logict/test/Main.purs

module Test.Main where

import Prelude

import Control.Alternative (guard, (<|>))
import Control.Monad.Logic.Class (class MonadLogic, interleave)
import Control.Monad.Logic.Trans (runSFKT)
import Control.Monad.Reader.Class (class MonadReader)
import Control.Monad.Reader.Trans (runReaderT, ask)
import Control.Monad.State.Class (class MonadState)
import Control.Monad.State.Trans (runStateT, put, get)
import Data.Maybe (Maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested(type (/\), (/\))

test :: forall m. MonadState String m => MonadReader Int m => MonadLogic m => m (Int /\ String)
test =
    do
        (yield 1 <|> yield 2) `interleave` (yield 3 <|> yield 4)
    where
        yield n = do
            offset <- ask
            oldState <- get
            put (show n)
            newState <- get
            pure ((offset+n) /\ (oldState <> " became " <> newState))

order1 :: Maybe String
order1 = show <$> (runReaderT (runSFKT (fst <$> runStateT (test >>= \(x /\ s) -> guard (x `mod` 2 == 1) >>= \_ -> pure (x /\ s)) "initial")) 11)

order2 :: Maybe String
order2 = show <$> fst <$> (runStateT (runReaderT (runSFKT (test >>= \(x /\ s) -> guard (x `mod` 2 == 1) >>= \_ -> pure (x /\ s))) 11) "initial")

order3 :: Maybe String
order3 = show <$> fst <$> (runStateT (runReaderT (runSFKT test) 0) "initial")

main :: Maybe String
main = order1