Search code examples
haskellrefactoringmonadsdo-notationreader-monad

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?


Solution

  • 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.