Question

我使用scotty和acid状态编写了一个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)

，我还为我的“生产” monad提供了实例。

但是在数据库功能方面，我无法按需工作。

班级看起来像这样

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状态的更新和查询功能，但是对于测试monad，我希望具有以下内容：实例Db测试在哪里 dbQuery（GetVersion）=使用（testDb。clientVersion） dbQuery（GetUser名称）= preuse（testDb.users.ix名称） dbUpdate（PutUser名称用户）=用户％= M.insert名称用户 ... 这样我就可以在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)

Answer 1

在这种情况下，您想要的应该是可能的，因为QueryEvent或UpdateEvent是Method，而Method是Typeable。 Typeable使我们可以使用Data.Typeable中的函数来检查我们在运行时拥有的特定类型，而实际上这是我们通常无法做到的。

这是一个很小的，自成体系的示例，它不直接使用acid-state，而是开始说明这个想法：

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

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

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)

使用此“模式同义词”可以使我们可以在模式匹配的LHS上写IsEvent p，并使它的工作方式与编写(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所应用的类型，这些类型通过{{1}绑定}，并在类型签名中使用ScopedTypeVariables。 forall与castWithWitness类似，但是除了“ casted”变量之外，它还返回一个证明，即传入的类型相同。不幸的是，这使它更难使用：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上进行匹配后，GHC都会在函数的RHS上知道Refl是什么，并且可以减少a类型的族。

使用类型类为使用Acid-State

纳入建议

1 个答案: