Question

在hedgehog中使用状态机时，我必须定义一个更新模型状态的函数。其类型应为forall v. Ord1 v => state v -> input v -> Var output v -> state v（请参见Callback的Update构造函数）。

现在，我想进入output，但是我发现的唯一功能是concrete，但是它指定了我的更新功能v。

如何定义一个满足Update类型的更新函数，同时又仍然允许我到达输出（大概是通过使用concrete）？

Answer 1

啊，我明白了。您想要做的是在Hedgehog模型状态和输入（AKA转换）中使用Vars，无论状态组件取决于先前的操作。然后，您可以根据这些变量抽象地更新状态（即以一种既可以符号化又可以具体起作用的方式）。只有当您执行命令时，才需要使这些变量具体化。

让我给你看一个例子。如果您想遵循以下步骤，则使用了以下导入和扩展：

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}

import Control.Monad
import Control.Monad.IO.Class
import Data.IORef
import Data.Map.Strict as Map
import Data.Map.Strict (Map)
import Data.Set as Set
import Data.Set (Set)
import System.IO.Unsafe

import Hedgehog
import Hedgehog.Gen as Gen
import Hedgehog.Range as Range

假设我们具有以下使用全局IORef的模拟Web API：

type UUID = Int
type Content = String

uuidRef :: IORef UUID
uuidRef = unsafePerformIO (newIORef 0)

newUuid :: IO UUID
newUuid = do
  n <- readIORef uuidRef
  writeIORef uuidRef (n+1)
  return n

dbRef :: IORef (Map UUID Content)
dbRef = unsafePerformIO (newIORef Map.empty)

resetDatabase :: IO ()
resetDatabase = writeIORef dbRef Map.empty

postFoo :: Content -> IO UUID
postFoo bdy = do
  uuid <- newUuid
  modifyIORef dbRef (Map.insert uuid bdy)
  return uuid

getFoo :: UUID -> IO (Maybe Content)
getFoo uuid = Map.lookup uuid <$> readIORef dbRef

deleteFoo :: UUID -> IO ()
deleteFoo uuid =
  modifyIORef dbRef (Map.delete uuid)

在构造Hedgehog模型时，我们需要记住，postFoo操作将生成UUID作为输出，以用于后续（获取和删除）操作。以后的操作与以前的操作的这种依赖关系意味着这些UUID应该在状态中显示为变量。

在我们的状态下，我们将跟踪Map的{{1}}的UUID（作为变量）以对数据库的内部状态进行建模。我们还将跟踪所有UUID的集合，甚至是那些不再存在于数据库中的UUID，因此我们可以测试已删除UUID的提取。

Content

现在，我们要对发布，获取和删除命令进行建模。要“发布”，我们需要下面的“输入”（或过渡，或任何其他形式），用于发布给定的内容：

data ModelState (v :: * -> *)
  = S { uuids :: Set (Var UUID v)             -- UUIDs ever returned
      , content :: Map (Var UUID v) Content   -- active content
      }
  deriving (Eq, Ord, Show)

initialState :: ModelState v
initialState = S Set.empty Map.empty

，相应的命令如下所示：

data Post (v :: * -> *) = Post Content
  deriving (Eq, Show)

请注意，无论当前状态如何，始终可以创建新的帖子，因此s_post :: (MonadGen n, MonadIO m, MonadTest m) => Command n m ModelState s_post = let gen _state = Just $ Post <$> Gen.string (Range.constant 0 100) Gen.alpha execute (Post bdy) = liftIO $ postFoo bdy in Command gen execute [ Update $ \S{..} (Post bdy) o -> S { uuids = Set.insert o uuids , content = Map.insert o bdy content } ]会忽略当前状态并生成随机帖子。 gen将此操作转换为实际API上的IO操作。请注意，execute回调将Update的结果作为变量接收。也就是说，postFoo的类型为o。很好，因为我们的Var UUID v只需要在状态中存储Update-由于我们构建Var UUID v的方式，它不需要具体的UUID值

我们还需要ModelState的{{1}}实例来进行类型检查。由于HTraversable没有任何变量，因此该实例很简单：

Post

对于“获取”输入和命令，我们有：

Post

