A couple months ago, I had an idea for a monad transformer, and sunk a good deal of time into figuring out how to make it work. I started getting it ready for Hackage before I realized I didn't have an immediate use case for it, and so I didn't have a good sense for what sensible defaults would be. I put the project aside to work on other things and let my brain churn on it.
What I'm going to do here is describe the idea and some implementation notes to get a sense of how useful it'd be as a package, so I know whether it's worth my time.
The root of the ObserverT monad transformer is described by the functions:
evalObserverT' :: ObserverT r m a -> r -> Either a (m a)
uses :: Functor f => StoreDict f a -> (r -> a) -> ObserverT r m aIn this sense, ObserverT's similar to ReaderT except that ObserverT r m a
admits the possibility of computing a from r purely.
runReaderT :: ReaderT r m a -> r -> m a
asks :: (r -> a) -> ReaderT r m aWhile it can be seen that ObserverT r m a values consisting of nothing but
return, uses and >>= can be evaluated purely, what's the utility of a
monad transformer in which you never lift something from the underlying monad?
lift :: m a -> ObserverT r m aAnd once you've lift'ed, you can't get a value of type a purely.
And that's true... the first time.
But uses gives us a way of generating a signature for the inputs of type
r that would compute a particular output of type a. If we record the
association between the input signature and the output value, then we can
purely check if a given input matches the signature and reuse the cached
output.
To generate an updated ObserverT r m a that contains the association between
the input signature and the output, we have:
runObserverT' :: ObserverT r m a -> r -> Either (a, ObserverT r m a) (m (a, ObserverT r m a))which is a bit more succinctly written with:
runObserverT :: ObserverT r m a -> r -> IdentityOr m (a, ObserverT r m a)
newtype IdentityOr m a = IdentityOr { runIdentityOr :: Either a (m a) }where we have the constraint that given (a, obs') <- runObserverT obs r,
then evalObserverT' obs' r is always just Left a.
That is, we only have to perform the monadic actions once for all inputs that match the given signature.
Things get a bit more opinion-based when you start to consider partial matches of an input signature, and this is where I started wishing for real use-cases.
For example, consider the case of partial signature matches with respect to <*>. Given:
(_, mf') <- runObserverT mf r0(_, ma') <- runObserverT ma r1
(that is, mf' and ma' are signature-enriched versions of mf and ma,
respectively).
There's two choices for defining evalObserverT' (mf' <*> ma') r:
-
let the two sides of the
<*>operator use their signature cache independently: [1A]evalObserverT' (mf' <*> ma') r = case (evalObserverT' mf' r, evalObserverT' ma' r) of (Left f, Left a) -> Left (f a) (Left f, Right na) -> Right (fmap f na) (Right nf, Left a) -> Right (fmap ($a) nf) (Right nf, Right na) -> Right (nf <*> na)
-
a signature-miss on one side forces a miss on the other, reruning the monadic actions on that side. [1B]
evalObserverT' (mf' <*> ma') r = case (evalObserverT' mf' r, evalObserverT' ma' r) of (Left f, Left a) -> Left (f a) (Left f, Right na) -> evalObserverT' (mf <*> ma') r (Right nf, Left a) -> evalObserverT' (mf' <*> ma) r (Right nf, Right na) -> Right (nf <*> na)
Similarly for evalOperatorT' (ma' >>= f) r:
-
we could reuse a purely-computable prefix: [2A]
evalOperatorT' (ma' >>= f) r = case (evalOperatorT' ma r) of Left a -> evalOperatorT' (f a) r Right na -> Right $ do a <- na case (evalOperatorT' (f a) r) of Left b -> return a Right nb -> nb
-
or we could recompute the prefix if there's a signature-miss later [2B]
evalOperatorT' (ma' >>= f) r = case (evalOperatorT' ma r) of Left a -> case (evalOperatorT' (f a) r) of Left b -> Left b Right _ -> evalOperatorT (ma >>= f) r Right na -> -- as before...
While supporting various different methods of partial signature evaluation is possible via flags, the ambiguity over what would be the most useful here is what led me to put this to the side.
The implementation was pretty fun to work out. If we don't worry too much about efficiency and hardcode for [1A,2A] the types looks like:
data ObserverT r m a where
Pure :: a -> ObserverT r m a
Wrap :: Functor f => Request m f i x r a -> ObserverT r m a
data Request m f i x r a = Request
{ action :: Action m f i r x
, create :: x -> ObserverT r m a
, cached :: f (ObserverT r m a)
}
deriving Functor
data Action m f i r x where
Uses :: StoreDict f i -> (r -> i) -> Action m f i r i
Lift :: m x -> Action m Maybe () r x
Ap :: (Functor g, Functor h) =>
Request m g j y r (w -> x) ->
Request m h k z r w ->
Action m (Compose g h) (j,k) r x
data StoreDict (f :: * -> *) (i :: *) = StoreDict
{ empty :: forall a. f a
, lookup :: forall a. i -> f a -> Maybe a
, insert :: forall a. i -> a -> f a -> f a
}If you squint hard you can see that ObserverT could almost be defined the
free monad over a Request-like Functor, if it weren't for Ap.
The Monad, Applicative and Functor instances follow from this similarity,
requiring only that the m parameter be a Functor, but where the free monad
would define <*> as ap, ObserverT uses Ap:
instance Functor (ObserverT r m) where
fmap f (Pure a) = Pure $ f a
fmap f (Wrap req) = Wrap $ fmap f req
instance Applicative (ObserverT r m) where
pure = Pure
Pure f <*> obs = fmap f obs
obs <*> Pure a = fmap ($a) obs
Wrap pf <*> Wrap pw = Wrap pa where
pa = Request
{ action = Ap pf pw
, create = Pure
, cached = empty (store pa)
}
instance Monad (ObserverT r m) where
return = pure
Pure a >>= f = f a
Wrap (Request {..}) >>= f = Wrap $ Request
{ action = action
, create = (>>=f) . create
, cached = fmap (>>=f) cached
}A Request can be seen as a tree of Aps, with Uses and Lift at the
leaves and caching at each level.
The only additional interfaces needed to construct ObserverT values is a
MonadTrans instance and uses (which could be provided from an mtl-style
MonadObserver class, but isn't for simplicity):
instance MonadTrans (ObserverT r) where
lift ma = Wrap $ Request
{ action = Lift ma
, create = Pure
, cached = Nothing
}
uses :: Functor f => StoreDict f a -> (r -> a) -> ObserverT r m a
uses s q = Wrap $ Request
{ action = Uses s q
, create = Pure
, cached = empty s
}The utility of the types can be seen in the implementation of runObserverT,
where Ap shows its necessity for [1A] by caching each side of the <*> independently,
while [2A] follows from the sequencing in the IdentityOr m monad.
runObserverT :: Monad m => ObserverT r m a -> r -> IdentityOr m (a, ObserverT r m a)
runObserverT obs@(Pure a) _ = Point (a, obs)
runObserverT (Wrap pa) r = second Wrap <$> runRequest pa r
runRequest :: Monad m => Request m f i x r a -> r -> IdentityOr m (a, Request m f i x r a)
runRequest pa@(Request {..}) r = do
let i = query pa r
StoreDict {..} = store pa
(obs, pa) <- case (lookup i cached, action) of
(Just obs, _) -> return (obs, pa)
(_, Uses _ _) -> return (create i, pa)
(_, Lift mx) -> (\x -> (create x, pa)) <$> lift mx
(_, Ap pf pw) ->
(\(f,pf) (w,pw) -> (create (f w), pa { action = Ap pf pw })) <$> runRequest pf r <*> runRequest pw r
(a, obs) <- runObserverT obs r
return (a, pa { cached = insert i obs cached })I'm a big fan of [1A,2A] because it gives a way of representing a resumable computation, where you can reuse as much as possible from previous computations:
So as a silly example, if we had an action that created users from profiles:
createUser :: ObserverT Profile IO User
createUser = do
(name, image) <- (,) <$> welcomeName <*> fetchImage
userid <- lift nextUserId
return $ User userid name image
where
welcomeName = do
name <- uses ord $ view name
lift . putStrLn $ ">>> Welcome, " ++ name ++ "!"
return name
fetchImage = do
url <- uses ord $ view profilePic
imageData <- lift $ do
putStrLn $ ">>> fetching " ++ show url
fetch url
bounds <- uses ord $ view profilePicBounds
lift $ do
putStrLn $ ">>> cropping " ++ url ++ " to " ++ show bounds
cropTo bounds imageData
ord :: Ord i => StoreDict Map i
ord = ...We could see how various branches are reused:
λ :{
⋮ let obsRef # r = do
⋮ obs <- readIORef obsRef
⋮ (a, obs) <- lower (runObserverT obs r)
⋮ writeI0Ref obsRef obs
⋮ return a
⋮ :}
λ createUserRef <- newIORef createUser
λ createUserRef # defaultUser
>>> Welcome {unknown name}!
>>> Fetching default.png
>>> cropping default.png to 100x100
User 0
λ createUserRef # defaultUser
User 0
λ createUserRef # defaultUser { name = "Harold" }
>>> Welcome Harold!
User 1
λ createUserRef # defaultUser { name = "Harold", profilePic = "awesome.png" }
>>> Fetching awesome.png
>>> cropping awesome.png to 100x100
User 2
λ createUserRef # defaultUser { profilePic = "awesome.png", profilePicBounds = mkBounds 25 25 }
>>> cropping awesome.png to 25x25
User 3