Compare commits

...

2 Commits

Author SHA1 Message Date
Danila Fedorin 2facde2377 Update test code 2023-03-04 19:01:57 -08:00
Danila Fedorin e08de1f8f7 Add MonadLogic instence for ReaderT 2023-03-04 19:01:23 -08:00
2 changed files with 13 additions and 10 deletions

View File

@ -3,8 +3,8 @@ module Control.Monad.Logic.Class (class MonadLogic, msplit, interleave, fbind, r
import Prelude
import Control.MonadPlus (class MonadPlus, (<|>), empty)
import Control.Monad.State (runStateT)
import Control.Monad.State.Trans (StateT(..))
import Control.Monad.State.Trans (StateT(..), runStateT)
import Control.Monad.Reader.Trans (ReaderT(..), runReaderT)
import Data.Tuple.Nested (type (/\), (/\))
import Data.Maybe (Maybe(..))
@ -32,3 +32,10 @@ instance MonadLogic m => MonadLogic (StateT s m) where
Nothing -> pure (Nothing /\ s)
Just ((a /\ s') /\ m) -> pure (Just (a /\ (StateT $ const m)) /\ s')
interleave m1 m2 = StateT $ \s -> runStateT m1 s <|> runStateT m2 s
instance MonadLogic m => MonadLogic (ReaderT r m) where
msplit sm = ReaderT $ \r -> do
msplit (runReaderT sm r) >>= case _ of
Nothing -> pure Nothing
Just (a /\ m) -> pure $ Just $ a /\ (ReaderT $ const m)
interleave m1 m2 = ReaderT $ \r -> runReaderT m1 r <|> runReaderT m2 r

View File

@ -4,12 +4,11 @@ import Prelude
import Control.Alternative (guard, (<|>))
import Control.Monad.Logic.Class (class MonadLogic, interleave)
import Control.Monad.Logic.Trans (SFKT, runSFKT)
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.List (List(..), (:))
import Data.Maybe (Maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested(type (/\), (/\))
@ -26,17 +25,14 @@ test =
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)
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 (solutions (test >>= \(x /\ s) -> guard (x `mod` 2 == 1) >>= \_ -> pure (x /\ s))) 11) "initial")
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 (solutions test) 0) "initial")
order3 = show <$> fst <$> (runStateT (runReaderT (runSFKT test) 0) "initial")
main :: Maybe String
main = order1