Search code examples
haskellstatemonadsmonad-transformersstate-monad

Nested States in Haskell


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.

Solution

  • 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