Search code examples
haskellmonad-transformersstate-monad

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.


Solution

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