[Haskell-cafe] state and exception or types again...
Andrea Rossato
mailing_list at istitutocolli.org
Tue Aug 29 14:51:26 EDT 2006
Il Tue, Aug 29, 2006 at 10:02:38AM +0100, Brian Hulley ebbe a scrivere:
> Yes I agree the StateT/monad transformer approach is probably best in the
> long run, since by using the standard monad transformers, you will get code
> that will scale better to handle more complexities later, and has the
> advantage of being already tested so you can be sure the resulting monads
> will obey all the monad laws. Also, there are a lot of tutorials about how
> to use them to solve different problems.
...
Hi!
It's been quite troublesome since there are no examples (at least I
did not find any), but I implemented (copied...;-) StateT.
Below the code. What do you think (apart from names or lack of class
instance: I need this code to understand what's going on and to write
about it in my tutorial)?
Is it quite canonical? Anything really bad?
> Happy monadic explorations! :-)
Great fun indeed!
Thanks for the kind help from you, guys!
Andrea
Here's the bit. At the end the output.
module Monadi where
data Term = Con Int
| Add Term Term
deriving (Show)
eval :: Term -> Int
eval (Con a) = a
eval (Add a b) = eval a + eval b
answer, noanswer :: Term
answer = (Add (Add (Con 30) (Con 12)) (Add (Con 20) (Con 30)))
noanswer = (Add (Add (Con 20) (Con 12)) (Con 11))
formatLine t a = "eval (" ++ show t ++ ") <= " ++ show a ++ " - "
type Exception = String
type O = String
data M2 a = Ex Exception
| Done {unpack :: (a,O) }
deriving (Show)
newtype StateT s m a = S {runStateT :: s -> m (a,s) } --S (s -> m (a,s))
instance Monad m => Monad (StateT s m) where
return a = S (\s -> return (a,s))
S m1 >>= k = S (\s -> do ~(a,s1) <- m1 s
let S m2 = k a
m2 s1)
instance Monad M2 where
return a = Done (a, "")
m >>= f = case m of
Ex e -> Ex e
Done (a, x) -> case (f a) of
Ex e1 -> Ex e1
Done (b, y) -> Done (b, x ++ y)
lift m = S (\s -> do x <- m
return (x,s))
raise_IOE :: O -> StateT s M2 a
raise_IOE e = lift (Ex e)
print_IOE :: O -> StateT Int M2 ()
print_IOE x = lift (Done ((), x))
incState :: StateT Int M2 (M2 ())
incState = S (\s -> return (Done ((), ""), s + 1))
eval_IOE :: Term -> StateT Int M2 Int
eval_IOE (Con a) = do incState
print_IOE (formatLine (Con a) a)
return a
eval_IOE (Add t u) = do a <- eval_IOE t
b <- eval_IOE u
incState
print_IOE (formatLine (Add t u) (a + b))
if (a+b) == 42
then raise_IOE "The Ultimate Answer Has Been Computed!! Now I'm tired!"
else return (a + b)
-- *Monadi> runStateT (eval_IOE answer) 0
-- Ex "The Ultimate Answer Has Been Computed!! Now I'm tired!"
-- *Monadi> runStateT (eval_IOE noanswer) 0
-- Done {unpack = ((43,5),"eval (Con 20) <= 20 - eval (Con 12) <= 12 - eval (Add (Con 20) (Con 12)) <= 32 - eval (Con 11) <= 11 - eval (Add (Add (Con 20) (Con 12)) (Con 11)) <= 43 - ")}
-- *Monadi>
More information about the Haskell-Cafe
mailing list