polysemy-zoo-0.5.0.0: test/ContSpec.hs

module ContSpec where

import Test.Hspec

import Data.IORef

import Polysemy
import Polysemy.Cont
import Polysemy.Error
import Polysemy.Reader
import Polysemy.Writer
import Polysemy.State
import Polysemy.Trace
import Polysemy.Final.MTL

import qualified Control.Monad.State as S
import qualified Control.Monad.Cont as C

test1 :: (String, Int)
test1 =
    run
  . runContPure
  . runReader 1
  . runWriter
  $ do
  i <- censor (++"!") $ local (+1) $ callCC $ \c -> do
    i <- local (+1) ask
    tell "unimportant"
    local (+1) (c i)
  tell (show i)
  j <- ask
  return j

test2 :: (String, ())
test2 =
    run
  . runContPure
  . runReader (1 :: Int)
  . runWriter
  $ do
  i <- censor (++"!") $ local (+1) $ callCC $ \_ -> do
    i <- local (+1) ask
    tell "important"
    return i
  tell (show i)
  return ()

test3 :: Either () ()
test3 =
     run
   . runContPure
   . runError
   $ catch (callCC $ \_ -> throw ()) (\_ -> pure ())

stateTest :: (Member (State Int) r, Member (Cont ref) r)
          => Sem r Int
stateTest = do
  i <- get
  put (i + 1)
  callCC $ \c -> do
    j <- get
    put (j + 1)
    c ()
  get

test4 :: (Int, Int)
test4 =
    (`S.runState` 1)
  . runM
  . runContM
  . runStateFinal
  $ stateTest

test5 :: IO (Int, Int)
test5 = do
  ref <- newIORef 1

  r <-  runM
      . runContM
      . runStateIORef ref
      $ stateTest
  s' <- readIORef ref
  return (r, s')

test6 :: (Int, Int)
test6 =
    run
  . runState 1
  . runContUnsafe
  $ stateTest

test7 :: ([String], String)
test7 =
    (`C.runCont` id)
  . runFinal
  . runTraceList
  . runReader ""
  . runContFinal
  $ do
  j <- local (++".") $ callCC $ \c -> do
    j <- ask
    trace "Global state semantics?"
    local (\_ -> "What's that?") (c j)
  i <- local (++"Nothing") ask
  trace $ i
  callCC $ \_ ->
    trace "at"
  trace "all."
  return j

test8 :: Int
test8 =
     ($ 1)
   . (`C.runContT` pure)
   . runFinal
   . runReaderFinal
   . runContFinal
   $ do
  callCC $ \c ->
    local (+1) (c ())
  ask

spec :: Spec
spec = do
  describe "runContPure" $ do
    it "should work with higher-order effects if not applied on continuations\
          \ and discard local state" $
      test1 `shouldBe` ("!3", 1)

    it "should not discard local state if continuation is never invoked" $
      test2 `shouldBe` ("important!3", ())

    it "should catch exception within callCC" $
      test3 `shouldBe` Right ()

  describe "runContM" $ do
    it "should have global state semantics with runStateFinal" $
      test4 `shouldBe` (3, 3)

    it "should have global state semantics with runStateInIORef" $ do
      r <- test5
      r `shouldBe` (3, 3)

  describe "runContFinal" $ do
    it "should work just like runContPure/M." $
      test7 `shouldBe` (["Nothing", "at", "all."], ".")

    it "should be able to apply local to continuation" $
      test8 `shouldBe` 2

  describe "runContUnsafe" $ do
    it "should work with and have global state semantics with runState\
       \ run after it" $
      test6 `shouldBe` (3, 3)