Compare commits
2 Commits
c2088a6967
...
2facde2377
Author | SHA1 | Date | |
---|---|---|---|
2facde2377 | |||
e08de1f8f7 |
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user