I am mucking around with free monads and lens, using the free monad to create my own version of the IO monad:
data MyIO next
= LogMsg String next
| GetInput (String -> next)
deriving (Functor)
I am stacking this on top of a state monad like so: FreeT MyIO (State GameState) a where GameState is:
data GameState = GameState { _players :: [PlayerState] }
Now, what I would like to have is a way to "zoom-into" a PlayerState from a GameState context. Something like this:
zoomPlayer :: Int -> FreeT MyIO (State PlayerState) a -> FreeT MyIO (State GameState) a
zoomPlayer i prog = hoistFreeT (zoom (players . element i)) prog
But I'm getting this error:
No instance for (Data.Monoid.Monoid a1)
arising from a use of ‘_head’
This error seems related to the fact that players . element i is a traversal; if I remove the list aspect from _players and use normal lens then the code works.
Any ideas on how to write this function?
If you are sure you'll never index into a non-existing player and don't mind a little unsafety, you can use the unsafeSingular combinator to turn a Traversal into a Lens, like this:
zoomPlayer :: Int -> FreeT MyIO (State PlayerState) a -> FreeT MyIO (State GameState) a
zoomPlayer i prog = hoistFreeT (zoom (players . unsafeSingular (element i))) prog
(Also, perhaps I would use ix instead of element, but that's unrelated to the problem.)
We can also construct safe indexing lenses for always-infinite sequences, like streams defined using Cofree from the free package:
import Control.Lens (Lens', _Wrapped')
import Control.Comonad.Cofree (Cofree, telescoped)
import Data.Functor.Identity
import Control
sureIx :: Int -> Lens' (Cofree Identity a) a
sureIx i = telescoped $ replicate i _Wrapped'
But a game is unlikely to have infinite players.
Related
I'm trying to write a Monad which renders some HTML, while tracking (and caching) a few specific function calls. Here's what I tried:
data TemplateM a = TemplateM
{ templateCache :: ![(Text, Text)]
, templateResult :: !(IO a)
}
Here's how I plan to use this:
renderCached :: Text -> TemplateM Text
renderCached k =
-- lookup templateCache from the monadic context, if it lacks the key,
-- then fetch the key from an external data source (which is where the
-- "IO interior" comes from, and store it in templateCache (monadic context)
Notably, I do not want arbitrary IO actions to be executed in TemplateM via lift, liftIO, and suchlike. The only IO that should happen in TemplateM is to fetch something from the cache via the renderCached function.
I was able to define the Functor and Applicative instances for this, but got completely stuck with the Monad instance. Here's how far I got:
instance Functor TemplateM where
{-# INLINE fmap #-}
fmap fn tmpl = tmpl{templateResult=fmap fn (templateResult tmpl)}
instance Applicative TemplateM where
{-# INLINE pure #-}
pure x = TemplateM
{ templateCache = []
, templateResult = pure x
}
{-# INLINE (<*>) #-}
fn <*> f =
let fnCache = templateCache fn
fnFunction = templateResult fn
fCache = templateCache f
fResult = templateResult f
in TemplateM { templateCache = fnCache <> fCache
, templateResult = fnFunction <*> fResult
}
Is there any way to write the Monad instance for this without exposing the IO internals to the outside world?
I've worked out a solution sitting on top of ReaderT, but I really want to get my original idea to work:
newtype TemplateM a = TemplateM { unTemplateM :: ReaderT (IORef [(Text, Text)]) IO a } deriving (Functor, Applicative, Monad)
renderCached :: Text -> TemplateM Text
renderCached k = TemplateM $ do
-- this is just dummy code. The actual cache lookup has not
-- been implemented, but the types align
v <- pure $ "rendered template for " <> k
cacheRef <- ask
atomicModifyIORef' cacheRef (\x -> ((k, v):x, ()))
pure v
runTemplateM :: [(Text, Text)]
-> TemplateM a
-> IO ([(Text, Text)], a)
runTemplateM initialCache x = do
initialCacheRef <- newIORef initialCache
(flip runReaderT) initialCacheRef $ do
res <- unTemplateM x
ref <- ask
finalCache <- readIORef ref
pure (finalCache, res)
As others have suggested, the elementary solution here is to use StateT. Since you don't need to store your IORef in a data structure or share it between threads, you can eliminate it altogether. (Of course, if that changes and you do end up wanting to share state across multiple concurrent threads, you'll have to revisit this choice.)
import Control.Monad.State.Strict
import Data.Text (Text)
import Data.Tuple (swap)
newtype TemplateM a = TemplateM {unTemplateM :: StateT [(Text, Text)] IO a}
deriving (Functor, Applicative, Monad)
renderCached :: Text -> TemplateM Text
renderCached k = TemplateM $ do
v <- pure $ "rendered template for " <> k
modify ((k, v) :)
pure v
runTemplateM :: [(Text, Text)]
-> TemplateM a
-> IO ([(Text, Text)], a)
runTemplateM initialCache x = fmap swap $ flip runStateT initialCache (unTemplateM x)
It goes without saying that a cache like this should almost certainly be stored as a structure that is not a list. One promising option is to use text-trie, a data structure Wren Romano designed specially for this purpose. You might also consider a HashMap or even a Map.
I'm designing a small game which basically uses StateT and just updating the state. Below is the simplified version:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.State.Class
import System.Random
data PlayerState = PlayerState {
_psName :: String,
_psScore :: Int
} deriving (Show)
makeClassy ''PlayerState
data Game = Game {
_turns :: Int,
_players :: [PlayerState]
} deriving (Show)
makeClassy ''Game
randomGameInit :: IO Game
randomGameInit = do
players <- replicateM 5 $ PlayerState <$> (replicateM 4 $ randomRIO ('a', 'z')) <*> randomRIO (1,10)
return $ Game 0 players
update :: (MonadState s m, HasGame s) => m ()
update = do
players . ix 0 . psName %= (\_ -> "mordor")
turns %= (+1)
exitCondition <- fmap (>10) (turns <%= id)
unless exitCondition update
main :: IO ()
main = do
init <- randomGameInit
runStateT update init >> print "Game Over"
I've recently learned about the ReaderT Design Pattern vs mtl StateT, which encourages replacing StateT with a mutable reference inside a ReaderT over IO.
I wonder how I should adapt the code using ReaderT. Most specifically, many Lens functions have types: (MonadState s m) which apparently need to be inside a State. Does this mean that Lens library functions are designed for StateT and not ReaderT? How to use Lens with ReaderT design pattern?
From what I've seen, ReaderT pattern users typically don't use the MonadState lens operators. Instead, use view to access the desired MVar (or whatever kind of mutable var you're dealing with) and update that as usual (e.g. with modifyMVar).
The RIO monad offers an appropriate MonadState instance, though. A better answer than mine could probably adapt your code to the RIO monad fairly easily.
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.
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.