在这里，instance HTraversable Post where htraverse _ (Post bdy) = pure (Post bdy)会查询当前状态以获取一直观察到的UUID的集合（从技术上讲，作为符号变量）。如果该集合为空，则我们没有要测试的有效UUID，因此无法使用data Get (v :: * -> *) = Get (Var UUID v) deriving (Eq, Show) s_get :: (MonadGen n, MonadIO m, MonadTest m) => Command n m ModelState s_get = let gen S{..} | not (Set.null uuids) = Just $ Get <$> Gen.element (Set.toList uuids) | otherwise = Nothing execute (Get uuid) = liftIO $ getFoo $ concrete uuid in Command gen execute [ Require $ \S{..} (Get uuid) -> uuid `Set.member` uuids , Ensure $ \before _after (Get uuid) o -> o === Map.lookup uuid (content before) ]，并且gen返回Get。否则，我们将为集合中的随机UUID（作为符号变量）生成一个gen请求。这可能是仍在数据库中的UUID或已被删除的UUID。然后，Nothing方法对实际的API执行IO操作。最后，在这里，我们允许将变量具体化（我们需要为API获得实际的Get）。

请注意回调-我们execute认为UUID变量是当前状态下UUID变量集的成员（以防在收缩期间无效），并且在执行操作后，我们{{ 1}}，我们可以为此UUID检索适当的内容。请注意，我们允许在UUID中将变量具体化，但是在这种情况下我们不需要这样做。这里不需要Require，因为Ensure不会影响状态。

我们还需要Ensure的{{1}}实例。由于它具有一个变量，因此实例稍微复杂一些：

Update

“删除”输入和命令的代码与“获取”的代码非常相似，不同之处在于它具有Get回调。

HTraversable

我们要测试的属性是这些动作的随机集合的顺序应用。请注意，由于我们的API具有全局状态，因此我们需要在每次测试开始时Get，否则事情会变得奇怪：

instance HTraversable Get where
  htraverse f (Get uuid) = Get <$> htraverse f uuid

最后，然后：

Update

并运行它给出：

data Delete (v :: * -> *) = Delete (Var UUID v)
  deriving (Eq, Show)
instance HTraversable Delete where
  htraverse f (Delete uuid) = Delete <$> htraverse f uuid

s_delete :: (MonadGen n, MonadIO m, MonadTest m) => Command n m ModelState
s_delete =
  let
    gen S{..} | not (Set.null uuids) = Just $ Delete <$> Gen.element (Set.toList uuids)
              | otherwise            = Nothing
    execute (Delete uuid) = liftIO $ deleteFoo $ concrete uuid
  in
    Command gen execute [
        Require $ \S{..} (Delete uuid) -> uuid `Set.member` uuids
      , Update $ \S{..} (Delete uuid) _o -> S { content = Map.delete uuid content, .. }
      , Ensure $ \_before after (Delete uuid) _o ->
          Nothing === Map.lookup uuid (content after)
      ]

请注意，以上我们忘记检查一件事，即该API在发布时确实提供了唯一的UUID。例如，如果我们故意中断UUID生成器：

resetDatabase

测试仍然通过-API为我们提供了重复的UUID，并且我们忠实地覆盖了模型状态下的旧数据，匹配了损坏的API。

要对此进行检查，我们想向prop_main :: Property prop_main = property $ do liftIO $ resetDatabase actions <- forAll $ Gen.sequential (Range.linear 1 100) initialState [ s_post, s_get, s_delete ] executeSequential initialState actions添加一个main :: IO () main = void (check prop_main)回调，以确保每个新的UUID都不是我们以前见过的。但是，如果我们写：

> main
✓ <interactive> passed 100 tests.
>

这不会键入检查，因为newUuid :: IO UUID newUuid = do n <- readIORef uuidRef writeIORef uuidRef $ (n+1) `mod` 2 return n是实际的，具体的Ensure输出值（即，不是s_post），但是, Ensure $ \before _after (Post _bdy) o -> assert $ o `Set.notMember` uuids before是一组具体变量。我们可以映射到集合以从变量中提取具体值：

或者，我们可以像这样为值UUID构造一个具体变量：

Var

两者都能正常工作，并且可以捕获上面有问题的uuids before实现。

供参考，完整的代码是：

, Ensure $ \before _after (Post _bdy) o ->
    assert $ o `Set.notMember` Set.map concrete (uuids before)

Haskell，定义类型多态的函数的专业化

1 个答案: