How to combine data composition and monad transformers

Question

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.

Answer 1

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.

Answer 2

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.