I'm trying to implement a Maybe-State monad transformer and use it to implement a simple stack machine.
The definitions of state monad and maybe should be correct. Now I'm trying to implement pop:
pop :: MaybeT (State Stack) Int
So that if the stack is empty it returns nothing, otherwise it returns Just <popped stack>.
This is what I have so far:
pop :: MaybeT (State Stack) Int
pop = guard True (do (r:rs) <- get
put rs
return r)
(Obviously True is just a dummy placeholder - I'll implement the condition later, for now I want to get the other part right).
What is wrong with my code? From my understanding guard takes a conditional (True) and a function f. If the conditional is true it then gives pure f.
In my case,
pure = MaybeT . return . Just
So shouldn't my function f just return a State Stack Int?
Here is the full code, with my implementations of MaybeT and State:
import Control.Applicative (Alternative(..))
import Control.Monad (liftM, ap, guard)
import Control.Monad.Trans.Class (MonadTrans(lift))
main :: IO()
main = return ()
-- State Monad
--------------
newtype State s a = MakeState { runState :: s -> (a, s) }
instance Functor (State s) where
fmap = liftM
instance Applicative (State s) where
pure a = MakeState $ \s -> (a, s)
(<*>) = ap
instance Monad (State s) where
return a = MakeState $ \s -> (a, s)
m >>= k = MakeState $ \s -> let (x, s') = runState m s
in runState (k x) s'
get :: State s s
get = MakeState $ \s -> (s, s)
put :: s -> State s ()
put s = MakeState $ \_ -> ((), s)
modify :: (s -> s) -> State s ()
modify f = MakeState $ \s -> ((), f s)
-- MaybeT MonadTransformer
---------------------------
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
instance Monad m => Functor (MaybeT m) where
fmap a x = MaybeT $ do e <- runMaybeT x
return $ fmap a e
instance Monad m => Applicative (MaybeT m) where
pure = MaybeT . return . Just
(<*>) a b = MaybeT $ do e <- runMaybeT a
f <- runMaybeT b
return $ e <*> f
instance Monad m => Monad (MaybeT m) where
return = pure
a >>= b = MaybeT $ do aa <- runMaybeT a
maybe (return Nothing) (runMaybeT . b) aa
instance Monad m => Alternative (MaybeT m) where
empty = MaybeT $ return Nothing
a <|> b = MaybeT $ do aa <- runMaybeT a
bb <- runMaybeT b
return $ aa <|> bb
instance MonadTrans MaybeT where
-- "herwrappen" van het argument
lift x = MaybeT $ do r <- x
return $ Just r
-- Stack Manipulation
---------------------
type Stack = [Int]
-- plaats het argument bovenop de stack
push :: Int -> State Stack ()
push x = do r <- get
put (x:r)
-- geef de grootte van de stack terug
size :: State Stack Int
size = do r <- get
return $ length r
-- neem het eerste element van de stack, als het aanwezig is
-- (hint: hoogle naar `guard`)
pop :: MaybeT (State Stack) Int
pop = guard (True) (do (r:rs) <- get
put rs
return r)
guard doesn't take two arguments, it only takes a Bool argument.
You also need to lift your state manipulations into MaybeT:
pop :: MaybeT (State Stack) Int
pop = do
guard True
(r:rs) <- lift get
lift $ put rs
return r
First of all, you should understand if your stack is empty, your pattern r:rs <- get fails. But you write it in do-block, so the fail function will be called. It is implemented for Monad m => MaybeT m like this: fail _ = MaybeT (return Nothing). This means that if the pattern fails it returns Nothing. That what you want.
So, you can do like this:
pop :: MaybeT (State Stack) Int
pop = do r:rs <- get
put rs
return r
For the sake of comparison, here is a cruder implementation which doesn't rely neither on guard nor on fail:
pop :: MaybeT (State Stack) Int
pop = do
stk <- lift get
case stk of
[] -> empty
(r:rs) -> do
lift (put rs)
return r
Producing empty when the stack is [] amounts to the same thing that using guard in the way you intend, or using fail to exploit a failed pattern match (as in freestyle's answer).
Related
I'm writing interpreter in haskell. I want to do that with monads.
I already created parser, so I have a lot of functions :: State -> MyMonad State, and I can run my program using bind. m >>= inst1 >>= inst2.
Everything works perfectly fine, but I have no idea how to create instruction print (or read) in my language with that monad.
I don't want simple, but ugly, solutions like keeping strings to print inside State and printing in main at the end. (What if I have infinity while with print?)
I couldn't understand texts from web about that part of monad functionality. There were some explanations like "pack inside IO Monad, it's quite straightforward", but without any working examples. And almost all printing tutorials was about printing in main.
To better explain problem, I prepared minimal "interpreter" example (below). There State is just Int, my monad is AutomatM instructions have type :: Int -> AutomatM Int. So possible instruction is:
inc :: Int -> AutomatM Int
inc x = return (x+1)
I designed it as simple as I could think:
import Control.Applicative
import Control.Monad (liftM, ap)
import Control.Monad.IO.Class (MonadIO(..))
import System.IO
data AutomatM a = AutomatError | Running a
instance Show a => Show (AutomatM a) where
show (AutomatError) = "AutomatError"
show (Running a) = "Running " ++ show a
instance Functor AutomatM where
fmap = liftM
instance Applicative AutomatM where
pure = return
(<*>) = ap
instance Monad AutomatM where
return x = Running x
m >>= g = case m of
AutomatError -> AutomatError
Running x -> g x
magicPrint x = do
-- print x -- How can I make print work?
-- c <- getLine -- And if that is as simple as print
b <- return "1000" -- how can I change constant to c?
return (x + (read b :: Int))
main = do
a <- getLine
print $ (Running (read a :: Int)) >>= (\x -> return (x*2)) >>= magicPrint
My main target is to add print x inside magicPrint. However if it's not harder, it would be nice to have getLine.
I changed state in magicPrint, because print in my language has side effects.
I know that I need something with monad transformers and maybe MonadIO, but it's hard to find any tutorial with simple explanation for beginners.
Therefore I would very appreciate extending my minimal code example to work with prints (and maybe getLine/other read Int) and some explanations to that (perhaps with links).
Functor and Aplicative code is based on Defining a new monad in haskell raises no instance for Applicative
In order to create a new type with a Monad instance and access IO form inside of it, you will need to create another monad transformer type called AutomatMT and declare an instance of Monad, MonadTrans, etc. for it. It involves a lot of boilerplate code. I'll try to clarify anything that doesn't make sense.
import Control.Applicative
import Control.Monad (liftM, ap)
import Control.Monad.IO.Class (MonadIO(..))
import System.IO
import Control.Monad.Trans.Class (MonadTrans(..), lift)
data AutomatM a = AutomatError | Running a
instance Show a => Show (AutomatM a) where
show (AutomatError) = "AutomatError"
show (Running a) = "Running " ++ show a
instance Functor AutomatM where
fmap = liftM
instance Applicative AutomatM where
pure = return
(<*>) = ap
instance Monad AutomatM where
return x = Running x
m >>= g = case m of
AutomatError -> AutomatError
Running x -> g x
newtype AutomatMT m a = AutomatMT { runAutomatMT :: m (AutomatM a) }
mapAutomatMT :: (m (AutomatM a) -> n (AutomatM b)) -> AutomatMT m a -> AutomatMT n b
mapAutomatMT f = AutomatMT . f . runAutomatMT
instance (Functor m) => Functor (AutomatMT m) where
fmap f = mapAutomatMT (fmap (fmap f))
instance MonadTrans AutomatMT where
lift = AutomatMT . liftM Running
instance (Functor m, Monad m) => Applicative (AutomatMT m) where
pure = AutomatMT . return . Running
mf <*> mx = AutomatMT $ do
mb_f <- runAutomatMT mf
case mb_f of
AutomatError -> return AutomatError
Running f -> do
mb_x <- runAutomatMT mx
case mb_x of
AutomatError -> return AutomatError
Running x -> return (Running (f x))
instance (MonadIO m) => MonadIO (AutomatMT m) where
liftIO = lift . liftIO
instance (Monad m) => Monad (AutomatMT m) where
x >>= f = AutomatMT $ do
v <- runAutomatMT x
case v of
AutomatError -> return AutomatError
Running y -> runAutomatMT (f y)
fail _ = AutomatMT (return AutomatError)
magicPrint :: String -> (AutomatMT IO String)
magicPrint x = do
liftIO $ print $ "You gave magic print " ++ x
let x = "12"
y <- pure 1
liftIO $ print y
pure $ "1"
main = do
print "Enter some text"
a <- getLine
b <- runAutomatMT $ magicPrint a
pure ()
Say that I have a State monad, and I want to do some manipulations on the state and might want to undo the change in future. How in general can I do this decently?
To give a concrete example, let's assume the state is just an Int, and the manipulation
is just to increase the number by one.
type TestM a = StateT a IO ()
inc :: TestM Int
inc = modify (+ 1)
however, if I want to keep track of all the history of states in case I want to undo to some previous state, the best I can think of is to wrap the states in a stack: every modification to the state will be pushed to the stack so that I can undo changes through droping the top element on the stack.
-- just for showing what's going on
traceState :: (MonadIO m, MonadState s m, Show s) => m a -> m a
traceState m = get >>= liftIO . print >> m
recordDo :: TestM a -> TestM [a]
recordDo m = do
x <- gets head
y <- liftIO $ execStateT m x
modify (y:)
inc' :: TestM [Int]
inc' = recordDo inc
undo' :: TestM [Int]
undo' = modify tail
-- inc 5 times, undo, and redo inc
manip' :: TestM [Int]
manip' = mapM_ traceState (replicate 5 inc' ++ [undo',inc'])
main :: IO ()
main = do
v1 <- execStateT (replicateM_ 5 (traceState inc)) 2
v2 <- execStateT (replicateM_ 5 (traceState inc')) [2]
v3 <- execStateT manip' [2]
print (v1,v2,v3)
As expected, here is the output:
2
3
4
5
6
[2]
[3,2]
[4,3,2]
[5,4,3,2]
[6,5,4,3,2]
[2]
[3,2]
[4,3,2]
[5,4,3,2]
[6,5,4,3,2]
[7,6,5,4,3,2]
[6,5,4,3,2]
(7,[7,6,5,4,3,2],[7,6,5,4,3,2])
The drawback of my approach:
tail and head are unsafe
One have to use something like recordDo explicitly, but I guess this is unavoidable because otherwise there will be some inconsistency issue. For example increasing the number by two can be done by either inc' >> inc' or recordDo (inc >> inc) and these two approach have different effects on the stack.
So I'm looking for either some ways to make it more decent or something that does the job of "reversible state" better.
Depending on your use-case, it might be worth considering something that I'd call "delimited undo":
{-# LANGUAGE FunctionalDependencies, FlexibleContexts #-}
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Maybe
undo :: (MonadState s m, MonadPlus m) => m a -> m a -> m a
undo dflt k = do
s <- get
k `mplus` (put s >> dflt)
undoMaybe :: (MonadState s m) => m a -> MaybeT m a -> m a
undoMaybe dflt k = do
s <- get
r <- runMaybeT k
maybe (put s >> dflt) return r
undoMaybe_ :: (MonadState s m) => MaybeT m () -> m ()
undoMaybe_ = undoMaybe (return ())
Executing undo x k means "execute k, and if it fails, undo the state and execute x instead". Function undoMaybe works similarly, but allows the failure only the nested block. Your example then could be expressed as:
type TestM a = StateT a IO ()
inc :: (MonadState Int m) => m ()
inc = modify (+ 1)
-- just for showing what's going on
traceState :: (MonadIO m, MonadState s m, Show s) => m a -> m a
traceState m = get >>= liftIO . print >> m
inc' :: (MonadIO m, MonadState Int m) => m ()
inc' = traceState inc
-- inc 5 times, undo, and redo inc
manip' :: TestM Int
manip' = replicateM 4 inc' >> undoMaybe_ (inc' >> traceState mzero) >> inc'
main :: IO ()
main = do
v1 <- execStateT (replicateM_ 5 (traceState inc)) 2
putStrLn ""
v3 <- execStateT manip' 2
print (v1,v3)
The main advantage is that you can never underflow the stack. The disadvantage is that you can't access the stack and the undo is always delimited.
One could also create an Undo monad transformer that where the above undo becomes mplus. Whenever a failed computation is restored with mplus, the state is restored as well.
newtype Undo m a = Undo (m a)
deriving (Functor, Applicative, Monad)
instance MonadTrans Undo where
lift = Undo
instance (MonadState s m) => MonadState s (Undo m) where
get = lift get
put = lift . put
state = lift . state
instance (MonadPlus m, MonadState s m) => MonadPlus (Undo m) where
mzero = lift mzero
x `mplus` y = do
s <- get
x `mplus` (put s >> y)
I following type and monad based on it:
data Err a = Ok a | Bad String
deriving (Read, Show, Eq, Ord)
instance Monad Err where
return = Ok
fail = Bad
Ok a >>= f = f a
Bad s >>= f = Bad s
instance Functor Err where
fmap = liftM
I've also function which has ot print "asdf" to screen and end with error (this is temporary solution for debug):
runStatments :: [Stm] -> State -> Err State
runStatments [] state = Ok state
runStatments (s:_) state = case s of
PrintStmt exp -> do {
e <- evalExpression exp state;
k <- Ok $putStrLn "asfd";
Bad "damn!"
}
...
The problem is that code doesn't print "asdf" on screen...
What is gentle solution for such a problem? I've tried liftIO and so on, but I coudln't write compileable program...
You can't just "jam" the IO into a monad without it bubbling up at some point. What you have to do is wrap the Err monad around the IO monad with what's called a monad transformer.
Something like
import Control.Monad
import Control.Monad.Trans
-- If you don't like `Either`, you can change it to
-- Err
data ErrT m a = ErrT {runErrT :: m (Either String a)}
instance (Monad m, Functor m) => Monad (ErrT m) where
return = ErrT . return . Right
(ErrT m) >>= f = ErrT $ do
val <- m
case val of
Left err -> return $ Left err
Right a -> runErrT $ f a
instance MonadTrans ErrT where
lift = ErrT . liftM Right
Then you can do something like this
test :: ErrT IO ()
test = lift $ putStrLn "Hello World"
main = runErrT test
I have trouble gripping to monads and monad transformers. I have the
following contrived example (not compilable):
import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
data State = State Int Int Int
type Foo = ReaderT State IO
readEither :: String -> Either String Int
readEither s = let p = reads s
in case p of
[] -> throwError "Could not parse"
[(a, _)] -> return a
readEitherT :: IO (Either String Int)
readEitherT = let p s = reads s
in runErrorT $ do
l <- liftIO (getLine)
readEither l
foo :: Foo Int
foo = do
d <- liftIO $ readEitherT
case d of
Right dd -> return dd
Left em -> do
liftIO $ putStrLn em
return (-1)
bar :: Foo String
bar = do
liftIO $ getLine
defaultS = State 0 0 0
If I copy the functionality of readEither to readEitherT, it works, but I
have a nagging feeling that I can leverage the power of the existing
readEither function, but I can't figure out how. If I try to lift the
readEither in the readEitherT function, it lifts it to ErrorT String IO
(Either String Int) as it should. But I should somehow get it to ErrorT
String IO Int.
If I'm going to the wrong direction with this, what is the correct way to
handle errors which require IO (or other monads) and are to be called from
monadic context (see the foo function in the example)
Edit:
Apparently it was not clear what I was trying to do. Maybe the following function describes what and why I was wondering
maybePulseQuit :: Handle -> IO (Either String ())
maybePulseQuit h = runErrorT $ do
f <- liftIO $ (communicate h "finished" :: IO (Either String Bool))
(ErrorT . pure) f >>= \b → liftIO $ when b $ liftIO pulseQuit
This works, but is still ugly because of the binds. This is a lot clearer than the previous version which had case checking. Is this the recommended way to do this?
It is not clear why you need ErrorT. You can implement readEitherT like
readEitherT :: IO (Either String Int)
readEitherT = fmap readEither getLine
If you really need ErrorT for some reason, then you can create utility function eitherToErrorT:
eitherToErrorT = ErrorT . pure
readEitherT = runErrorT $ do
l <- liftIO $ getLine
eitherToErrorT $ readEither l
[ADD]
Maybe you just want to add ErrorT into your monad stack...
data State = State Int Int Int
type Foo = ErrorT String (ReaderT State IO)
runFoo :: Foo a -> State -> IO (Either String a)
runFoo foo s = runReaderT (runErrorT foo) s
doIt :: Int -> Foo Int
doIt i = if i < 0
then throwError "i < 0"
else return (i * 2)
Example:
*Main> runFoo (doIt 1 >>= doIt) (State 0 0 0)
Right 4
*Main> runFoo (doIt (-1) >>= doIt) (State 0 0 0)
Left "i < 0"
Suppose I have a state monad such as:
data Registers = Reg {...}
data ST = ST {registers :: Registers,
memory :: Array Int Int}
newtype Op a = Op {runOp :: ST -> (ST, a)}
instance Monad Op where
return a = Op $ \st -> (st, a)
(>>=) stf f = Op $ \st -> let (st1, a1) = runOp stf st
(st2, a2) = runOp (f a1) st1
in (st2, a2)
with functions like
getState :: (ST -> a) -> Op a
getState g = Op (\st -> (st, g st)
updState :: (ST -> ST) -> Op ()
updState g = Op (\st -> (g st, ()))
and so forth. I want to combine various operations in this monad with IO actions. So I could either write an evaluation loop in which operations in this monad were performed and an IO action is executed with the result, or, I think, I should be able to do something like the following:
newtype Op a = Op {runOp :: ST -> IO (ST, a)}
Printing functions would have type Op () and other functions would have type Op a, e.g., I could read a character from the terminal using a function of type IO Char. However, I'm not sure what such a function would look like, since e.g., the following is not valid.
runOp (do x <- getLine; setMem 10 ... (read x :: Int) ... ) st
since getLine has type IO Char, but this expression would have type Op Char. In outline, how would I do this?
Use liftIO
You're already very close! Your suggestion
newtype Op a = Op {runOp :: ST -> IO (ST, a)}
is excellent and the way to go.
To be able to execute getLine in an Op context, you need to 'lift' the IO operation into the Op monad. You can do this by writing a function liftIO:
liftIO :: IO a -> Op a
liftIO io = Op $ \st -> do
x <- io
return (st, x)
You can now write:
runOp (do x <- liftIO getLine; ...
Use class MonadIO
Now the pattern of lifting an IO action into a custom monad is so common that there is a standard type class for it:
import Control.Monad.Trans
class Monad m => MonadIO m where
liftIO :: IO a -> m a
So that your version of liftIO becomes an instance of MonadIO instead:
instance MonadIO Op where
liftIO = ...
Use StateT
You've currently written your own version of the state monad, specialised to state ST. Why don't you use the standard state monad? It saves you from having to write your own Monad instance, which is always the same for the state monad.
type Op = StateT ST IO
StateT already has a Monad instance and a MonadIO instance, so you can use those immediately.
Monad transformers
StateT is a so-called monad transformer. You only want IO actions in your Op monad, so I've already specialized it with the IO monad for you (see the definition of type Op). But monad transformers allow you to stack arbitrary monads. This what intoverflow is talking about. You can read more about them here and here.
The basic approach would be to rewrite your Op monad as a monad transformer. This would allow you to use it in a "stack" of monads, the bottom of which might be IO.
Here's an example of what that might look like:
import Data.Array
import Control.Monad.Trans
data Registers = Reg { foo :: Int }
data ST = ST {registers :: Registers,
memory :: Array Int Int}
newtype Op m a = Op {runOp :: ST -> m (ST, a)}
instance Monad m => Monad (Op m) where
return a = Op $ \st -> return (st, a)
(>>=) stf f = Op $ \st -> do (st1, a1) <- runOp stf st
(st2, a2) <- runOp (f a1) st1
return (st2, a2)
instance MonadTrans Op where
lift m = Op $ \st -> do a <- m
return (st, a)
getState :: Monad m => (ST -> a) -> Op m a
getState g = Op $ \st -> return (st, g st)
updState :: Monad m => (ST -> ST) -> Op m ()
updState g = Op $ \st -> return (g st, ())
testOpIO :: Op IO String
testOpIO = do x <- lift getLine
return x
test = runOp testOpIO
The key things to observe:
The use of the MonadTrans class
The use of the lift function acting on getLine, which is used to bring the getline function from the IO monad and into the Op IO monad.
Incidentally, if you don't want the IO monad to always be present, you can replace it with the Identity monad in Control.Monad.Identity. The Op Identity monad behaves exactly the same as your original Op monad.