Difference between revisions of "The Monadic Way/Part II"
Jump to navigation
Jump to search
DonStewart (talk | contribs) m (category) |
BrettGiles (talk | contribs) m (Headings) |
||
| Line 3: | Line 3: | ||
''Note: this is just the skeleton of this part, with code but very little text'' |
''Note: this is just the skeleton of this part, with code but very little text'' |
||
| − | ==Summary of the |
+ | ==Summary of the previous part== |
<div id="BasicEval"> |
<div id="BasicEval"> |
||
| Line 24: | Line 24: | ||
| − | ==Taking |
+ | ==Taking complexity out of a monad: Monadic transformers== |
We have seen how the complexity of (>>=) was growing by adding |
We have seen how the complexity of (>>=) was growing by adding |
||
| Line 36: | Line 36: | ||
(StateT). |
(StateT). |
||
| − | ===The StateT |
+ | ===The StateT monad: A monad container=== |
Let me introduce StateT with some useful functions: |
Let me introduce StateT with some useful functions: |
||
| Line 381: | Line 381: | ||
| − | ==The |
+ | ==The final cut== |
| − | ===StateT for output, counter, debug, using the |
+ | ===StateT for output, counter, debug, using the standard library=== |
<haskell> |
<haskell> |
||
| Line 551: | Line 551: | ||
Let's see if we'll time for it... Fist we must complete the text above!! |
Let's see if we'll time for it... Fist we must complete the text above!! |
||
| − | ==Suggested |
+ | ==Suggested readings== |
Cale Gibbard, [http://haskell.org/haskellwiki/Monads_as_Containers Monads as Containers] |
Cale Gibbard, [http://haskell.org/haskellwiki/Monads_as_Containers Monads as Containers] |
||
Revision as of 19:02, 11 January 2007
Note: this is the second part of The Monadic Way
Note: this is just the skeleton of this part, with code but very little text
Summary of the previous part
> module TheMonadicWay where
> data Term = Con Int
> | Add Term Term
> deriving (Show)
> type Exception = String
> type O = String
> type Output = String
> formatLine :: Term -> Int -> Output
> formatLine t a = "eval (" ++ show t ++ ") <= " ++ show a ++ " - "
Taking complexity out of a monad: Monadic transformers
We have seen how the complexity of (>>=) was growing by adding operations to be done.
We will do the opposite: we will implement a state transformer (I copied StateT).
We will embed our monad in the StateT monad and we will start moving state and output from the inner monad (our one) to the outer monad (StateT).
The StateT monad: A monad container
Let me introduce StateT with some useful functions:
> newtype StateT s m a = StateT {runStateT :: s -> m (a,s) } --StateT (s -> m (a,s))
> instance Monad m => Monad (StateT s m) where
> return a = StateT (\s -> return (a,s))
> StateT m1 >>= k = StateT (\s -> do ~(a,s1) <- m1 s
> let StateT m2 = k a
> m2 s1)
> -- | Execute a stateful computation, as a result we get
> -- the result of the computation, and the final state.
> runState :: s -> StateT s m a -> m (a,s)
> runState s (StateT m) = m s
> -- | Execute a stateful computation, ignoring the final state.
> evalState :: Functor m => s -> StateT s m a -> m a
> evalState s m = fmap fst (runState s m)
> -- | Execute a stateful computation, just for the side effect.
> execState :: Functor m => s -> StateT s m a -> m s
> execState s m = fmap snd (runState s m)
> lift :: (Monad m) => m a -> StateT s m a
> lift m = StateT (\s -> do x <- m
> return (x,s))
StateT is pleased to meet you!.
StateT as a counter, and monadic evaluator with output and exceptions
And now out monad, with state out from it:
> data MTa a = FailTa Exception
> | DoneTa {unpackDoneTa :: (a,O) }
> deriving (Show)
> instance Monad MTa where
> return a = DoneTa (a, "")
> m >>= f = case m of
> FailTa e -> FailTa e
> DoneTa (a, x) -> case (f a) of
> FailTa e1 -> FailTa e1
> DoneTa (b, y) -> DoneTa (b, x ++ y)
> instance Functor MTa where
> fmap _ (FailTa e) = FailTa e
> fmap f (DoneTa (r,o)) = DoneTa ((f r),o)
> raiseTa_SIOE :: O -> StateT Int MTa a
> raiseTa_SIOE e = lift (FailTa e)
> printTa_SIOE :: O -> StateT Int MTa ()
> printTa_SIOE x = lift (DoneTa ((), x))
> incTaState :: StateT Int MTa ()
> incTaState = StateT (\s -> return ((), s + 1))
> evalTa_SIOE :: Term -> StateT Int MTa Int
> evalTa_SIOE (Con a) = do incTaState
> printTa_SIOE (formatLine (Con a) a)
> return a
> evalTa_SIOE (Add t u) = do a <- evalTa_SIOE t
> b <- evalTa_SIOE u
> incTaState
> let out = formatLine (Add t u) (a + b)
> printTa_SIOE out
> if (a+b) == 42
> then raiseTa_SIOE $
> out ++ "The Ultimate Answer Has Been Computed!! Now I'm tired!"
> else return (a + b)
> runEvalTa :: Term -> String
> runEvalTa exp = case runStateT (evalTa_SIOE exp) 0 of
> FailTa e -> e
> DoneTa (~(r,s),o)-> "Result = " ++ show r ++
> "; Iteration = " ++ show s ++
> "; Output = " ++ o
> runEvalTa1 :: Term -> String
> runEvalTa1 exp = case runState 0 (evalTa_SIOE exp) of
> FailTa e -> e
> DoneTa ((r,s),o) -> "Result = " ++ show r ++
> "; Iteration = " ++ show s ++
> "; Output = " ++ o
> runEvalTa2 :: Term -> String
> runEvalTa2 exp = case evalState 0 (evalTa_SIOE exp) of
> FailTa e -> e
> DoneTa (r,o) -> "Result = " ++ show r ++ "; Output = " ++ o
> runEvalTa3 :: Term -> String
> runEvalTa3 exp = case execState 0 (evalTa_SIOE exp) of
> FailTa e -> e
> DoneTa (s,o) -> "Iterations = " ++ show s ++ "; Output = " ++ o
StateT to keep output and counter, and monadic evaluator with (only) exceptions
Now we take output away from the inner monad and place it in the outer one (StateT):
> data MTb a = FailTb Exception
> | DoneTb {unpackDoneTb :: a }
> deriving (Show)
> type StateIO = (O,Int)
> instance Monad MTb where
> return a = DoneTb a
> m >>= f = case m of
> FailTb e -> FailTb e
> DoneTb a -> f a
> instance Functor MTb where
> fmap _ (FailTb e) = FailTb e
> fmap f (DoneTb b) = DoneTb (f b)
> raiseTb_SIOE :: O -> StateT StateIO MTb a
> raiseTb_SIOE e = lift (FailTb e)
> printTb_SIOE :: O -> StateT StateIO MTb ()
> printTb_SIOE x = StateT (\(o,s) -> return ((), (o ++ x,s)))
> incTbStateIO :: StateT StateIO MTb ()
> incTbStateIO = StateT (\(o,s) -> return ((), (o,s + 1)))
> evalTb_SIOE :: Term -> StateT StateIO MTb Int
> evalTb_SIOE (Con a) = do incTbStateIO
> printTb_SIOE (formatLine (Con a) a)
> return a
> evalTb_SIOE (Add t u) = do a <- evalTb_SIOE t
> b <- evalTb_SIOE u
> incTbStateIO
> let out = formatLine (Add t u) (a + b)
> printTb_SIOE out
> if (a+b) == 42
> then raiseTb_SIOE $
> out ++ "The Ultimate Answer Has Been Computed!! Now I'm tired!"
> else return (a + b)
We take away complexity from >>= and put it in the function we need to use to manipulate content in our StateT monad.
These are some wrapper to the evaluator to get the result and the side-effects produced by evaluation:
> runEvalTb :: Term -> String
> runEvalTb exp = case runStateT (evalTb_SIOE exp) ("",0) of
> FailTb e -> e
> DoneTb (r,~(o,s)) -> "Result = " ++ show r ++
> "; Iteration = " ++ show s ++
> "; Output = " ++ o
> runEvalTb1 :: Term -> String
> runEvalTb1 exp = case runState ("",0) (evalTb_SIOE exp) of
> FailTb e -> e
> DoneTb (r,~(o,s)) -> "Result = " ++ show r ++
> "; Iteration = " ++ show s ++
> "; Output = " ++ o
> runEvalTb2 :: Term -> String
> runEvalTb2 exp = case evalState ("",0) (evalTb_SIOE exp) of
> FailTb e -> e
> DoneTb r -> "Result = " ++ show r
> runEvalTb3 :: Term -> String
> runEvalTb3 exp = case execState ("",0) (evalTb_SIOE exp) of
> FailTb e -> e
> DoneTb (o,s) -> "Iterations = " ++ show s ++
> " - Output = " ++ o
StateT to keep output, counter and debug. The monadic evaluator is only for failable computations
And now we will keep in the inner monad only the result of the evaluation.
> data MT a = FailT Exc
> | DoneT {unpackDoneT :: a }
> deriving (Show)
> type Exc = String
> type IOstack = [Output]
> newtype StateTIO = StateTIO {unPackStateTIO :: (IOstack,Exc,Int)}
> deriving(Show)
> instance Monad MT where
> return a = DoneT a
> m >>= f = case m of
> FailT e -> FailT e
> DoneT a -> f a
> instance Functor MT where
> fmap _ (FailT a) = FailT a
> fmap f (DoneT a) = DoneT (f a)
Simple isn't it?
The complexity is now below:
> stopExecT_SIOE :: Output -> StateT StateTIO MT Int
> stopExecT_SIOE exc = StateT (\s -> do x <- FailT exc
> return (x, s))
> catchT_SIOE exc = StateT (\(StateTIO (o,e,s)) ->
> return ((), StateTIO (o ,"Exception at Iteration " ++
> show s ++ ": " ++ exc ++ " - " ++ e,s)))
> printT_SIOE :: Output -> StateT StateTIO MT ()
> printT_SIOE x = StateT (\(StateTIO (o,e,s)) -> return ((), StateTIO (x:o,e,s)))
> incTstateIO :: StateT StateTIO MT ()
> incTstateIO = StateT (\(StateTIO (o,e,s)) -> return ((),StateTIO (o,e,s + 1)))
> evalT_SIOE :: Term -> StateT StateTIO MT Int
> evalT_SIOE (Con a) = do incTstateIO
> printT_SIOE (formatLine (Con a) a)
> return a
> evalT_SIOE (Add t u) = do a <- evalT_SIOE t
> b <- evalT_SIOE u
> incTstateIO
> let out = formatLine (Add t u) (a + b)
> printT_SIOE out
> case (a+b) of
> 42 -> do catchT_SIOE "The Ultimate Answer Has Been Computed!! Now I'm tired!"
> return (a+b)
> 11 -> stopExecT_SIOE "11.... I do not like this number!"
> otherwise -> return (a + b)
But now we have exceptions to stop execution and debugging output.
Some helper functions:
> runEvalT :: Term -> String
> runEvalT exp = case runStateT (evalT_SIOE exp) (StateTIO ([],"",0)) of
> FailT e -> e
> DoneT (r,StateTIO (o,e,s)) -> "Result = " ++ show r ++ "; Iteration = " ++ show s ++
> "; Output = " ++ show o ++ " - Exceptions = " ++ e
> runEvalT1 :: Term -> String
> runEvalT1 exp = case runState (StateTIO ([],"",0)) (evalT_SIOE exp) of
> FailT e -> e
> DoneT (r,StateTIO(o,e,s)) -> "Result = " ++ show r ++ "; Iteration = " ++ show s
> ++ "; Output = " ++ show o ++ " - Exceptions = " ++ e
> runEvalT2 :: Term -> String
> runEvalT2 exp = case evalState (StateTIO ([],"",0)) (evalT_SIOE exp) of
> FailT e -> e
> DoneT r -> "Result = " ++ show r
> runEvalT3 :: Term -> String
> runEvalT3 exp = case execState (StateTIO ([],"",0)) (evalT_SIOE exp) of
> FailT e -> e
> DoneT (StateTIO (o,e,s)) -> "Iterations = " ++ show s ++
> " - Output = " ++ show o ++ " - Exceptions = " ++ e
> showOut :: [String] -> IO ()
> showOut [] = return ()
> showOut (a:xs) = do print a
> showOut xs
> runMyEval :: Term -> IO ()
> runMyEval exp = let StateTIO (a,b,c) = unpackDoneT $ execState (StateTIO ([],"",0)) (evalT_SIOE exp) in
> showOut $ reverse a
Some tests:
*TheMonadicWay> runEvalT (Add (Con 18) (Add (Con 12) (Add (Con 10) (Con 2))))
"Result = 42; Iteration = 7; Output = [\"eval (Add (Con 18) (Add (Con 12) (Add (Con 10) (Con 2)))) <= 42 - \",
\"eval (Add (Con 12) (Add (Con 10) (Con 2))) <= 24 - \",
\"eval (Add (Con 10) (Con 2)) <= 12 - \",
\"eval (Con 2) <= 2 - \",
\"eval (Con 10) <= 10 - \",
\"eval (Con 12) <= 12 - \",
\"eval (Con 18) <= 18 - \"] -
Exceptions = Exception at Iteration 7: The Ultimate Answer Has Been Computed!! Now I'm tired! - "
*TheMonadicWay> runEvalT2 (Add (Con 18) (Add (Con 12) (Add (Con 10) (Con 2))))
"Result = 42"
*TheMonadicWay> runEvalT3 (Add (Con 18) (Add (Con 12) (Add (Con 10) (Con 2))))
"Iterations = 7 - Output = [\"eval (Add (Con 18) (Add (Con 12) (Add (Con 10) (Con 2)))) <= 42 - \",
\"eval (Add (Con 12) (Add (Con 10) (Con 2))) <= 24 - \",
\"eval (Add (Con 10) (Con 2)) <= 12 - \",
\"eval (Con 2) <= 2 - \",
\"eval (Con 10) <= 10 - \",
\"eval (Con 12) <= 12 - \",
\"eval (Con 18) <= 18 - \"] -
Exceptions = Exception at Iteration 7: The Ultimate Answer Has Been Computed!! Now I'm tired! - "
*TheMonadicWay> runEvalT3 (Add (Con 1) (Add (Con 7) (Add (Con 1) (Con 2))))
"Iterations = 7 - Output = [\"eval (Add (Con 1) (Add (Con 5) (Add (Con 1) (Con 2)))) <= 9 - \",
\"eval (Add (Con 5) (Add (Con 1) (Con 2))) <= 8 - \",
\"eval (Add (Con 1) (Con 2)) <= 3 - \",
\"eval (Con 2) <= 2 - \",
\"eval (Con 1) <= 1 - \",
\"eval (Con 5) <= 5 - \",
\"eval (Con 1) <= 1 - \"] - Exceptions = "
*TheMonadicWay> runEvalT3 (Add (Con 1) (Add (Con 7) (Add (Con 1) (Con 2))))
"11.... I do not like this number!"
*TheMonadicWay> runMyEval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) (Con 10))
"eval (Con 10) <= 10 - "
"eval (Con 2) <= 2 - "
"eval (Add (Con 10) (Con 2)) <= 12 - "
"eval (Con 12) <= 12 - "
"eval (Con 3) <= 3 - "
"eval (Add (Con 12) (Con 3)) <= 15 - "
"eval (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) <= 27 - "
"eval (Con 3) <= 3 - "
"eval (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) <= 30 - "
"eval (Con 10) <= 10 - "
"eval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) (Con 10)) <= 40 - "
*TheMonadicWay>
The final cut
StateT for output, counter, debug, using the standard library
module MyStateT where
import Control.Monad.State hiding (State)
data Term = Con Int
| Add Term Term
deriving (Show)
type IOStack = [Output]
type Output = String
type Debug = [String]
data EvalST = State {getIOS :: IOStack, getDebug :: Debug, getCount:: Int}
deriving(Show)
type Exception = String
data MT a = Fail Exception
| Done {unpackDone :: a }
deriving (Show)
type Eval s a = StateT s MT a
instance Monad MT where
return a = Done a
m >>= f = case m of
Fail e -> Fail e
Done a -> f a
instance Functor MT where
fmap _ (Fail a) = Fail a
fmap f (Done a) = Done (f a)
emptyState = State [] [] 0
stopExecT exc = lift $ Fail exc
catchT e = do st <- get
let s = getCount st
let es = getDebug st
let o = getIOS st
let exc = "Debug msg at Iteration " ++ show s ++ ": " ++ e
put $ State o (exc:es) s
printT :: Output -> Eval EvalST ()
printT o = do st <- get
let s = getCount st
let e = getDebug st
let os = getIOS st
let out = show s ++ " - " ++ o
put $ State (out:os) e s
incTcounter :: Eval EvalST ()
incTcounter = do st <- get
let s = getCount st
let e = getDebug st
let o = getIOS st
put $ State o e (s+1)
evalT :: Term -> Eval EvalST Int
evalT (Con a) = do incTcounter
printT (formatLine (Con a) a)
return a
evalT (Add t u) = do a <- evalT t
b <- evalT u
incTcounter
let out = formatLine (Add t u) (a + b)
printT out
case (a+b) of
42 -> do catchT "The Ultimate Answer Has Been Computed!! Now I'm tired!"
return (a+b)
11 -> stopExecT "11.... I do not like this number!"
otherwise -> return (a + b)
formatLine :: Term -> Int -> Output
formatLine t a = "eval (" ++ show t ++ ") <= " ++ show a
printAll :: [String] -> IO ()
printAll [] = return ()
printAll (a:xs) = do putStrLn a
printAll xs
eval :: Term -> IO ()
eval exp = case execStateT (evalT exp) emptyState of
Fail e -> putStrLn e
Done (State a b c )
-> do printAll $ reverse a
putStrLn $ show $ unpackDone $
evalStateT (evalT exp) emptyState
case b of
[] -> putStrLn $ "Iterations: " ++ show c
_ -> do printAll $ reverse b
putStrLn $ "Iterations: " ++ show c
---- testing functions ----
runEvalT :: Term -> String
runEvalT exp = case runStateT (evalT exp) emptyState of
Fail e -> e
Done (r,State o e s) -> "Result = " ++ show r ++
"; Iteration = " ++ show s ++
"; Output = " ++ show o ++
" - Exceptions = " ++ show e
getEvalResult :: Term -> String
getEvalResult exp = case evalStateT (evalT exp) emptyState of
Fail e -> e
Done r -> "Result = " ++ show r
getSideEffects :: Term -> String
getSideEffects exp = case execStateT (evalT exp) emptyState of
Fail e -> e
Done (State o e s) -> "Iterations = " ++ show s ++
" - Output = " ++ show o ++
" - Exceptions = " ++ show e
{-
Some runs:
*MyStateT> eval (Add (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 30))) (Con 3)) (Con 10))
1 - eval (Con 40) <= 40
2 - eval (Con 2) <= 2
3 - eval (Add (Con 40) (Con 2)) <= 42
4 - eval (Con 12) <= 12
5 - eval (Con 30) <= 30
6 - eval (Add (Con 12) (Con 30)) <= 42
7 - eval (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 30))) <= 84
8 - eval (Con 3) <= 3
9 - eval (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 30))) (Con 3)) <= 87
10 - eval (Con 10) <= 10
11 - eval (Add (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 30))) (Con 3)) (Con 10)) <= 97
97
Debug msg at Iteration 3: The Ultimate Answer Has Been Computed!! Now I'm tired!
Debug msg at Iteration 6: The Ultimate Answer Has Been Computed!! Now I'm tired!
Iterations: 11
*MyStateT>
*MyStateT> eval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) (Con 2))
1 - eval (Con 10) <= 10
2 - eval (Con 2) <= 2
3 - eval (Add (Con 10) (Con 2)) <= 12
4 - eval (Con 12) <= 12
5 - eval (Con 3) <= 3
6 - eval (Add (Con 12) (Con 3)) <= 15
7 - eval (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) <= 27
8 - eval (Con 5) <= 5
9 - eval (Con 2) <= 2
10 - eval (Add (Con 5) (Con 2)) <= 7
11 - eval (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) <= 34
12 - eval (Con 2) <= 2
13 - eval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) (Con 2)) <= 36
36
Iterations: 13
*MyStateT>
*MyStateT> eval (Add (Con 5) (Con 6))
11.... I do not like this number!
*MyStateT>
-}
Next?
We need a parser to get a string from input and turn into something of type Term!
Let's see if we'll time for it... Fist we must complete the text above!!
Suggested readings
Cale Gibbard, Monads as Containers
Jeff Newbern, All About Monads
You Could Have Invented Monads! (And Maybe You Already Have.) by sigfpe
Acknowledgments
Thanks to Neil Mitchell, Daniel Fisher, Bulat Ziganzhin, Brian Hulley and Udo Stenzel for the invaluable help they gave, in the haskell-cafe mailing list, in understanding this topic.
I couldn't do it without their help.
Obviously errors are totally mine. But this is a wiki so, please, correct them!