diff --git a/test/Main.purs b/test/Main.purs index f91f98c..7ac79f1 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -2,10 +2,41 @@ module Test.Main where import Prelude -import Effect (Effect) -import Effect.Class.Console (log) +import Control.Alternative (guard, (<|>)) +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 -main = do - log "🍝" - log "You should add some tests." +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)) + +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