cleff-0.1.0.0: test/StateSpec.hs

-- | This module is adapted from https://github.com/arybczak/effectful/blob/master/effectful/tests/StateTests.hs,
-- originally BSD3 license, authors Andrzej Rybczak et al.
module StateSpec where

import           Cleff
import           Cleff.State
import qualified Control.Exception.Lifted as LE
import qualified Control.Monad.Catch      as E
import           Test.Hspec
import           UnliftIO.Exception
import qualified UnliftIO.Exception       as UE

spec :: Spec
spec = parallel do
  it "should run with correct results" basic
  it "should run in a deep stack" deepStack
  it "should interact well with exceptions" exceptionInteract
  it "should run in nested cases" nested

basic, deepStack, exceptionInteract, nested :: IO ()

basic = do
  (end, len) <- runIOE . runState (0::Int) . fmap snd . runState collatzStart $ collatz
  end `shouldBe` 1
  len `shouldBe` collatzLength

deepStack = do
  n <- runIOE . fmap fst . runState () . fmap snd . runState (0::Int) $ do
    fmap fst . runState () . fmap fst . runState () $ do
      fmap fst . runState () $ do
        fmap fst . runState () . fmap fst . runState () . fmap fst . runState () $ do
          modify @Int (+1)
        modify @Int (+2)
      modify @Int (+4)
    modify @Int (+8)
  n `shouldBe` 15

exceptionInteract = do
  testTry   E.try
  testCatch E.catch
  testTry   LE.try
  testCatch LE.catch
  testTry   UE.try
  testCatch UE.catch
  where
    testTry
      :: (∀ a es. IOE :> es => Eff es a -> Eff es (Either Ex a))
      -> IO ()
    testTry tryImpl = do
      e <- runIOE $ tryImpl $ runState (0::Int) action
      e `shouldBe` Left Ex
      s <- runIOE $ fmap snd $ runState (0::Int) $ tryImpl action
      s `shouldBe` 1
    testCatch
      :: (∀ a es. IOE :> es => Eff es a -> (Ex -> Eff es a) -> Eff es a)
      -> IO ()
    testCatch catchImpl = do
      s <- runIOE . fmap snd . runState (0::Int) $ do
        _ <- (fmap fst . runState () $ action) `catchImpl` \Ex -> modify @Int (+4)
        modify @Int (+8)
      s `shouldBe` 13
    action :: '[State Int, IOE] :>> es => Eff es ()
    action = do
      modify @Int (+1)
      _ <- throwIO Ex
      modify @Int (+2)

nested = do
  x <- runIOE do
    runHasInt 0 do
      putInt 1
      fmap snd . runState () $ do
        putInt 2
        fmap snd . runState () $ do
          putInt expected
      getInt
  x `shouldBe` expected
  where
    expected :: Int
    expected = 4

data HasInt :: Effect where
  GetInt :: HasInt m Int
  PutInt :: Int -> HasInt m ()

getInt :: HasInt :> es => Eff es Int
getInt = send GetInt

putInt :: HasInt :> es => Int -> Eff es ()
putInt = send . PutInt

runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a
runHasInt n =
  fmap fst . runState () . fmap fst . runState n . fmap fst . runState True . reinterpret3 \case
    GetInt   -> get
    PutInt i -> put i

data Ex = Ex
  deriving stock (Eq, Show)
  deriving anyclass (Exception)

collatzStart :: Integer
collatzStart = 9780657630

collatzLength :: Int
collatzLength = 1132

-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
collatz :: (State Integer :> es, State Int :> es) => Eff es ()
collatz = get @Integer >>= \case
  1 -> pure ()
  n -> if even n
       then do put $ n `div` 2
               modify @Int (+1)
               collatz
       else do put $ 3*n + 1
               modify @Int (+1)
               collatz
{-# NOINLINE collatz #-}