Add tests for the logic monad transformer

This commit is contained in:
Danila Fedorin 2023-02-28 18:54:24 -08:00
parent 529879736a
commit 66de5244af
1 changed files with 37 additions and 6 deletions

View File

@ -2,10 +2,41 @@ module Test.Main where
import Prelude import Prelude
import Effect (Effect) import Control.Alternative (guard, (<|>))
import Effect.Class.Console (log) import Control.Monad.Logic.Class (class MonadLogic, interleave)
import Control.Monad.Logic.Trans (SFKT, 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.List (List(..), (:))
import Data.Maybe (Maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested(type (/\), (/\))
main :: Effect Unit test :: forall m. MonadState String m => MonadReader Int m => MonadLogic m => m (Int /\ String)
main = do test =
log "🍝" do
log "You should add some tests." (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))
solutions :: forall a m. Monad m => SFKT m a -> m (List a)
solutions m = runSFKT m ((<$>) <<< (:)) (pure Nil)
order1 :: Maybe String
order1 = show <$> (runReaderT (solutions (fst <$> runStateT (test >>= \(x /\ s) -> guard (x `mod` 2 == 1) >>= \_ -> pure (x /\ s)) "initial")) 11)
order2 :: Maybe String
order2 = show <$> fst <$> (runStateT (runReaderT (solutions (test >>= \(x /\ s) -> guard (x `mod` 2 == 1) >>= \_ -> pure (x /\ s))) 11) "initial")
order3 :: Maybe String
order3 = show <$> fst <$> (runStateT (runReaderT (solutions test) 0) "initial")
main :: Maybe String
main = order1