Skip to content

Instantly share code, notes, and snippets.

@mctaylorpants
Created May 10, 2018 01:22
Show Gist options
  • Save mctaylorpants/d8d4536370642dc5c71a9600e32b2fde to your computer and use it in GitHub Desktop.
Save mctaylorpants/d8d4536370642dc5c71a9600e32b2fde to your computer and use it in GitHub Desktop.
Haskell from First Principles - Chapter 15 - 'Mem' Exercise

This gist and its comments are a way of working through an exercise problem found in Chapter 15 of the Haskell Book.

Here's the code from the exercise. Our job is to implement the mempty and mappend functions, which are presented here as undefined:

module Chap15Ex where
import Data.Monoid

newtype Mem s a =
  Mem {
      runMem :: s -> (a, s)
  }

instance Monoid a => Monoid (Mem s a) where
  mempty = undefined
  mappend = undefined


f' :: Mem Integer String
f' = Mem $ \s -> ("hi", s + 1)

main = do
  let rmzero = runMem mempty 0
      rmleft = runMem (f' <> mempty) 0
      rmright = runMem (mempty <> f') 0
  print $ rmleft -- ("hi, 1)
  print $ rmright -- ("hi", 1)
  print $ (rmzero :: (String, Int)) -- ("", 0)
  print $ rmleft == runMem f' 0 -- True
  print $ rmright == runMem f' 0 -- True
@expede
Copy link

expede commented May 10, 2018

What the heck. I can't post emoji like "thumbs up" or "wink" in gists because the encoding is too big?! The original version of that post had more encouraging emoji, I swear :P

@mctaylorpants
Copy link
Author

mctaylorpants commented May 10, 2018

Thanks for the thoughtful comments! You've put me on the right track for mempty, here's what I've got now:

instance Monoid a => Monoid (Mem s a) where
  mempty  = Mem $ \s -> (mempty, s)

This feels correct, because we're delegating to mempty for the value of a, and we're just returning s unchanged, similar to an identity function. Now I can prove that mempty is behaving in isolation:

runMem mempty 9 :: ([Int], Int)
-- ([],9)

runMem mempty "hi" :: (Sum Int, String)
(Sum {getSum = 0},"hi")

Ok, on to mappend!

I know I'll have two Mems, each with a function inside, so I can destructure that in the argument:

  mappend (Mem f) (Mem f') = undefined

Now, each function has the same signature s -> (a, s), so I'll need to create a new function that combines the output of f and f' into a new tuple. I don't think I can use straight-up function composition because the output of one function can't be used as the input for the next.

@expede
Copy link

expede commented May 10, 2018

mempty = Mem $ \s -> (mempty, s)

:thumbsup:

I don't think I can use straight-up function composition because the output of one function can't be used as the input for the next.

That's right! There's some unwrapping and threading of arguments involved. Here's one step as a hint:

-- You have: Mem f
let (a', s') = f s

Or, well.. you can always use the point free style... but it may be torturous. Better to do it with arguments in this case.

@mctaylorpants
Copy link
Author

mctaylorpants commented May 11, 2018

let (a', s') = f s

I didn't realize you could destructure in a normal assignment like that - very cool!

I'm getting very, very close now 😁 I've figured it out! πŸŽ‰

πŸ¦† Rubber ducking is awesome - I started typing this message to organize my thoughts before taking a break for the day, but as I was typing it out I realized how I could solve it!

We have to accomplish the following:

  1. Write a new function which mappend will ultimately return;
  2. Apply the argument that this new function accepts to both functions that we're passing into mappend;
  3. Destructure the resulting tuples and gather up our two a values and our two s values;
  4. mappend both a values, since they're both guaranteed to be monoidal (yay, laws!)
  5. Compose both s values*.
  • The last step took me the longest to figure out. But then, I started thinking about how if you ignore part of the tuple, we're really dealing with a plain 'ol composable function:
-- before:
\s -> (a, s + 1)

-- after:
\s -> s + 1

If we can ignore the tuple and make the function return just one value, then we can compose things together!

All that's left is to take the new function we wrote, and wrap it up in a nice Mem package πŸ—ƒοΈ

Drumroll please... πŸ₯ πŸ₯ πŸ₯


The solution (here be spoilers)
instance Monoid a => Monoid (Mem s a) where
  mempty                   = Mem $ \s -> (mempty, s)
  mappend (Mem f) (Mem f') = Mem $ \s -> (fst (f s) <> fst (f' s), snd . f . snd . f' $ s)

-- hooray, it passes!
-- > main
--    ("hi",1)
--    ("hi",1)
--    ("",0)
--    True
--    True

I used fst and snd to handle the tuples:

let tuple = ("hello", 0)

fst tuple -- "hello"
snd tuple -- "hello"

For what it's worth, I started with this parenthetical monstrosity, but it really helped me work through what I needed to do:

    Mem $ \s -> ((fst (f s)) <> (fst (f' s)), (snd (f (snd (f' s)))))

Now that I've figured it out, I'd love to hear if there's a more idiomatic way of writing this instance, I'm curious about other implementations!

Thanks again for your help, @expede! You gave me the perfect level of hints to lead me towards the solution without giving too much away πŸ‘Œ πŸ‘Œ

@expede
Copy link

expede commented May 11, 2018

Improved readability (here be spoilers)

Let's use some intermediate variables. This means the same thing, and is really just there for readability. It's slightly more operational, but that's clearer here. There may be some minor differences in what the compiler infers for performance stuff, but I'm too lazy to dig into it that far :P The version below is the canonical form.

instance Monoid a => Monoid (Mem s a) where
  mempty = Mem $ \s -> (mempty, s)
  mappend (Mem f) (Mem g) =
      Mem $ \s -> 
        let 
          (a, t) = g s
          (b, u) = f t
        in     
          (a <> b, u)

-- Alternate variable naming, depending on how many ticks you like to track

  mappend (Mem f) (Mem f') =
    Mem $ \s -> 
      let 
        (a' , s' ) = f' s
        (a'', s'') = f  s'
      in
        (a' <> a'', s'')

-- Alternate naming to help follow in English

  mappend (Mem secondFun) (Mem firstFun) =
    Mem $ \state -> 
      let 
        (firstValue, intermediateState) = firstFun state
        (secondValue, finalState) = secondFun intermediateState
      in
        (firstValue <> secondValue, finalState)

@mctaylorpants
Copy link
Author

Nice, those look great πŸ‘ I see how you're threading the state through from both functions before returning the final result, that makes a lot of sense!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment