polysemy-zoo-0.5.0.0: test/ShiftSpec.hs

module ShiftSpec where

import Test.Hspec

import Data.IORef

import Polysemy
import Polysemy.Shift
import Polysemy.Error
import Polysemy.Reader
import Polysemy.Writer
import Polysemy.State
import Polysemy.Final.MTL

import Control.Monad.Cont(ContT(..))
import Control.Monad.State(StateT(..))


test1 :: Maybe (String, ())
test1 =
    run
  . runShiftPure
  . runReader (1 :: Int)
  . runWriter
  $ do
  censor (++"!") $ shift $ \c -> do
    _ <- local (+1) (c ())
    _ <- local (+1) (c ())
    tell "unimportant"
    local (+1) (c ())
  j <- ask
  tell (show j)

test2 :: Maybe (Either () ())
test2 =
    run
  . runShiftPure
  . runError
  $ do
  shift $ \_ -> do
    throw ()

test3 :: Maybe (Either () ())
test3 =
    run
  . runShiftPure
  . runError
  $ do
  r <- reset' $ shift $ \_ -> do
    throw ()
  case r of
    Just r' -> abort r'
    _       -> pure ()

test4 :: IO (Maybe Int)
test4 = do
  ref <- newIORef 1
  runM
   . runShiftM
   . runStateIORef ref
   $ do
    shift $ \c -> do
      _ <- c ()
      _ <- c ()
      c ()
    modify (+1)
    get

test5 :: (Maybe Int, Int)
test5 =
    ($ 1)
  . (`runStateT` 1)
  . (`runContT` (pure . Just))
  . runFinal
  . runStateFinal
  . runShiftFinal
  . runReaderFinal
  $ do
  shift $ \c -> do
    _ <- local (+1) (c ())
    _ <- local (+2) (c ())
    local (+3) (c ())
  i <- ask
  modify (+i)
  get

test6 :: (Int, Maybe Int)
test6 =
     run
   . runState 1
   . runShiftUnsafe
   $ do
    shift $ \c -> do
      _ <- c ()
      _ <- c ()
      c ()
    modify (+1)
    get

spec :: Spec
spec = do
  describe "runShiftPure" $ do
    it "should only tell once, censor once, and\
       \ local should have no effect on the continuation." $
      test1 `shouldBe` Just ("!1", ())

    it "should fail from failing locally" $ do
      test2 `shouldBe` Nothing

    it "should recover from failing locally" $ do
      test3 `shouldBe` Just (Right ())

  describe "runShiftM" $ do
    it "should modify multiple times with runStateInIORef" $ do
      res <- test4
      res `shouldBe` Just 4

  describe "runShiftFinal" $ do
    it "should modify multiple times with runStateFinal\
        \ and should be able to apply local to continuation" $
      test5 `shouldBe` (Just 10, 10)

  describe "runShiftUnsafe" $ do
    it "should modify multiple times with runState\
        \ run after it" $
      test6 `shouldBe` (4, Just 4)