Print to console and update Monad state in same function - haskell

I want to define a function that expects an Int, prints an error in the console depending on the number (x) and then updates the State with Nothing.
How can I join those commands in one function?
Here's what I got:
type Env = [(Variable,Int)]
newtype StateError a = StateError { runStateError :: Env -> Maybe (a, Env) }
class Monad m => MonadError m where
throw :: Monad m => a -> m a
instance MonadError StateError where
throw x = StateError (\s -> Nothing)
But I can't figure out how to perform the IO side-effect and then the State update in the same function definition

No
A function in the state monad, such as a -> State s b, is a pure function (no IO) that happens to have an extra function argument s hidden though some handy plumbing.
You can't print to the console from the state monad.
However, Yes!
However! You can use a monad transformer to get both State and some underlying monad such as IO.
I'll provide an example using transformers instead of a custom monad and mtl as it appears you were using. With mtl you can use classes like MonadError to leverage a throw that works well with other libraries that use the mtl classes. On the other hand, if you are the end consumer of this transformer it is less important.
First we'll import the modules that give us MonadIO, StateT, MaybeT, and use newtype deriving so we don't have to type out the monad instance boilerplate:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import qualified Control.Monad.Trans.State as S
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Control.Monad.Trans
Just to be complete we'll spell out the types useful to your abstraction:
type Variable = String
type Env = [(Variable,Int)]
Now we can get to the interesting part - a Monad definition and functions for plumbing. The monad stack is StateT MaybeT IO:
newtype StateError a = StateError { unStateError :: S.StateT Env (MaybeT IO) a }
deriving (Monad, Applicative, Functor)
And we can run it by first unwrapping the newtype, then running the state, and finally the MaybeT:
run :: StateError a -> IO (Maybe (a, Env))
run = runMaybeT . flip S.runStateT [] . unStateError
Usually you'll write an army of functions that provide your monad abstraction. For this question it's just "update the state" and "print to stdout":
modify :: (Env -> Env) -> StateError ()
modify = StateError . S.modify
emit :: Show a => a -> StateError ()
emit = StateError . liftIO . print . show
Armed with our Monad of Power, we can do fancy things like update state and emit IO messages and track failure or success:
updateAndPrint :: Variable -> Int -> StateError ()
updateAndPrint v i =
do emit (v,i)
modify ((v,i):)
Oh, and failure is pretty simple - just fail in our MaybeT monad:
throw :: a -> StateError b
throw _ = fail "" -- same as 'MaybeT (pure Nothing)'
We can use this monad as expected:
> run $ updateAndPrint "var" 1
"(\"var\",1)"
Just (() -- ^ return value of `updateAndPrint`
,[("var",1)]) -- ^ resulting state

Related

How to add Mask to a monadic stack

