How do I actually execute a StateT monad along with IO? - haskell

I am trying to follow the advice given in Combine state with IO actions for building up an AppState along with an IO monad. What I've gotten is this:
module Main where
import Control.Monad.State
import Control.Monad.Trans
data ST = ST [Integer] deriving (Show)
type AppState = StateT ST IO
new = ST []
append :: Integer -> State ST ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: State ST Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
script = do
append 5
append 10
append 15
sumST
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
let (res, st) = runState script new
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runStateT myMain (ST [15])
There's some part of this I'm not getting. It bothers me greatly that I have script and myMain and main. It also bothers me that I have to execute runState within myMain and that I have to feed an initial state into runStateT in my main function. I'm wanting to have my "script", so to speak, directly in the myMain function because the entire point of myMain is to be able to run the append and sum directly in myMain and right next to the print operations. I think I should be able to do this, instead:
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
append 5
append 10
append 15
r <- sumST
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runState myMain
I had thought that the point of the monad transformer was so I can execute my State monad operations in a function (like above) and lift IO operations into that function. What is the right way to set all of this up so that I can remove one of the layers of indirection?
In addition to Daniel's solution (which I have flagged the solution), I have also found a few variations that might also shed some light on the situation. First, the final implementation of myMain and main:
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
append 5
append 10
append 15
res <- sumST
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runStateT myMain new
Now, various implementations of append and sumST, in addition to Daniel's:
append :: Integer -> AppState ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: AppState Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
and (note that only the type declaration changes; in fact you can omit the type declaration completely!)
append :: MonadState ST m => Integer -> m ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: MonadState ST m => m Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
It occurred to me that the AppState/StateT monad is not the same as the basic State monad, and I was coding both sumST and append for the State monad. In a sense, they also had to be lifted into the StateT monad, though the correct way of thinking of in is that they had to be run in the monad (hence, runState script new).
I'm not sure I completely get it, but I will work with it for a while, read the MonadState code, and write something about this when it finally works in my head.

The problem is that you made your append and sumST functions too monomorphic! Instead of directly using the state function, you should use the more polymorphic get and put functions, so that you can give them the more exciting types
append :: MonadState ST m => Integer -> m ()
append v = do
ST lst <- get
put (ST (lst ++ [v]))
sumST :: MonadState ST m => m Integer
sumST = do
ST lst <- get
return (sum lst)
Then you can write exactly the myMain you proposed (though you'll still have to give an initial state in main).
As a stylistic thing, I would propose not defining a new ST type: there are lots of functions that do handy things with lists, and making them impossible to use by imposing a ST constructor in between you and the lists can be annoying! If you use [Integer] as your state type instead, you can make definitions like this:
prepend :: MonadState [Integer] m => Integer -> m ()
prepend = modify . (:)
sumST :: MonadState [Integer] m => m Integer
sumST = gets sum
Looks pretty nice, no? =)

Related

How to preserve the state of the monad stack in the IO exception handler?

Consider the following program.
import Control.Monad.State
import Control.Monad.Catch
ex1 :: StateT Int IO ()
ex1 = do
modify (+10)
liftIO . ioError $ userError "something went wrong"
ex2 :: StateT Int IO ()
ex2 = do
x <- get
liftIO $ print x
ex3 :: StateT Int IO ()
ex3 = ex1 `onException` ex2
main :: IO ()
main = evalStateT ex3 0
When we run the program we get the following output.
$ runhaskell Test.hs
0
Test.hs: user error (something went wrong)
However, I expected the output to be as follows.
$ runhaskell Test.hs
10
Test.hs: user error (something went wrong)
How do I preserve the intermediate state in ex1 in the exception handler ex2?
Use an IORef (or MVar or TVar or whatever) instead.
newtype IOStateT s m a = IOStateT { unIOStateT :: ReaderT (IORef s) m a }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)
-- N.B. not MonadReader! you want that instance to pass through,
-- unlike ReaderT's instance, so you have to write the instance
-- by hand
runIOStateT :: IOStateT s m a -> IORef s -> m a
runIOStateT = runReaderT . unIOStateT -- or runIOStateT = coerce if you're feeling cheeky
instance MonadIO m => MonadState s (IOStateT s m) where
state f = IOStateT $ do
ref <- ask
liftIO $ do
s <- readIORef ref
let (a, s') = f s
writeIORef ref s'
pure a
This feels like a pattern I've seen enough times that there ought to be a Hackage package for it, but I don't know of one.

Monad transformers: Implementation of a stack machine with MaybeT (State Stack)

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).

