Использование классов типов для обеспечения альтернативных реализаций при использовании Acid-State
Я написал веб-приложение, используя состояние Скотти и Кислоты, теперь я хотел бы использовать классы типов, чтобы иметь возможность предоставлять альтернативные реализации для возможностей моего приложения для тестирования. Я получил общее представление об этом и смог применить его на таких простых примерах, но так как я использую кислотное состояние, есть много классов типов и шаблонов haskell, которые мне пока не совсем удобны.
так что у меня есть эти простые классы для различных возможностей
class Logging m where
log :: T.Text -> m ()
class Server m where
body :: m B.ByteString
respond :: T.Text -> m ()
setHeader :: T.Text -> T.Text -> m ()
class Db m where
dbQuery :: (MethodState event ~ Database,QueryEvent event) => event -> m (EventResult event)
dbUpdate :: (MethodState event ~ Database,UpdateEvent event) => event -> m (EventResult event)
и я также предоставил им экземпляры для моей "производственной" монады.
Но когда дело доходит до возможностей базы данных, я не могу заставить работать то, что я хочу.
класс выглядит так
class Db m where
dbQuery :: (MethodState event ~ Database,QueryEvent event) => event -> m (EventResult event)
dbUpdate :: (MethodState event ~ Database,UpdateEvent event) => event -> m (EventResult event)
и экземпляр для производственной монады работает нормально, так как он только передает событие в функции обновления и запроса кислотного состояния, но для тестовой монады я хотел бы иметь что-то вроде этого: экземпляр Db Test, где dbQuery (GetVersion) = use (testDb . clientVersion) dbQuery (GetUser name) = preuse (testDb . users . ix name) dbUpdate (PutUser name user) = users %= M.insert name user ... так что я могу сопоставить в GetVersion,GetUser и т. д. (которые генерируются шаблоном функции haskell makeAcidic ...) и указывают, как они должны обрабатываться в тестовой среде.
Но я получаю ошибку:
Could not deduce: event ~ GetVersion
from the context: (MethodState event ~ Database, QueryEvent event)
bound by the type signature for:
dbQuery :: (MethodState event ~ Database, QueryEvent event) =>
event -> Test (EventResult event)
at Main.hs:88:3-9
‘event’ is a rigid type variable bound by
the type signature for:
dbQuery :: forall event.
(MethodState event ~ Database, QueryEvent event) =>
event -> Test (EventResult event)
at Main.hs:88:3
• In the pattern: GetVersion
In an equation for ‘dbQuery’:
dbQuery (GetVersion) = use (testDb . clientVersion)
In the instance declaration for ‘Db Test’
• Relevant bindings include
dbQuery :: event -> Test (EventResult event)
(bound at Main.hs:88:3)
Я думаю, это потому, что у GetVersion,GetUser и т. д. есть свои собственные типы. Так есть ли способ сделать это?
Включение предложений
Я попробовал предложения, предложенные Питером Амидоном, но, к сожалению, он все еще не компилируется, вот мой тестовый код
{-# LANGUAGE GADTs #-} -- For type equality
{-# LANGUAGE TypeOperators #-} -- For type equality
{-# LANGUAGE TypeFamilies #-} -- For EventResult
{-# LANGUAGE ScopedTypeVariables #-} -- For writing castWithWitness
{-# LANGUAGE TypeApplications #-} -- For convenience
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Lens
import Data.Acid
import qualified Data.Text.Lazy as T
import Types
import Data.Typeable
main = return ()
getUser :: Username -> Query Database (Maybe User)
getUser name = preview (users . ix name)
getVersion :: Query Database T.Text
getVersion = view clientVersion
$(makeAcidic ''Database ['getUser,'getVersion])
castWithWitness :: forall b a. (Typeable a, Typeable b)
=> a -> Maybe (b :~: a, b)
castWithWitness x = case eqT @a @b of
Nothing -> Nothing
Just Refl -> Just (Refl, x)
exampleFunction :: forall a. QueryEvent a => a -> EventResult a
exampleFunction (castWithWitness @GetVersion -> (Just Refl, Just GetVersion)) = "1.0"
exampleFunction (castWithWitness @GetUser -> (Just Refl, Just (GetUser n))) = Nothing
а тут ошибка
Main.hs:124:49: error:
• Couldn't match expected type ‘Maybe
(GetVersion :~: a, GetVersion)’
with actual type ‘(Maybe (t1 :~: t2), t0)’
• In the pattern: (Just Refl, Just GetVersion)
In the pattern:
castWithWitness @GetVersion -> (Just Refl, Just GetVersion)
In an equation for ‘exampleFunction’:
exampleFunction
(castWithWitness @GetVersion -> (Just Refl, Just GetVersion))
= "1.0"
• Relevant bindings include
exampleFunction :: a -> EventResult a (bound at Main.hs:124:1)
Main.hs:124:61: error:
• Couldn't match expected type ‘t0’
with actual type ‘Maybe GetVersion’
‘t0’ is untouchable
inside the constraints: t2 ~ t1
bound by a pattern with constructor:
Refl :: forall k (a :: k). a :~: a,
in an equation for ‘exampleFunction’
at Main.hs:124:55-58
• In the pattern: Just GetVersion
In the pattern: (Just Refl, Just GetVersion)
In the pattern:
castWithWitness @GetVersion -> (Just Refl, Just GetVersion)
Main.hs:125:46: error:
• Couldn't match expected type ‘Maybe (GetUser :~: a, GetUser)’
with actual type ‘(Maybe (t4 :~: t5), t3)’
• In the pattern: (Just Refl, Just (GetUser n))
In the pattern:
castWithWitness @GetUser -> (Just Refl, Just (GetUser n))
In an equation for ‘exampleFunction’:
exampleFunction
(castWithWitness @GetUser -> (Just Refl, Just (GetUser n)))
= Nothing
• Relevant bindings include
exampleFunction :: a -> EventResult a (bound at Main.hs:124:1)
Main.hs:125:79: error:
• Could not deduce: MethodResult a ~ Maybe a0
from the context: t5 ~ t4
bound by a pattern with constructor:
Refl :: forall k (a :: k). a :~: a,
in an equation for ‘exampleFunction’
at Main.hs:125:52-55
Expected type: EventResult a
Actual type: Maybe a0
The type variable ‘a0’ is ambiguous
• In the expression: Nothing
In an equation for ‘exampleFunction’:
exampleFunction
(castWithWitness @GetUser -> (Just Refl, Just (GetUser n)))
= Nothing
• Relevant bindings include
exampleFunction :: a -> EventResult a (bound at Main.hs:124:1)
1 ответ
В этом случае то, что вы хотите, должно быть возможным, потому что QueryEvent или же UpdateEvent это Methodи Method является Typeable, Typeable позволяет нам использовать функции из Data.Typeable чтобы проверить, какой конкретный тип у нас есть во время выполнения, что мы обычно не можем сделать.
Вот небольшой автономный пример, который напрямую не использует acid-state но начинает иллюстрировать идею:
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
Это не является строго необходимым, но позволяет сделать более приятный синтаксис для сопоставления на Events.
import Data.Typeable
Нам нужны функции из этого модуля для доступа к информации о наборе во время выполнения.
data GetVersion = GetVersion
data GetUser = GetUser String
class Typeable a => QueryEvent a where
instance QueryEvent GetVersion where
instance QueryEvent GetUser where
Упрощенный набор типов / классов для эмуляции того, что acid-state должен производить.
pattern IsEvent p <- (cast -> Just p)
Этот "синоним шаблона" делает его таким, чтобы мы могли писать IsEvent p на LHS сопоставления с образцом, и пусть он работает так же, как если бы мы написали (cast -> Just p), Этот последний является "шаблоном представления", который по существу выполняет функцию cast на входе, а затем шаблон сопоставляет его с Just p, cast это функция, определенная в Data.Typeable: cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b, Это означает, что если мы напишем, например, (cast -> Just GetVersion)что происходит cast пытается преобразовать аргумент в значение типа GetVersion, который затем сопоставляется с шаблоном уровня GetVersion условное обозначение; если преобразование не удается (подразумевая, что событие является чем-то другим), cast возвращается Nothing, так что этот шаблон не совпадает. Это позволяет нам писать:
exampleFunction :: QueryEvent a => a -> String
exampleFunction (IsEvent GetVersion) = "get version"
exampleFunction (IsEvent (GetUser a)) = "get user " ++ a
Это тогда работает:
λ> exampleFunction GetVersion
"get version"
λ> exampleFunction (GetUser "foo")
"get user foo"
Ваша ситуация немного сложнее, так как (тип) RHS функции зависит от типа входа. Нам понадобится еще несколько расширений для этого:
{-# LANGUAGE GADTs #-} -- For type equality
{-# LANGUAGE TypeOperators #-} -- For type equality
{-# LANGUAGE TypeFamilies #-} -- For EventResult
{-# LANGUAGE ScopedTypeVariables #-} -- For writing castWithWitness
{-# LANGUAGE TypeApplications #-} -- For convenience
Мы также можем добавить EventResult нашему простому манекену QueryEvent:
class Typeable a => QueryEvent a where
type EventResult a
instance QueryEvent GetVersion where
type EventResult GetVersion = Int
instance QueryEvent GetUser where
type EventResult GetUser = String
Вместо того, чтобы использовать cast, мы можем использовать
castWithWitness :: forall b a. (Typeable a, Typeable b)
=> a -> Maybe (b :~: a, b)
castWithWitness x = case eqT @a @b of
Nothing -> Nothing
Just Refl -> Just (Refl, x)
@a а также @b используют TypeApplications применять eqT к типам, которые castWithWitness был применен к, которые связаны через ScopedTypeVariables с использованием forall в подписи типа. castWithWitness как cast, но в дополнение к "приведенной" переменной она возвращает доказательство того, что переданные типы одинаковы. К сожалению, это делает его немного сложнее в использовании: IsEvent Синоним шаблона не может быть использован, и соответствующий тип должен быть передан напрямую:
exampleFunction :: forall a. QueryEvent a => a -> EventResult a
exampleFunction (castWithWitness @GetVersion -> Just (Refl, GetVersion)) = 1
exampleFunction (castWithWitness @GetUser -> Just (Refl, GetUser n)) = n
Это работает, потому что в каждом случае после сопоставления на ReflGHC знает на RHS функции, что a есть и может уменьшить EventResult Тип семьи.