使用 type 类 为使用 Acid-State 时提供替代实现
using type classes to provide alternative implementations for when using Acid-State
我使用 scotty 和 acid state 编写了一个 web 应用程序，现在我想使用类型 classes 来为我的应用程序的测试功能提供替代实现。
我得到了它的一般概念并且能够应用它如此简单的例子但是因为我使用的是酸性状态所以有很多类型 classes 和模板 haskell 涉及我并不完全适应还。
所以我有这些直接的 classes 用于不同的功能
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)
我还为我的 "production" monad 提供了实例。
但是当涉及到数据库功能时，我无法按照自己的意愿工作。
class 看起来像这样
class Db m where
dbQuery :: (MethodState event ~ Database,QueryEvent event) => event -> m (EventResult event)
dbUpdate :: (MethodState event ~ Database,UpdateEvent event) => event -> m (EventResult event)
并且生产 monad 的实例工作正常，因为它只将事件传递给 acid state 的更新和查询函数，但对于测试 monad，我希望有这样的东西：
实例 Db 测试位置
dbQuery (GetVersion) = 使用 (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 等都有自己不同的类型。那么有没有办法做到这一点？
合并建议
我尝试了 Peter Amidon 提出的建议，但遗憾的是它仍然没有编译这里是我的测试代码
{-# 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)
在这种情况下，您想要的应该是可能的，因为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
一组简化的 types/classes 来模拟 acid-state 应该产生的结果。
pattern IsEvent p <- (cast -> Just p)
这个 "pattern synonym" 使得我们可以在模式匹配的 LHS 上写 IsEvent p 并且让它像我们写 (cast -> Just p) 一样工作。后者是一个 "view pattern"，它本质上是 运行 对输入的函数 cast，然后将其与 Just p 进行模式匹配。 cast 是 Data.Typeable 中定义的函数：cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b。这意味着如果我们写，例如，(cast -> Just GetVersion)，会发生的是 cast 尝试将参数转换为类型 GetVersion 的值，然后与该值进行模式匹配-level GetVersion 符号；如果转换失败（暗示事件是别的东西），cast returns 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，但除了 "casted" 变量外，它 returns 证明传入的类型相同。不幸的是，这使得使用起来有点困难：不能使用IsEvent模式同义词，需要直接传入相关类型：
exampleFunction :: forall a. QueryEvent a => a -> EventResult a
exampleFunction (castWithWitness @GetVersion -> Just (Refl, GetVersion)) = 1
exampleFunction (castWithWitness @GetUser -> Just (Refl, GetUser n)) = n
这行得通，因为在每种情况下，在 Refl 上匹配后，GHC 在函数的 RHS 上知道 a 是什么，并且可以减少 EventResult 类型族。
我使用 scotty 和 acid state 编写了一个 web 应用程序，现在我想使用类型 classes 来为我的应用程序的测试功能提供替代实现。 我得到了它的一般概念并且能够应用它如此简单的例子但是因为我使用的是酸性状态所以有很多类型 classes 和模板 haskell 涉及我并不完全适应还。
所以我有这些直接的 classes 用于不同的功能
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)
我还为我的 "production" monad 提供了实例。
但是当涉及到数据库功能时，我无法按照自己的意愿工作。
class 看起来像这样
class Db m where
dbQuery :: (MethodState event ~ Database,QueryEvent event) => event -> m (EventResult event)
dbUpdate :: (MethodState event ~ Database,UpdateEvent event) => event -> m (EventResult event)
并且生产 monad 的实例工作正常，因为它只将事件传递给 acid state 的更新和查询函数，但对于测试 monad，我希望有这样的东西： 实例 Db 测试位置 dbQuery (GetVersion) = 使用 (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 等都有自己不同的类型。那么有没有办法做到这一点？
合并建议
我尝试了 Peter Amidon 提出的建议，但遗憾的是它仍然没有编译这里是我的测试代码
{-# 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)
在这种情况下，您想要的应该是可能的，因为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
一组简化的 types/classes 来模拟 acid-state 应该产生的结果。
pattern IsEvent p <- (cast -> Just p)
这个 "pattern synonym" 使得我们可以在模式匹配的 LHS 上写 IsEvent p 并且让它像我们写 (cast -> Just p) 一样工作。后者是一个 "view pattern"，它本质上是 运行 对输入的函数 cast，然后将其与 Just p 进行模式匹配。 cast 是 Data.Typeable 中定义的函数：cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b。这意味着如果我们写，例如，(cast -> Just GetVersion)，会发生的是 cast 尝试将参数转换为类型 GetVersion 的值，然后与该值进行模式匹配-level GetVersion 符号；如果转换失败（暗示事件是别的东西），cast returns 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，但除了 "casted" 变量外，它 returns 证明传入的类型相同。不幸的是，这使得使用起来有点困难：不能使用IsEvent模式同义词，需要直接传入相关类型：
exampleFunction :: forall a. QueryEvent a => a -> EventResult a
exampleFunction (castWithWitness @GetVersion -> Just (Refl, GetVersion)) = 1
exampleFunction (castWithWitness @GetUser -> Just (Refl, GetUser n)) = n
这行得通，因为在每种情况下，在 Refl 上匹配后，GHC 在函数的 RHS 上知道 a 是什么，并且可以减少 EventResult 类型族。