mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-12-02 11:54:06 +03:00
0d22cdaba0
* Added Pass to Writer, replacing Censor. Fixed semantics of listen * Swap order of elements in the Pass tuple * Sometimes I'm bad! Fixed compile error.
60 lines
1.2 KiB
Haskell
60 lines
1.2 KiB
Haskell
{-# LANGUAGE AllowAmbiguousTypes #-}
|
|
module WriterSpec where
|
|
|
|
import Test.Hspec
|
|
|
|
import Polysemy
|
|
import Polysemy.Error
|
|
import Polysemy.Writer
|
|
|
|
censor' :: forall e s a r
|
|
. (Member (Error e) r, Member (Writer s) r)
|
|
=> (s -> s)
|
|
-> Sem r a
|
|
-> Sem r a
|
|
censor' f m = do
|
|
res <- censor f $ fmap Right m `catch` (pure . Left)
|
|
case res of
|
|
Right res' -> return res'
|
|
Left e -> throw (e :: e)
|
|
|
|
test1 :: (String, Either () ())
|
|
test1 =
|
|
run
|
|
. runWriter
|
|
. runError $
|
|
do
|
|
tell "censoring"
|
|
censor @String
|
|
(drop 4)
|
|
(tell " not applied" *> throw ())
|
|
`catch`
|
|
(\(_ :: ()) -> pure ())
|
|
|
|
test2 :: (String, Either () ())
|
|
test2 =
|
|
run
|
|
. runWriter
|
|
. runError $
|
|
do
|
|
tell "censoring"
|
|
censor' @() @String
|
|
(drop 4)
|
|
(tell " not applied" *> throw ())
|
|
`catch`
|
|
(\(_ :: ()) -> pure ())
|
|
|
|
test3 :: (String, (String, ()))
|
|
test3 = run . runWriter $ listen (tell "and hear")
|
|
|
|
spec :: Spec
|
|
spec = describe "writer" $ do
|
|
it "should not censor" $ do
|
|
test1 `shouldBe` ("censoring not applied", Right ())
|
|
|
|
it "should censor" $ do
|
|
test2 `shouldBe` ("censoring applied", Right ())
|
|
|
|
it "should have a proper listen" $ do
|
|
test3 `shouldBe` ("and hear", ("and hear", ()))
|