I am trying to use the bracket function from Exception.Safe Package which has a return type of
forall m a b c. MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c
This implies that my monad stack must have the Mask monad added to the stack ?
My calling function looks like this
sendMessage :: String -> Config.KafkaP (Either KafkaError ())
sendMessage msg=do
getProperties <- producerProps
let
mkProducer = newProducer getProperties
clProducer (Left _) = return ()
clProducer (Right prod) = closeProducer prod
runHandler (Left err) = return $ Left err
runHandler (Right prod) = messageSender prod msg
res <- bracket mkProducer clProducer runHandler
return res
And config.KakfaP has the type
ReaderT ProducerConfig IO a
And the error I get is ,
No instance for (exceptions-0.10.0:Control.Monad.Catch.MonadMask
Config.KafkaP)
arising from a use of ‘bracket’
Does this mean the monad stack needs to be something like this
Mask (ReaderT ProducerConfig IO a)
Ideally I would want the function to return what the run Handler returns which is Config.KafkaP (Either KafkaError ()) ,or anything more robust .
Adding a solution based on an answer
sendMessage :: String -> Config.KafkaP (Either KafkaError ())
sendMessage msg=do
getProperties <- producerProps
let
mkProducer = newProducer getProperties
--newProducer :: MonadIO m => ProducerProperties -> m (Either KafkaError KafkaProducer)
--mkProducer :: Config.KafkaP (Either KafkaError KafkaProducer)
clProducer (Left _) = return ()
clProducer (Right prod) = closeProducer prod
--closeProducer :: MonadIO m => KafkaProducer -> m ()
--clProducer :: Config.KafkaP (Either () ()) -- ??
runHandler (Left err) = return $ Left err
runHandler (Right prod) = messageSender prod msg
--messageSender :: KafkaProducer -> String -> Config.KafkaP (Either KafkaError ())
--runHandler :: Config.KafkaP (Either KafkaError ()) -- ??
Config.KafkaP $ bracket (Config.runK mkProducer) (Config.runK .clProducer) (Config.runK .runHandler)
If you were using the type ReaderT ProducerConfig IO a directly, there wouldn't be a problem, because the exceptions package provides an instance
MonadMask IO
That says you can use bracket with IO, and another instance
MonadMask m => MonadMask (ReaderT r m)
That says that if the base monad is an instance of MonadMask, then ReaderT over that monad is also an instance of MonadMask.
Notice that MonadMask is not a transformer that is part of the monad stack. Instead, it is a constraint that says "this monad stack supports masking / bracketing operations".
If you were using a type synonym like
type KafkaP a = ReaderT ProducerConfig IO a
there wouldn't be a problem either, because type synonyms don't create a new type, they just give an alias to an exiting one. One can still make use of all the existing typeclass instances for the type.
You mention in the comments that KafkaP is a newtype. A newtype is a cheap way of creating, well, a new type out of another. It's basically a constructor that holds a value of the original type.
And that's the problem. Because it is a new type, it doesn't share automatically all the typeclass instances of the old one. In fact, having different typeclass instances in newtypes is one of the main motivations for using newtypes!
What can be done? Well, supposing the newtype constructor is exported (sometimes they are hidden for purposes of encapsulation) you could unwrap the KafkaPs actions into ReaderT ProducerConfig IO a before sending them into bracket, and then re-wrap the result into KafkaP again. Some of the parameters are KafkaP-returning functions, so you'll probably need to throw in some function composition as well. Perhaps something like (assuming KafkaP is the name of the constructor, and runKafkaP the name of the corresponding accessor):
KafkaP $ bracket (runKafkaP mkProducer) (runKafkaP . clProducer) (runKafkaP . runHandler)
All this wrapping and unwrapping is tedious; sometimes using coerce from Data.Coerce can help. But this only works when the newtype constructor is exported.
You might also think of defining your own MonadMask instance for KafkaP using the technique above. This can be done, but instances which are defined neither in the module that defines the typeclass nor in the module that defines the type are called orphan instances and are somewhat frowned upon.

How to combine data composition and monad transformers