Strip off layer from MonadResource

I'm playing around with the leveldb bindings.
I'm wondering if it's possible to take a function like
MonadResource m => a -> m b
And convert it to
MonadResource m => m (a -> IO b))
It can definitely be done, but it's dangerous. Let's demonstrate first the how, by extracting the internal state of the ResourceT:
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Resource.Internal
data Foo = Foo Int
deriving Show
getFoo :: MonadResource m => Int -> m Foo
getFoo i = fmap snd $ allocate
(do
putStrLn $ "allocating Foo with " ++ show i
return $ Foo i)
(\(Foo x) -> putStrLn $ "Freeing Foo " ++ show x)
stripLayer :: MonadResource m => (a -> ResourceT IO b) -> m (a -> IO b)
stripLayer f = do
is <- liftResourceT getInternalState
return $ \a -> runInternalState (f a) is
main :: IO ()
main = do
getFoo' <- runResourceT $ stripLayer $ getFoo
getFoo' 42 >>= print
Unfortunately the output from this isn't what we'd hope for:
allocating Foo with 42
Foo 42
Notice how the "Freeing" line is never called. This is because, by the time we use getFoo', the runResourceT call has already exited, which is how we guarantee that all resources are freed. You can safely get away with this trick if you're disciplined and make sure everything lives inside the runResourceT call, but the type system won't help you. To see what this will look like:
main :: IO ()
main = runResourceT $ do
getFoo' <- stripLayer $ getFoo
liftIO $ getFoo' 42 >>= print

Working with Maybe a, IO a, and MaybeT IO a

