mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-11-30 07:13:55 +03:00
4a5f2ce92a
* Add Final Effect * Changes per review, Final at top-level, doc changes * Update Changelog * Final touches to Final * Revert change to stack.yaml
97 lines
2.1 KiB
Haskell
97 lines
2.1 KiB
Haskell
{-# LANGUAGE RecursiveDo #-}
|
|
module FinalSpec where
|
|
|
|
import Test.Hspec
|
|
|
|
import Data.Either
|
|
import Data.IORef
|
|
|
|
import Polysemy
|
|
import Polysemy.Async
|
|
import Polysemy.Error
|
|
import Polysemy.Fixpoint
|
|
import Polysemy.Trace
|
|
import Polysemy.State
|
|
|
|
|
|
data Node a = Node a (IORef (Node a))
|
|
|
|
mkNode :: (Member (Embed IO) r, Member Fixpoint r)
|
|
=> a
|
|
-> Sem r (Node a)
|
|
mkNode a = mdo
|
|
let nd = Node a p
|
|
p <- embed $ newIORef nd
|
|
return nd
|
|
|
|
linkNode :: Member (Embed IO) r
|
|
=> Node a
|
|
-> Node a
|
|
-> Sem r ()
|
|
linkNode (Node _ r) b =
|
|
embed $ writeIORef r b
|
|
|
|
readNode :: Node a -> a
|
|
readNode (Node a _) = a
|
|
|
|
follow :: Member (Embed IO) r
|
|
=> Node a
|
|
-> Sem r (Node a)
|
|
follow (Node _ ref) = embed $ readIORef ref
|
|
|
|
test1 :: IO (Either Int (String, Int, Maybe Int))
|
|
test1 = do
|
|
ref <- newIORef "abra"
|
|
runFinal
|
|
. embedToFinal @IO
|
|
. runStateIORef ref -- Order of these interpreters don't matter
|
|
. errorToIOFinal
|
|
. fixpointToFinal @IO
|
|
. asyncToIOFinal
|
|
$ do
|
|
n1 <- mkNode 1
|
|
n2 <- mkNode 2
|
|
linkNode n2 n1
|
|
aw <- async $ do
|
|
linkNode n1 n2
|
|
modify (++"hadabra")
|
|
n2' <- follow n2
|
|
throw (readNode n2')
|
|
m <- await aw `catch` (\s -> return $ Just s)
|
|
n1' <- follow n1
|
|
s <- get
|
|
return (s, readNode n1', m)
|
|
|
|
test2 :: IO ([String], Either () ())
|
|
test2 =
|
|
runFinal
|
|
. runTraceList
|
|
. errorToIOFinal
|
|
. asyncToIOFinal
|
|
$ do
|
|
fut <- async $ do
|
|
trace "Global state semantics?"
|
|
catch @() (trace "What's that?" *> throw ()) (\_ -> return ())
|
|
_ <- await fut
|
|
trace "Nothing at all."
|
|
|
|
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "Final on IO" $ do
|
|
it "should terminate successfully, with no exceptions,\
|
|
\ and have global state semantics on State." $ do
|
|
res1 <- test1
|
|
res1 `shouldSatisfy` isRight
|
|
case res1 of
|
|
Right (s, i, j) -> do
|
|
i `shouldBe` 2
|
|
j `shouldBe` Just 1
|
|
s `shouldBe` "abrahadabra"
|
|
_ -> pure ()
|
|
|
|
it "should treat trace with local state semantics" $ do
|
|
res2 <- test2
|
|
res2 `shouldBe` (["Nothing at all."], Right ())
|