haskell 如何测试Monad示例的自定义StateT?

knsnq2tg  于 2023-01-31  发布在  其他
关注(0)|答案(2)|浏览(113)

我正在学习Monad Transformers,其中一个练习要求实现StateT的Monad示例,我想使用validity包(类似于checkers包)测试我的实现是否符合Monad定律。
问题是,我的Arbitrary示例无法编译。我看到了this question,但它并不完全符合我的要求,因为测试基本上重复了实现,并且没有检查规则。还有this question,但它没有得到解答,而且我已经知道如何测试不涉及函数的Monad Transformers(如MaybeT)。

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE InstanceSigs #-}

module Ch11.MonadT (StT (..)) where

import Control.Monad.Trans.State (StateT (..))

newtype StT s m a = StT (s -> m (a, s))
  deriving
    (Functor, Applicative)
    via StateT s m

instance (Monad m) => Monad (StT s m) where
  return :: a -> StT s m a
  return = pure

  (>>=) :: StT s m a -> (a -> StT s m b) -> StT s m b
  StT x >>= f = StT $ \s -> do
    (k, s') <- x s
    let StT y = f k
    y s'

  (>>) :: StT s m a -> StT s m b -> StT s m b
  (>>) = (*>)

我的测试:

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Ch11.MonadTSpec (spec) where

import Ch11.MonadT (StT (..))
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Monad

spec :: Spec
spec = do
  monadSpecOnArbitrary @(StTArbit Int [] Int)

-- create wrapper to avoid orphan instance error
newtype StTArbit s m a = StTArbit (StT s m a)
  deriving
    (Functor, Applicative, Monad)

instance (Arbitrary s, Function s, Arbitrary1 m, Arbitrary a) => Arbitrary (StTArbit s m a) where
  arbitrary = do
    f <- arbitrary :: Fun s (m (a, s))
    StTArbit . StT <$> f

错误:

• Couldn't match type: (a0, s0)
                 with: s -> m (a, s)
  Expected: Gen (s -> m (a, s))
    Actual: Gen (a0, s0)
• In the second argument of ‘(<$>)’, namely ‘f’
  In a stmt of a 'do' block: StTArbit . StT <$> f
sg2wtvxw

sg2wtvxw1#

OP在这里,这是我最后做的。

-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/explicit_forall.html
{-# LANGUAGE ExplicitForAll #-}
-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html
{-# LANGUAGE TypeApplications #-}

module Ch11.MonadTSpec (spec) where

import Ch11.MonadT (StT (..), runStT)
import Data.Function as F
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck

spec :: Spec
spec = do
  describe "Monad (StT Int [])" $ do
    describe "satisfies Monad laws" $ do
      -- the types are in the same order as in `forall`
      prop "right identity law" (prop_monadRightId @Int @Int @[])
      prop "left identity law" (prop_monadLeftId @Int @Int @Int @[])
      prop "associative law" (prop_monadAssoc @Int @Int @Int @Int @[])

{- HLINT ignore -}

{-
the types in `forall` are specified in the order of dependency.
since `m` needs `a` and `s`, those appear before `m` in the list.
-}

-- (x >>= return) == x
prop_monadRightId ::
  forall a s m.
  (Monad m, Eq (m (a, s)), Show (m (a, s))) =>
  s ->
  Fun s (m (a, s)) ->
  Property
prop_monadRightId s f = ((===) `F.on` go) (m >>= return) m
  where
    m = StT $ applyFun f
    go st = runStT st s

-- (return x >>= f) == (f x)
prop_monadLeftId ::
  forall a b s m.
  (Monad m, Eq (m (b, s)), Show (m (b, s))) =>
  a ->
  s ->
  Fun (a, s) (m (b, s)) ->
  Property
prop_monadLeftId a s f = ((===) `F.on` go) (return a >>= h) m
  where
    g = applyFun2 f
    m = StT $ g a
    h = StT . g
    go st = runStT st s

-- ((x >>= f) >>= g) == (x >>= (\x' -> f x' >>= g))
prop_monadAssoc ::
  forall a b c s m.
  (Monad m, Eq (m (b, s)), Show (m (b, s)), Eq (m (c, s)), Show (m (c, s))) =>
  s ->
  Fun s (m (a, s)) ->
  Fun (a, s) (m (b, s)) ->
  Fun (b, s) (m (c, s)) ->
  Property
prop_monadAssoc s h f g =
  ((===) `F.on` go)
    ((m >>= f') >>= g')
    (m >>= (\x -> f' x >>= g'))
  where
    m = StT $ applyFun h
    f' = StT . applyFun2 f
    g' = StT . applyFun2 g
    go st = runStT st s
pcww981p

pcww981p2#

我想您需要的是pure,而不是(<$>)(但是我还没有检查本地编译器,所以我不确定)。您可能还需要将Fun转换为实际函数。

arbitrary = do
  f <- arbitrary
  pure (StTArbit . StT . applyFun $ f)

我还要指出,在这里创建一个newtype并没有多大意义,我猜它避免了一个孤立示例警告,但是你已经定义了你正在为自己编写一个示例的类型,大概甚至在同一个包中,所以它看起来很友好;如果它是一个独立的阴谋集团的一部分,人们不能依赖,像一个测试套件,甚至更多。

相关问题