haskell - 使用类型类为使用 Acid-State 时提供替代实现

Question

我使用 scotty 和 acid state 编写了一个 Web 应用程序，现在我想使用类型类来为我的应用程序的测试功能提供替代实现。我对它有了大致的了解，并且能够将它应用到如此简单的示例中，但是由于我使用的是酸性状态，因此涉及到很多类型类和模板 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)

并且生产 monad 的实例工作正常，因为它只将事件传递给酸状态的更新和查询函数，但是对于测试 monad，我想要这样的东西： instance Db Test where 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 等都有自己不同的类型。那么有没有办法做到这一点？

纳入建议

我尝试了 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)

score 1 · Accepted Answer

在这种情况下，您想要的应该是可能的，因为 a QueryEventorUpdateEvent是 a Method，而 aMethod是Typeable。Typeable让我们使用函数 fromData.Typeable来检查我们在运行时拥有的特定类型，这是我们通常无法做到的。

这是一个小型的、独立的示例，它不直接使用acid-state但开始说明这个想法：

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}

Event这些并不是绝对必要的，但可以为匹配s提供更好的语法。

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.Typeablecast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b(cast -> Just GetVersion)castGetVersionGetVersioncastNothing

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通过使用类型签名中的绑定。类似于，但除了“casted”变量之外，它还返回传入类型相同的证明。不幸的是，这样使用起来有点困难：不能使用模式同义词，需要直接传入相关类型：@bTypeApplicationseqTcastWithWitnessScopedTypeVariablesforallcastWithWitnesscastIsEvent

exampleFunction :: forall a. QueryEvent a => a -> EventResult a
exampleFunction (castWithWitness @GetVersion -> Just (Refl, GetVersion)) = 1
exampleFunction (castWithWitness @GetUser -> Just (Refl, GetUser n)) = n

这是可行的，因为在每种情况下，在匹配 on 之后Refl，GHC 都知道函数的 RHS 是什么a，并且可以减少EventResult类型族。

haskell - 使用类型类为使用 Acid-State 时提供替代实现

纳入建议

1 回答 1

Related

Reference