StateSpec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

module Parameterized.Control.Monad.Trans.State.Strict.StateSpec (main, spec) where

import Control.Applicative
import Control.Monad.Trans.State.Strict
import Parameterized.Control.Monad.Trans.State.Strict
import Parameterized.Control.Monad
import Data.Diverse
import Data.Functor.Identity
import Data.Semigroup
import Text.Read (readMaybe)
import Test.Hspec


-- `main` is here so that this module can be run from GHCi on its own.  It is
-- not needed for automatic spec dicovery.
main :: IO ()
main = hspec spec

-- | NB. Normally you'd use @MaybeT (StateT s) r@ and not
-- @StateT s Maybe r@ because the state is lost on failure (Nothing),
-- but for the purposes of this test, I want test funtionality of @StateT s m@
-- where m is an Alternative.
manyIntMaybeState :: StateT (Many '[Int]) Maybe String
manyIntMaybeState= do
    s <- get
    let r = fetch @Int s
    case r of
        0 -> empty
        r' -> do
           put $ replace @Int s (r' + 1)
           pure $ show r'

manyBoolMaybeState :: StateT (Many '[Bool]) Maybe String
manyBoolMaybeState = do
    s <- get
    let r = fetch @Bool s
    case r of
        False -> empty
        r' -> do
            put $ replace @Bool s False
            pure $ show r'

--------------------------------

intToString :: Int -> Identity (Bool, String)
intToString i = Identity (even i, show i)

stringToBool :: String -> Identity (Int, Bool)
stringToBool s = case readMaybe s of
    Nothing -> Identity (0, False)
    Just i -> Identity (i, True)

--------------------------------

spec :: Spec
spec = do

    describe "ManyState" $ do
        it "pappend with empty doesn't change the type of the parameter" $ do
            let r1 = ManyState manyIntMaybeState `pappend` pempty
                r2 = pempty `pappend` ManyState manyIntMaybeState
                -- the "parameter" doesn't change when `pappend` with empty
                r1' = runManyState r1 :: StateT (Many '[Int]) Maybe String
                r2' = runManyState r2 :: StateT (Many '[Int]) Maybe String
            -- functionality unchanged
            runStateT r1' (single (5 :: Int)) `shouldBe` Just ("5", single (6 :: Int))
            runStateT r2' (single (5 :: Int)) `shouldBe` Just ("5", single (6 :: Int))

        it "it can 'pappend' to combine state runners 'Alternative'ly" $ do
            let r = ManyState manyIntMaybeState `pappend`
                        ManyState manyBoolMaybeState
                -- the "parameter" is combined
                r' = runManyState r :: StateT (Many '[Int, Bool]) Maybe String
            -- functionality of both state in an Alternative fashion
            -- manyIntMaybeState suceeded
            runStateT r' ( (5 :: Int) ./ True ./ nil) `shouldBe` Just ("5", (6 :: Int) ./ True ./ nil)
            runStateT r' ( (5 :: Int) ./ False ./ nil) `shouldBe` Just ("5", (6 :: Int) ./ False ./ nil)
            -- manyBoolMaybeState suceeded
            runStateT r' ( (0 :: Int) ./ True ./ nil) `shouldBe` Just ("True", (0 :: Int) ./ False ./ nil)
            -- Both failed
            runStateT r' ( (0 :: Int) ./ False ./ nil) `shouldBe` Nothing

        it "it can 'papply' to combine state runners 'Applicative'ly" $ do
            let r = (\a b -> a <> "." <> b) <$> ManyState manyIntMaybeState &<*>
                        ManyState manyBoolMaybeState
                -- the "parameter" is combined
                r' = runManyState r :: StateT (Many '[Int, Bool]) Maybe String
            -- functionality of both state functions in an Applicative fashion
            runStateT r' ( (5 :: Int) ./ True ./ nil) `shouldBe` Just ("5.True", (6 :: Int) ./ False ./ nil)
            runStateT r' ( (5 :: Int) ./ False ./ nil) `shouldBe` Nothing
            runStateT r' ( (0 :: Int) ./ True ./ nil) `shouldBe` Nothing
            runStateT r' ( (0 :: Int) ./ False ./ nil) `shouldBe` Nothing


        it "it can 'pbind' to combine state runners 'Monad'ically" $ do
            let r = ManyState manyIntMaybeState &>>= \a ->
                        case a of
                            "1" -> ManyState manyBoolMaybeState
                            _ -> empty
                -- the "parameter" is combined
                r' = runManyState r :: StateT (Many '[Int, Bool]) Maybe String
            -- functionality of both state functions in an Monad fashion
            runStateT r' ( (1 :: Int) ./ True ./ nil) `shouldBe` Just ("True", (2 :: Int) ./ False ./ nil)
            runStateT r' ( (1 :: Int) ./ False ./ nil) `shouldBe` Nothing
            runStateT r' ( (5 :: Int) ./ True ./ nil) `shouldBe` Nothing
            runStateT r' ( (5 :: Int) ./ False ./ nil) `shouldBe` Nothing
            runStateT r' ( (0 :: Int) ./ True ./ nil) `shouldBe` Nothing
            runStateT r' ( (0 :: Int) ./ False ./ nil) `shouldBe` Nothing

    describe "ChangingState" $ do
        it "ppure id doesn't change the type of the parameter" $ do
            let r1 = (ppure @_ @_ @(Int, Int) id) &<*> changingState intToString
                -- the "parameter" doesn't change
                r1' = r1 :: ChangingState Identity (Int, String) Bool
            -- functionality unchanged
            runChangingState r1' (5 :: Int) `shouldBe` Identity (False, "5")
            runChangingState r1' (10 :: Int) `shouldBe` Identity (True, "10")

        it "it can 'papply' to combine state runners 'Applicative'ly" $ do
            let r = (\b i -> show b <> "." <> show i) <$> changingState intToString &<*>
                        changingState stringToBool
                -- the "parameter" is combined
                r' = r :: ChangingState Identity (Int, Bool) String
            -- functionality of both state functions in an Applicative fashion
            runChangingState r' (5 :: Int) `shouldBe` Identity ("False.5", True)
            runChangingState r' (10 :: Int) `shouldBe` Identity ("True.10", True)

        it "it can 'pbind' to combine state runners 'Monad'ically" $ do
            let r = changingState intToString &>>= \b ->
                    changingState stringToBool &>>= \i ->
                    ppure @_ @_ @(Bool, Bool) (show b <> "." <> show i)
                -- the "parameter" is combined
                r' = r :: ChangingState Identity (Int, Bool) String
            -- functionality of both state functions in an Applicative fashion
            runChangingState r' (5 :: Int) `shouldBe` Identity ("False.5", True)
            runChangingState r' (10 :: Int) `shouldBe` Identity ("True.10", True)