I'm somewhat new to monad transformers, and currently trying to use a StateT/Except stack in a project. The difficulty I'm having is that I have a few layers of data composition (types with operations on them, contained within types that have other operations on them), and I can't figure out how to elegantly use monad transformers in that design. Concretely, I'm having trouble writing the following code (simplified example, obviously):
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Trans.Except (Except, throwE)
import Control.Monad.Trans.State (StateT)
data ComposedState = ComposedState { state :: Bool }
data MyError = MyError { message :: String }
-- If the passed in state is true, change it to false; otherwise throw.
throwingModification :: ComposedState -> Except MyError ComposedState
throwingModification (ComposedState True) = return $ ComposedState False
throwingModification _ = throwE $ MyError "error!"
-- A state which composes with #ComposedState#,
data MyState = MyState { composed :: ComposedState }
-- and a monad transformer state to allow me to modify it and propagate
-- errors.
newtype MyMonad a = MyMonad { contents :: StateT MyState (Except MyError) a }
deriving ( Functor
, Applicative
, Monad
, MonadState MyState
, MonadError MyError )
anAction :: MyMonad ()
anAction = do -- want to apply throwingModification to the `composed` member,
-- propogating any exception
undefined
where I have a potentially "throwing" operation on ComposedState, and I want to use that operation in a stateful, throwing operation on MyState. I can obviously do that by deconstructing the whole stack and rebuilding it, but the whole point of the monadic structure is that I shouldn't have to. Is there a terse, idiomatic solution?
Apologies for the lengthy code snippet--I did my best to cut it down.
The more natural way of doing this would be to write throwingModification from the start in the MyMonad monad, like so:
throwingModification' :: MyMonad ()
throwingModification' = do ComposedState flag <- gets composed
if not flag then throwError $ MyError "error!"
else modify (\s -> s { composed = (composed s)
{ Main.state = False } })
I'm assuming here that the composed states contain other components that you want to preserve, which makes the modify clause ugly. Using lenses can make this cleaner.
However, if you're stuck with the current form of throwingModification, you'll probably have to write your own combinator, since the usual State combinators don't include mechanisms for switching the state type s, which is what you're effectively trying to do.
The following definition of usingState may help. It transforms a StateT operation from one state to another using a getter and setter. (Again, a lens approach would be cleaner.)
usingState :: (Monad m) => (s -> t) -> (s -> t -> s)
-> StateT t m a -> StateT s m a
usingState getter setter mt = do
s <- get
StateT . const $ do (a, t) <- runStateT mt (getter s)
return (a, setter s t)
I don't think there's an easy way to modify usingState to work between general MonadState monads instead of directly on a StateT, so you'll need to lift it manually and convert it through your MyMonad data type.
With usingState so defined, you can write the following. (Note >=> comes from Control.Monad.)
MyMonad $ usingState getComposed putComposed $
StateT (throwingModification >=> return . ((),))
with helpers:
getComposed = composed
putComposed s c = s { composed = c }
This is still a little ugly, but that's because the type t -> Except e t must be adapted to StateT (t -> Except e ((), t)), then transformed to the s state by the combinator, and then wrapped manually in your MyMonad, as explained above.
With Lenses
I'm not suggesting lenses are a miracle cure or anything, but they do help clean up a few of the uglier parts of the code.
After adding lenses:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad ((>=>))
import Control.Monad.Except (Except, MonadError, throwError)
import Control.Monad.State (get, MonadState, runStateT, StateT(..))
data MyError = MyError { _message :: String }
data MyState = MyState { _composed :: ComposedState }
data ComposedState = ComposedState { _state :: Bool }
makeLenses ''ComposedState
makeLenses ''MyError
makeLenses ''MyState
the definition of throwingModification looks a little cleaner:
throwingModification :: ComposedState -> Except MyError ComposedState
throwingModification s =
if s^.state then return $ s&state .~ False
else throwError $ MyError "error!"
and the MyMonad version I gave above certainly benefits:
throwingModification' :: MyMonad ()
throwingModification' = do
flag <- use (composed.state)
if flag then composed.state .= False
else throwError (MyError "error!")
The definition of usingStateL doesn't look much different:
usingStateL :: (Monad m) => Lens' s t -> StateT t m a -> StateT s m a
usingStateL tPart mt = do
s <- get
StateT . const $ do (a, t) <- runStateT mt (s^.tPart)
return (a, s&tPart .~ t)
but it allows the existing lens composed to be used in place of helper functions:
MyMonad $ usingStateL composed $
StateT (throwingModification >=> return . ((),))
and it would generalize to (composed.underneath.state4) if you had complex nested state.
The best solution would be re-write throwingModification as a MyMonad.
throwingModification :: MyMonad ()
throwingModification = do
s <- get
if state s then
put $ ComposedState False
else
throwError $ MyError "error!"
If you can't re-write your function (because it is used elsewhere), you can wrap it instead.

Monad type mismatch