I'm writing a prompt - response style system with a bunch of various combinations of Maybe a, IO a, and MaybeT IO a, and there is a lof of stuff to take into account. Some IO actions for which there is no invalid input (and therefore aren't wrapped in MaybeT), some which are (and return an MaybeT IO a) some which aren't IO actions but can fail, so return Maybe a, and some that are just plain values and its beginning to seem that I have to remember inordinate combinations of <$>, Just, fmap, MaybeT, lift, =<<, and return just to get everything to be the right type. Is there any easier way to manage this or to reason about what functions I need to use to get my values where I need them? Or do I just have to hope I get better at it with time? Here is my example:
getPiece :: Player -> Board -> MaybeT IO Piece
getPiece player#(Player pieces _ _ _) board = piece
where
promptString = displayToUserForPlayer player board ++ "\n" ++ (display player) ++ "\n" ++ "Enter piece number: "
input :: MaybeT IO String
input = lift $ prompt promptString
index :: MaybeT IO Int
index = MaybeT <$> return <$> ((fmap cvtFrom1indexedInt) . maybeRead) =<< input
piece :: MaybeT IO Piece
piece = MaybeT <$> return <$> maybeIndex pieces =<< index
getRotatedPiece :: Player -> Board -> MaybeT IO Piece
getRotatedPiece player#(Player pieces _ _ _) board = piece
where
promptString :: MaybeT IO String
promptString = (++) <$> displayListString <*> restOfString
input :: MaybeT IO String
input = MaybeT <$> (fmap Just) <$> prompt =<< promptString
index :: MaybeT IO Int
index = MaybeT <$> return <$> ((fmap cvtFrom1indexedInt) . maybeRead) =<< input
piece :: MaybeT IO Piece
piece = MaybeT <$> return <$> maybeIndex pieces =<< index
rotatedPieceList :: MaybeT IO [Piece]
rotatedPieceList = rotations <$> getPiece player board
displayListString :: MaybeT IO String
displayListString = displayNumberedList <$> rotatedPieceList
restOfString :: MaybeT IO String
restOfString = MaybeT <$> return <$> Just $ "\nEnter rotation number:"
I must say, I am disappointed at the lack of conciseness, even if I removed the type hints I could likely write a shorter function to do the same thing in C# or python
Since you provided only a code fragment, I cannot try to refactor it. However, this is what I'd do: Most monads have a corresponding type class. The reason for it is exactly what you need here: When you create a monad using a monad transformer, it will inherit the operations of the inner monads (if appropriate). So you can forget about the inner monads and work just within the final monad.
In your case, you have MaybeT IO. It's instance of MonadPlus and of MonadIO. So you can refactor the code that returns Maybe something to work with a general MonadPlus instance instead, just replace Just with return and Nothing with mzero. Like:
-- before
checkNumber :: Int -> Maybe Int
checkNumber x | x > 0 = Just x
| otherwise = Nothing x
-- after
checkNumber :: MonadPlus m => Int -> m Int
checkNumber x | x > 0 = return x
| otherwise = mzero
-- or just: checkNumber = mfilter (> 0) . return
It will work with any MonadPlus, including Maybe and MaybeT IO.
And you can refactor the code that returns IO something to work with a general MonadIO instance:
-- before
doSomeIO :: IO ()
doSomeIO = getLine >>= putStrLn
-- after
doSomeIO :: MonadIO m => m ()
doSomeIO = liftIO $ getLine >>= putStrLn
This way, you can forget about <$>/fmap/liftM, Just, MaybeT etc. You just use return, mzero and in some places liftIO.
This will also help you to create a more general code. If you later realize that you need to add something to the monad stack, the existing code won't break, as long as the new monad stack implements the same type classes.
A less ambitious answer from me. Looking at your code, your operations like getPiece don't really return any information from the a particular error site. You can probably get away with just using IO and turning exceptions into Maybe values if you really want those. Some sample code I put together with some undefined functions referenced in your code:
import Control.Exception (handle, IOException)
data Board = Board deriving (Show)
data Piece = Piece deriving (Show)
type Pieces = [Piece]
data Player = Player Pieces () () () deriving (Show)
prompt :: String -> IO String
prompt = undefined
cvtFrom1indexedInt :: Int -> Int
cvtFrom1indexedInt = undefined
maybeIndex :: Pieces -> Int -> Maybe Piece
maybeIndex = undefined
displayToUserForPlayer :: Player -> Board -> String
displayToUserForPlayer = undefined
display :: Player -> String
display = undefined
-- I used this when testing, to deal with the Prelude.undefined errors
--returnSilently :: SomeException -> IO (Maybe a)
returnSilently :: IOException -> IO (Maybe a)
returnSilently e = return Nothing
getPiece :: Player -> Board -> IO (Maybe Piece)
getPiece player#(Player pieces _ _ _) board = handle returnSilently $ do
let promptString = displayToUserForPlayer player board ++ "\n" ++ (display player) ++ "\n" ++ "Enter piece number: "
input <- prompt promptString
let index = cvtFrom1indexedInt (read input)
return (maybeIndex pieces index)
main = do
maybePiece <- getPiece (Player [] () () ()) Board
putStrLn ("Got piece: " ++ show maybePiece)
Notably I've moved from MaybeT IO Piece to just IO (Maybe Piece). Instead of using fmap or lift I've just used do notation for referring to the intermediate results of my IO action.
Going on your comments about C# or Python, I hope this was the sort of simpler answer you were looking for.

Monads in monad transformer context

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"

Resources