mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-11-23 00:26:52 +03:00
235813da00
* Small code simplifications
These are all replacements of the form
before: fmap f $ x
after: f <$> x
Minor change, but feels marginally easier to read to me.
Co-authored-by: TheMatten <matten@tuta.io>
103 lines
2.4 KiB
Haskell
103 lines
2.4 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE RecursiveDo #-}
|
|
module FixpointSpec where
|
|
|
|
import Data.Functor.Identity
|
|
import Control.Exception (evaluate)
|
|
import Control.Monad.Fix
|
|
|
|
import Polysemy
|
|
import Polysemy.Fixpoint
|
|
import Polysemy.Error
|
|
import Polysemy.State
|
|
import Polysemy.Output
|
|
|
|
import Test.Hspec
|
|
|
|
data FinalState s m a where
|
|
GetEventualState :: FinalState s m s
|
|
|
|
makeSem ''FinalState
|
|
|
|
runFinalState :: Member Fixpoint r
|
|
=> s
|
|
-> Sem (State s ': FinalState s ': r) a
|
|
-> Sem r (s, a)
|
|
runFinalState s sm = mfix $ \ ~(s', _) ->
|
|
interpret
|
|
(\GetEventualState -> pure s')
|
|
(runState s sm)
|
|
|
|
test1 :: (String, (Int, ()))
|
|
test1 =
|
|
runIdentity
|
|
. runFinal
|
|
. fixpointToFinal @Identity
|
|
. runOutputMonoid (show @Int)
|
|
. runFinalState 1
|
|
$ do
|
|
s <- get @Int
|
|
s' <- getEventualState @Int
|
|
output @Int s
|
|
output @Int s'
|
|
put @Int 2
|
|
|
|
test2 :: Either [Int] [Int]
|
|
test2 =
|
|
runIdentity
|
|
. runFinal
|
|
. fixpointToFinal @Identity
|
|
. runError
|
|
$ mdo
|
|
a <- throw (2 : a) `catch` (\e -> return (1 : e))
|
|
return a
|
|
|
|
test3 :: Either () (Int, Int)
|
|
test3 =
|
|
runIdentity
|
|
. runFinal
|
|
. fixpointToFinal @Identity
|
|
. runError
|
|
. runLazyState @Int 1
|
|
$ mdo
|
|
put a
|
|
a <- throw ()
|
|
return a
|
|
|
|
test4 :: (Int, Either () Int)
|
|
test4 =
|
|
runIdentity
|
|
. runFinal
|
|
. fixpointToFinal @Identity
|
|
. runLazyState @Int 1
|
|
. runError
|
|
$ mdo
|
|
put a
|
|
a <- throw ()
|
|
return a
|
|
|
|
|
|
spec :: Spec
|
|
spec = parallel $ describe "fixpointToFinal on Identity" $ do
|
|
it "should work with runState" $ do
|
|
test1 `shouldBe` ("12", (2, ()))
|
|
it "should work with runError" $ do
|
|
let res = take 10 <$> test2
|
|
res `shouldBe` Right (take 10 $ cycle [1,2])
|
|
it "should not trigger the bomb" $ do
|
|
test3 `shouldBe` Left ()
|
|
it "should trigger the bomb" $ do
|
|
let (s, a) = test4
|
|
evaluate s `shouldThrow` errorCall bombMessage
|
|
a `shouldBe` Left ()
|
|
|
|
bombMessage :: String
|
|
bombMessage =
|
|
"fixpointToFinal: Internal computation failed.\
|
|
\ This is likely because you have tried to recursively use\
|
|
\ the result of a failed computation in an action\
|
|
\ whose effect may be observed even though the computation failed.\
|
|
\ It's also possible that you're using an interpreter\
|
|
\ that uses 'weave' improperly.\
|
|
\ See documentation for more information."
|