Using GHC's RebindableSyntax for a dynamic state "Fauxnad"

I just learned about GHC’s RebindableSyntax extension from chrisdoner’s thread on reddit and wanted to play around with scratching a couple itches I’ve had. In this post I’ll illustrate using RebindableSyntax to allow us to use haskell’s do notation in a State-monad-like construction, in which our state type is allowed to change (I’ve played with this idea previously).

The dynamic state construction looks like the traditional State, but with separate types for input and output state:

{-# LANGUAGE DeriveFunctor, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
newtype DynState s1 s2 a = DynState { runState :: s1 -> (a,s2) }
    deriving Functor

get :: DynState s s s
get = DynState $ \s-> (s,s)

put :: s -> DynState x s ()
put = DynState . const . (,) ()

modify :: (s1 -> s2) -> DynState s1 s2 ()
modify = DynState . fmap ((,) ())

We can compose these by defining a (for the moment, very verbose) function dynStateBind. Interestingly, this is actually easier to understand IMHO than the State monad because the type signature makes explicit the fact that our lambda-bound state s1 is the initial state value that we run the construction on:

infixl 1 `dynStateBind` 
dynStateBind :: DynState s1 s2 a -> (a -> DynState s2 s3 b) -> DynState s1 s3 b
dynStateBind x f = DynState $ \s1-> let ~(a,s2) = runState x s1
                                     in runState (f a) s2

We also need stand-ins for (>>) and return:

-- It would be nice if >> inherited default instances in terms of bind, as in
-- an instance declaration
infixl 1 `dynThen`
dynThen :: DynState s1 s2 a -> DynState s2 s3 b -> DynState s1 s3 b
dynThen x y = x `dynStateBind` \_ ->  y

dynReturn :: a -> DynState s s a
dynReturn a = DynState $ \s-> (a,s)

So then we can use all the nonsense above as follows:

{-# LANGUAGE RebindableSyntax #-}
module Main
    where

import Prelude -- since RebindableSyntax implies NoImplicitPrelude
import DynState

-- avoid lame "Not in scope: `ifThenElse'"
ifThenElse b x y | b = x
                 | otherwise = y
-- oops, infinite loop fail!
--ifThenElse b x y = if b then x else y 

test :: DynState Int Int String
test = let (>>=)  = dynStateBind
           (>>)   = dynThen
           return = dynReturn
        in do i <- get             -- state :: Int
              put (even i, show i) -- state :: (Bool, String)
              (b,i_str) <- get
              put (i+1)            -- state :: Int
              if b then return "uh oh, even!"
                   else return $ "pre-incremented: "++i_str

If we want to we can even enrich our bind and add some machinery to support composing traditional StateT computations with our dynamic state:

-- | a silly class to support comosing regular State monad computations with
-- dynamic state computations.
class Stateful n s1 s2 | n -> s1 s2 where
    expand :: n a -> DynState s1 s2 a

instance Stateful (DynState s1 s2) s1 s2 where
    expand = id

instance Stateful (M.StateT s Identity) s s where
    expand = DynState . M.runState

-- category with bind sort of situation...
polyDynStateBind :: (Stateful x s1 s2, Stateful y s2 s3)=> x a -> (a -> y b) -> DynState s1 s3 b
polyDynStateBind x f = expand x `dynStateBind` fmap expand f

-- | convert a dynamic stateful computation into the usual State monad, so we
-- can compose it with normal state computations
flatten :: DynState s s a -> M.State s a
flatten = M.state . runState 

Zippers

At some point while working on zippo (you
should check out this instead) I made up detailed notes on a DSL for zipper operations that I wished I could shoe-horn into do or Arrow notation, but never quite could.

Lost the notes, but the idea would be to have bind expose the “focus” of the zipper and allow motions down and up to be sequenced nicely with minimal boilerplate, as in the state monad. Maybe I’ll find those and fill in this section properly.