I'm getting "No instance for MonadState BTState BT" and I don't know what I'm doing wrong. I've tried adding constraints in various places, putting MonadState in the deriving() clause, etc.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import System.Random
import Control.Monad.Error
import Control.Monad.State
-- I want to make a class of monads which contain random generator state.
class Monad m => RandMonad m where
putGen :: StdGen -> m ()
getGen :: m StdGen
-- the following creates a monadic type BT
data BTState = BTState
{ bGoalN :: Int
, bRandState :: StdGen }
newtype BT a = BT { insideBT :: ErrorT String (State BTState) a }
deriving(Monad)
runBT a s = runState (runErrorT $ insideBT a) s
instance RandMonad BT where
getGen = BT $ gets bRandState
putGen g = BT $ do { s <- get; put s {bRandState=g} }
-- trying to use BT
backtrackBT :: BT Int
backtrackBT = do
s <- get
put s {bGoalN=2}
return 3
You need to derive MonadState:
newtype BT a = ...
deriving (Monad, MonadState BTState, MonadError String)
And MonadError while we're at it.
If you had tried just putting deriving (Monad, MonadState, MonadError), you would have gotten a compiler error because you have to have an associated state or error type with your transformer stack, otherwise you'd be able to change the type of the error or the type of the state midway through the computation, which wouldn't typecheck elsewhere.
Related
I am trying to define a family of state machines with somewhat different kinds of states. In particular, the more "complex" state machines have states which are formed by combining the states of simpler state machines.
(This is similar to an object oriented setting where an object has several attributes which are also objects.)
Here is a simplified example of what I want to achieve.
data InnerState = MkInnerState { _innerVal :: Int }
data OuterState = MkOuterState { _outerTrigger :: Bool, _inner :: InnerState }
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- _innerVal <$> get
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- _outerTrigger <$> get
if b
then
undefined
-- Here I want to "invoke" innerStateFoo
-- which should work/mutate things
-- "as expected" without
-- having to know about the outerState it
-- is wrapped in
else
return 666
More generally, I want a generalized framework where these nestings are more complex. Here is something I wish to know how to do.
class LegalState s
data StateLess
data StateWithTrigger where
StateWithTrigger :: LegalState s => Bool -- if this trigger is `True`, I want to use
-> s -- this state machine
-> StateWithTrigger
data CombinedState where
CombinedState :: LegalState s => [s] -- Here is a list of state machines.
-> CombinedState -- The combinedstate state machine runs each of them
instance LegalState StateLess
instance LegalState StateWithTrigger
instance LegalState CombinedState
liftToTrigger :: Monad m, LegalState s => StateT s m o -> StateT StateWithTrigger m o
liftToCombine :: Monad m, LegalState s => [StateT s m o] -> StateT CombinedState m o
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
Now, I am trying to design combinators for these objects. Some of them are:
A pre combinator. Suppose that mon is a monitor. Then, pre mon is a monitor which always produces False after the first token is consumed and then mimicks the behaviour of mon as if the previous token is being inserted now. I would want to model the state of pre mon with StateWithTrigger in the example above since the new state is a boolean along with the original state.
An and combinator. Suppose that m1 and m2 are monitors. Then, m1 `and` m2 is a monitor which feeds the token to m1, and then to m2, and then produces True if both of the answers were true. I would want to model the state of m1 `and` m2 with CombinedState in the example above since the state of both monitors must be maintained.
For your first question, as Carl mentioned, zoom from lens does exactly what you want. Your code with lenses could be written like this:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad.State.Lazy
newtype InnerState = MkInnerState { _innerVal :: Int }
deriving (Eq, Ord, Read, Show)
data OuterState = MkOuterState
{ _outerTrigger :: Bool
, _inner :: InnerState
} deriving (Eq, Ord, Read, Show)
makeLenses ''InnerState
makeLenses ''OuterState
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- gets _innerVal
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- gets _outerTrigger
if b
then zoom inner $ innerStateFoo
else pure 666
Edit: While we're at it, if you're already bringing in lens then innerStateFoo can be written like so:
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = innerVal <<+= 1
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
I think that what you want to achieve doesn't need very much machinery.
newtype StreamTransformer input output = StreamTransformer
{ runStreamTransformer :: input -> (output, StreamTransformer input output)
}
type Monitor input = StreamTransformer input Bool
pre :: Monitor input -> Monitor input
pre st = StreamTransformer $ \i ->
-- NB: the first output of the stream transformer vanishes.
-- Is that OK? Maybe this representation doesn't fit the spec?
let (_, st') = runStreamTransformer st i
in (False, st')
and :: Monitor input -> Monitor input -> Monitor input
and left right = StreamTransformer $ \i ->
let (bleft, mleft) = runStreamTransformer left i
(bright, mright) = runStreamTransformer right i
in (bleft && bright, mleft `and` mright)
This StreamTransformer is not necessarily stateful, but admits stateful ones. You don't need to (and IMO should not! in most cases!!) reach for typeclasses in order to define these (or indeed ever! :) but that's another topic).
notStateful :: StreamTransformer input ()
notStateful = StreamTransformer $ \_ -> ((), notStateful)
stateful :: s -> (input -> s -> (output, s)) -> StreamTransformer input output
stateful s k = StreamTransformer $ \input ->
let (output, s') = k input s
in (output, stateful s' k)
alternateBool :: Monitor anything
alternateBool = stateful True $ \_ s -> (s, not s)
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
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.
Documentation for the parsec package states that u argument is used to carry some user state through monadic computation. But the same functionality can be achieved by basing ParsecT monad transformer on State monad. So if my parser is not stateful, i don't need u altogether, but have to set it to () with parsec. What's rationale for adding non-optional state support to ParsecT?
Because a parser of type ParsecT s () (State st) a behaves differently from a parser of type Parsec s st Identity a when it comes to backtracking:
User state resets when parsec tries an alternative after a failing parse that consumes no input.
But the underlying Monad m does not backtrack; all the effects that happened on the way to a final parse result are kept.
Consider the following example:
{-# LANGUAGE FlexibleContexts #-}
module Foo where
import Control.Applicative
import Control.Monad.State
import Text.Parsec.Prim hiding ((<|>), State(..))
import Text.Parsec.Error (ParseError)
tick :: MonadState Int m => ParsecT s Int m ()
tick = do
lift $ modify (+1)
modifyState (+1)
tickTock :: MonadState Int m => ParsecT s Int m ()
tickTock = (tick >> empty) <|> tick
-- | run a parser that has both user state and an underlying state monad.
--
-- Example:
-- >>> run tickTock
-- (Right 1,2)
run :: ParsecT String Int (State Int) () -> (Either ParseError Int, Int)
run m = runState (runParserT (m >> getState) initUserState "-" "") initStateState
where initUserState = 0
initStateState = 0
As you can see, the underlying state monad registered two ticks (from both alternatives that were tried),
while the user state of the Parsec monad transformer only kept the successful one.
ParsecT carries it's own state already: parsing position and input: http://haddocks.fpcomplete.com/fp/7.8/20140916-162/parsec/Text-Parsec-Prim.html#t:State
So as leftaroundabout pointed out, it's probably due optimisation purposes.
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.