module Main where import Data.Functor.Identity import qualified Control.Monad.MultiState as MS import qualified Control.Monad.MultiReader as MR import Types.Data.List ( Cons, Null ) import Control.Applicative ( Applicative, (<$>), (<*>) ) type Tests = [(Bool, String)] runEvalMS :: MS.MultiStateT Null Identity a -> a runEvalMS = runIdentity . MS.evalMultiStateT runEvalMR :: MR.MultiReaderT Null Identity a -> a runEvalMR = runIdentity . MR.evalMultiReaderT runnerMS :: a -> MS.MultiStateT (Cons a Null) Identity a -> a runnerMS x m = runIdentity $ MS.evalMultiStateT $ MS.withMultiState x m runnerMR :: a -> MR.MultiReaderT (Cons a Null) Identity a -> a runnerMR x m = runIdentity $ MR.evalMultiReaderT $ MR.withMultiReader x m runnerMS_ :: a -> MS.MultiStateT (Cons a Null) Identity b -> a runnerMS_ x m = runIdentity $ MS.evalMultiStateT $ MS.withMultiState x (m >> MS.mGet) runnerMR_ :: a -> MR.MultiReaderT (Cons a Null) Identity b -> a runnerMR_ x m = runIdentity $ MR.evalMultiReaderT $ MR.withMultiReader x (m >> MR.mAsk) intRunnerMS :: Int -> MS.MultiStateT (Cons Int Null) Identity Int -> Int intRunnerMS = runnerMS intRunnerMS_ :: Int -> MS.MultiStateT (Cons Int Null) Identity b -> Int intRunnerMS_ = runnerMS_ intRunnerMR :: Int -> MR.MultiReaderT (Cons Int Null) Identity Int -> Int intRunnerMR = runnerMR intRunnerMR_ :: Int -> MR.MultiReaderT (Cons Int Null) Identity b -> Int intRunnerMR_ = runnerMR_ mrAskTuple :: ( Applicative m , MR.MonadMultiReader a m , MR.MonadMultiReader b m) => m (a,b) mrAskTuple = (,) <$> MR.mAsk <*> MR.mAsk msGetTuple :: ( Applicative m , MS.MonadMultiState a m , MS.MonadMultiState b m) => m (a,b) msGetTuple = (,) <$> MS.mGet <*> MS.mGet testsMultiState :: Tests testsMultiState = [ (1 == runIdentity (Identity (1::Int)) , "identity"), (2 == intRunnerMS_ 2 (return ()) , "multistate getConfig"), (3 == intRunnerMS_ 100 (MS.mSet (3::Int)) , "multistate setConfig"), (4 == intRunnerMS_ 4 (MS.mGet >>= \x -> MS.mSet (x::Int)) , "multistate setConfig"), (5 == intRunnerMS (4::Int) (MS.withMultiState (5::Int) MS.mGet) , "multistate nesting"), (6 == intRunnerMS (4::Int) ( MS.mSet (100::Int) >> MS.withMultiState (6::Int) MS.mGet) , "multistate nesting"), (7 == intRunnerMS (4::Int) ( MS.withMultiState (100::Int) $ MS.mSet (7::Int) >> MS.mGet) , "multistate nesting"), ((True, 'a') == ( runEvalMS $ MS.withMultiState True $ MS.withMultiState 'a' $ msGetTuple ) , "multistate multiple types"), ((True, 'b') == ( runEvalMS $ MS.withMultiState True $ MS.withMultiState 'a' $ MS.withMultiState 'b' $ msGetTuple ) , "multistate multiple types"), ((False, 'a') == ( runEvalMS $ MS.withMultiState True $ MS.withMultiState 'a' $ MS.withMultiState False $ msGetTuple ) , "multistate multiple types"), (test13MS , "askRaw") ] testsMultiReader :: Tests testsMultiReader = [ (1 == runIdentity (Identity (1::Int)) , "identity"), (2 == intRunnerMR_ 2 (return ()) , "multistate getConfig"), (5 == intRunnerMR (4::Int) (MR.withMultiReader (5::Int) MR.mAsk) , "multistate nesting"), ((True, 'a') == ( runEvalMR $ MR.withMultiReader True $ MR.withMultiReader 'a' $ mrAskTuple ) , "multistate multiple types"), ((True, 'b') == ( runEvalMR $ MR.withMultiReader True $ MR.withMultiReader 'a' $ MR.withMultiReader 'b' $ mrAskTuple ) , "multistate multiple types"), ((False, 'a') == ( runEvalMR $ MR.withMultiReader True $ MR.withMultiReader 'a' $ MR.withMultiReader False $ mrAskTuple ) , "multistate multiple types"), (test13MR , "getRaw") ] tests :: Tests tests = testsMultiState ++ testsMultiReader test13MR :: Bool test13MR = runIdentity $ MR.evalMultiReaderT $ MR.withMultiReader True $ MR.withMultiReader 'a' $ do c <- MR.mAskRaw return $ runIdentity $ MR.evalMultiReaderT $ MR.withMultiReaders c $ do b <- MR.mAsk return (b::Bool) test13MS :: Bool test13MS = runIdentity $ MS.evalMultiStateT $ MS.withMultiState True $ MS.withMultiState 'a' $ do c <- MS.mGetRaw return $ runIdentity $ MS.evalMultiStateT $ MS.withMultiStates c $ do b <- MS.mGet return (b::Bool) main :: IO () main = do mapM_ (putStrLn . ("error: "++) . snd) $ filter (\(b, _) -> not b) tests putStrLn $ "ran " ++ show (length tests) ++ " tests (no further output = good)" return () {- main = do evalStateT (evalMultiReaderT $ withConfig 'a' $ do x <- withConfig 'b' getConfig lift $ lift $ print (x::Char) y <- get lift $ lift $ print (y::Int) return () ) (1::Int) evalMultiReaderT $ withConfig 'a' $ evalStateT ( do x <- getConfig lift $ lift $ print (x::Char) y <- get lift $ lift $ print (y::Int) return () ) (1::Int) main = do evalStateT (evalMultiStateT $ withConfig 'a' $ do x <- withConfig 'b' getConfig lift $ lift $ print (x::Char) y <- get lift $ lift $ print (y::Int) return () ) (1::Int) evalMultiStateT $ withConfig 'a' $ evalStateT ( do x <- getConfig lift $ lift $ print (x::Char) y <- get lift $ lift $ print (y::Int) return () ) (1::Int) -}