I am attempting to use the IO monad in a Spock application. The following code does not compile:
get "api/entities" $ do
entities <- loadEntities
let e1 : xs = entities
text $ note e1
loadEntities has the type IO [Entity]
The error is Couldn't match type ‘ActionT IO ()’ with ‘t0 -> IO b0’
Is Spock using a monad other than IO? If so, how do I get the result of loadEntities?
Writing answer so people can see a better explanation.
If you look at get it has the type.
get :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
ActionT is a monad transformer and it requires in inner monad to have an instance of MonadIO. If we look at the typeclass MonadIO it has a function
liftIO :: IO a -> m a
This means every that you call execute functions of the type IO a in that stack by using liftIO. ActionT has an instance of MonadIO also and which is the one you are using here to call your IO function. So to call loadEntities you had to
entities <- liftIO loadEntities
If you end of calling a certain function like that a lot you can create a separate module import it qualified and export a more friendly one.
module Lifted (loadEntities) where
import qualified SomeModule as IO
loadEntities :: MonadIO m => m Entities
loadEntities = liftIO IO.loadEntities
This will make it so you don't always have you use liftIO

Adding MonadReader/MonadError instances to a Transformer Type

As it's usual when working with Happstack, I have been making my own server monad to use for the handlers, to cover my DB and Sessions, plus some error handling. I have recently discovered the happstack-clientsession-Package that is a big help and prevents me from writing my own solution.
Though there's a little trouble wiring in the ClientSessionT monad to my own. As it turns out, there are no MonadReader or MonadError instances for it, so I cannot instance them in my wrapper monad.
Here is the full code of the module:
{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, DeriveDataTypeable, EmptyDataDecls, TemplateHaskell #-}
module Server where
import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.Trans
import Data.Data (Data, Typeable)
import Data.SafeCopy (base, deriveSafeCopy)
import Database.MongoDB as M
import Happstack.Server
import Happstack.Server.Error
import Happstack.Server.ClientSession
import System.IO.Pool
import System.IO.Error
import Web.ClientSession (getDefaultKey)
type MongoPool e = Pool e Pipe
data PonySession = PonySession -- TODO: Fill in User type when available
deriving (Ord, Read,Show, Eq, Typeable, Data)
$(deriveSafeCopy 0 'base ''PonySession)
instance ClientSession PonySession where
empty = PonySession
newtype PonyServerPartT e m a = PonyServerPart (ClientSessionT PonySession (ReaderT (MongoPool IOError) (ServerPartT (ErrorT e m))) a)
deriving (Monad, MonadIO, MonadReader (MongoPool e), MonadError e, ServerMonad, MonadPlus)
type PonyServerPart = PonyServerPartT IOError IO
runServerT s = mapServerPartT' (spUnwrapErrorT errorHandler) $ do
key <- liftIO getDefaultKey
let sessConf = (mkSessionConf key) { sessionCookieLife = MaxAge $ 60 * 60 * 24 * 7 }
pool <- liftIO mongoPool
runReaderT (runClientSessionT s sessConf) pool
where errorHandler = simpleErrorHandler . show
mongoPool :: IO (MongoPool IOError)
mongoPool = newPool fac 10
where fac = Factory {
newResource = connect $ M.host "127.0.0.1",
killResource = close,
isExpired = isClosed
}
The error I am getting is obvious: The deriving from MonadError and MonadReader does not work. But I'd need those, otherwise the entire performance is kind of useless.
Since I have never been able to figure out how these are done (And relied on deriving), I'd like for an answer that covers this specific problem and kind of tells me how it is done generally.
In theory, you would write something like this, except you can't because the ClientSessionT constructor and 'unClientSessionT` function are not exported:
instance (Monad m, MonadError e m) => MonadError e (ClientSessionT st m) where
throwError = ClientSessionT . throwError
catchError (ClientSessionT m) f =
ClientSessionT $ ReaderT $ \r -> StateT $ \s ->
(runStateT (runReaderT m r) s) `catchError` (\e -> runStateT (runReaderT (unClientSessionT (f e)) r) s)
instance (Functor m, Monad m, MonadReader r m) => MonadReader r (ClientSessionT st m) where
ask = ClientSessionT $ lift $ lift ask
local f (ClientSessionT m) = ClientSessionT $ mapReaderT (mapStateT (local f)) m
Writing these types of instances by hand is pretty mechanical -- there are patterns you will see arise again and again. (Which is why the compiler can figure out how to do it automatically most of the time).
In this case, the best fix is to complain to the authors about the missing instances.
The darcs version now includes MonadError, MonadReader, and a bunch more. Plus some other changes that break things a tiny bit, but make things better over all.
There is also a demo directory now:
http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-clientsession
I will probably release it, with a few minor changes, and more comments in a day or two.
The newtype deriving mechanism expects the ClientSessionT to have instances for the desired type classes. I do not see in the haddock documentation you linked to where ClientSessionT has instances for MonadError or MonadReader. Chasing the type class constraints (e.g. for Happstack) also does not reveal an instance for MonadError or `MonadReader.
The general mechanism is documented in section 7.5 of the GHC User's Guide. The idea is that for a type class CanBark and an instance for datatype Dog (i.e. instance CanBark Dog where ...) that a newtype wrapper DomesticDog around Dog can automatically have access to the CanBark Dog by search-and-replace Dog with DomesticDog.

What is the name of this Monad Stack function?

I've got a bunch of stateful functions inside a State monad. At one point in the program there needs to be some IO actions so I've wrapped IO inside a StateT getting a pair of types like this:
mostfunctions :: State Sometype a
toplevel :: StateT Sometype IO a
To keep things simple I don't want pass the IO context into the main set of functions and I would like to avoid wrapping them in the monad stack type. But in order to call them from the toplevel function I need something akin to a lift, but I'm not trying to lift a value from the inner monad. Rather I want to convert the state in the StateT monad into something equivalent in the State monad. To do this I've got the following:
wrapST :: (State Sometype a) -> StateT Sometype IO a
wrapST f = do s <- get
let (r,s2) = runState f s
put s2
return r
This then get used to interleave things like the following:
toplevel = do liftIO $ Some IO functions
wrapST $ Some state mutations
liftIO $ More IO functions
....
It seems like a fairly obvious block of code so I'm wondering does this function have a standard name, and it is already implemented somewhere in the standard libraries? I've tried to keep the description simple but obviously this extends to pulling one transformer out of a stack, converting the wrapped value to the cousin of the transformer type, skipping the monads below in the stack, and then pushing the results back in at the end.
It may be a good idea to refactor your code to use the type StateT SomeType m a instead of State SomeType a, because the first one is compatible to an arbitrary monad stack. If you'd change it like this, you don't need a function wrapST anymore, since you can call the stateful functions directly.
Okay. Suppose you have a function subOne :: Monad m => State Int Int:
subOne = do a <- get
put $ a - 1
return a
Now, change the types of all functions like this one from State SomeType a to StateT SomeType m a, leaving m as is. This way, your functions can work on any monadic stack. For those functions, that require IO, you can specify, that the monad at the bottom must be IO:
printState :: MonadIO m => StateT Int m ()
printState = do a <- get
liftIO $ print a
Now, it should be possible to use both functions together:
-- You could use me without IO as well!
subOne :: Monad m => StateT Int m ()
subOne = do a <- get
put $ a - 1
printState :: MonadIO m => StateT Int m ()
printState = do a <- get
liftIO $ print a
toZero :: StateT Int IO ()
toZero = do subOne -- A really pure function
printState -- function may perform IO
a <- get
when (a > 0) toZero
PS: I use GHC 7, some of the libs changed midway, so it might be a bit different on GHC 6.
A more direct answer to your question: the function hoist does exactly what you're describing in a slightly more generic way. Example usage:
import Control.Monad.State
import Data.Functor.Identity
import Control.Monad.Morph
foo :: State Int Integer
foo = put 1 >> return 1
bar :: StateT Int IO Integer
bar = hoist (return . runIdentity) foo
hoist is part of the MFunctor class, which is defined like this:
class MFunctor t where
hoist :: Monad m => (forall a. m a -> n a) -> t m b -> t n b
There are instances for most monad tranformers, but not ContT.

Resources