Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Refactoring a Haskell function that uses the Reader monad

I've got some code that looks sort of like this, ignoring all the code that isn't relevant to my question:

import qualified Control.Monad.Reader as Reader

data FooEnv = FooEnv { bar :: Int -> Int }
type FooReader = Reader.Reader FooEnv

foo :: Int -> FooReader String
foo i = Reader.liftM show $ bar' i
  where
    bar' i' = do
      bar'' <- Reader.asks bar
      return $ bar'' i'

Is there a way to refactor this? Specifically, the nested bar' function is bothering me most. Can this be condensed to one line?

like image 965
arussell84 Avatar asked Sep 08 '14 04:09

arussell84


1 Answers

We can do a little equational reasoning. First let's look at bar'. I'll write it in this form

asks bar >>= \z -> return (z i)

It turns out that liftM is defined to be liftM f m = m >>= \a -> return (f a) which fits the pattern above. So let's replace it with

liftM ($ i) (asks bar)

Then we have foo as being

liftM show (liftM ($ i) (asks bar))

Or, written out a bit particularly

liftM show . liftM ($ i) $ asks bar

If we know that liftM is fmap we might recognize the Functor law at play here

fmap show . fmap ($ i) $ asks bar -- equals
fmap (show . ($ i)) $ asks bar

I'm not personally a big fan of using ($ i) as a function, so let's rewrite it as an explicit lambda

fmap (\f -> show (f i)) (asks bar)

Now, we could decide to eliminate the asks by using bar at the call site (i.e. use bar as a function of type bar :: FooEnv -> Int -> Int

fmap (\f -> show (bar f i)) ask

and as a final trick, we could use flip to go pointless in the fmapped function and even return the use of asks (thanks Ørjan Johansen)

fmap (show . flip bar i) ask  -- or even
show . flip bar i <$> ask     -- or even
asks (show . flip bar i)

I'm not saying this is the most readable or wonderful way to perform this task, but you can see how we can just whittle down the pieces using equational reasoning.

like image 150
J. Abrahamson Avatar answered Sep 27 '22 16:09

J. Abrahamson