Understanding evaluation with fmaps

Hi,

I am learning Haskell using the Haskell Programming from 1st Principles book.
And I can’t read/decode the following expression:

(fmap . fmap) sum Just [1, 2, 3]

whose value is Just 6.

I mean, I tried to massage it in some ways (parenthesize, partially apply…) to see if I understand how it is evaluated but I just can’t!
Can’t even get the number of arguments for sure: 2 ? 3 ? Something else…

Obviously, I can get the same result with:

fmap sum (Just [1, 2, 3])
fmap sum $ Just [1, 2, 3]

But I can’t make sense of the first expression (grrrr…), Please somebody help me!

Thanks

B

2 Likes

The thing to note here is that you aren’t doing:

(fmap . fmap) sum $ Just [1,2,3]

but really

(fmap . fmap) sum Just $ [1,2,3]

the Functor you’re fmapping on is the Just function, not the Just [1,2,3] value. As for what that means, well, fmap on functions is the same as function composition, so we get a reduction like this:

(fmap . fmap) sum Just [1,2,3] = fmap (fmap sum) Just [1,2,3]  -- (definition of .)
fmap (fmap sum) Just  [1,2,3]  = (fmap sum) . Just   [1,2,3]   -- (fmap on functions is .)
fmap sum . Just $ [1,2,3]      = fmap sum (Just [1,2,3])       -- (definition of .)
-- you know the rest, probably, but included anyway
fmap sum (Just [1,2,3])        = Just (sum [1,2,3])            -- (fmap on Maybe)
Just (sum [1,2,3])             = Just 6                        -- (definition of sum)
4 Likes

Thanks for your reply. That is what I was hoping for.
(To carve into my brain: “fmap of function is function composition”)

Still I don’t get the first step of the reasoning. Why there? Is it because it’s the only way the expression type-checks ? Is it because of associativity and precedence ?

The key thing to understand here is fmap . fmap, which is an instance of a more general pattern of n-times fmap composition.

  1. fmap f x applies f to all values in a functor, one level deep, so x could have types such as the following:
    x :: [a]
    x :: Maybe a
    x :: r -> a
    ...
    
  2. (fmap . fmap) f x goes two levels deep, so x could have types such as the following:
    x :: [[a]]
    x :: Maybe [a]
    x :: [Maybe a]
    x :: r -> [a]
    ...
    
  3. (fmap . fmap . fmap) f x goes three levels deep, so x could have types such as the following:
    x :: [[[a]]]
    x :: Maybe (Maybe (Maybe a))
    x :: [Maybe [a]]
    x :: r -> Maybe [a]
    x :: [Maybe (r -> a)]
    x :: r1 -> r2 -> r3 -> a
    ...
    

and so on and so forth. It’s all about reaching that a in nested functorial contexts.

Now let’s take a look at your example, and in particular this fragment:

(fmap . fmap) sum Just

The type of Just is a -> Maybe a, so with fmap . fmap you’re reaching two levels deep:

  • the outer functorial context is a ->
  • the inner functorial context is Maybe

And then you reach some a within it, to which sum is applied. Of course sum expects a foldable t b, so type inference instantiates a ~ t b, and you get:

ghci> :t (fmap . fmap) sum Just
(fmap . fmap) sum Just :: (Foldable t, Num b) => t b -> Maybe b

Now you have a function that expects t b and turns it into Maybe b. You apply it to a list [1, 2, 3], which instantiates t ~ [] and b ~ Integer.

3 Likes

Thanks! It is quite clear now.
Although, I remember reading about “Functors stacking” and using composition of fmap to "peel of the outer Functor layers, I am still not… used to the ((->) r) functor.

Also, I still can’t figure out how you can read:

(fmap . fmap) sum Just [1, 2, 3]

And understand that what’s really going on is:

(fmap . fmap) sum Just $ [1, 2, 3]

I like the simplicity of Haskell syntax, but “everything” (I mean data constructor, function calls, argument list) looks the same. This is quite confusing…

Function application f x is left-associative, so f a b c is to be read as ((f a) b) c.

The structure of your expression is this:

(((fmap . fmap) sum) Just) [1, 2, 3]

and then it’s a matter of style which parentheses to omit or whether to add a gratuitous $.

1 Like

First you do parenthesis, so you do fmap . fmap.
Afterwards you have just function application so:

sum applied to (fmap . fmap)
Just applied to ((fmap . fmap) sum)
[1, 2, 3] applied to (((fmap . fmap) sum) Just)

You have functions and you apply functions to them and you get functions.
You can do type driven development to find out their types.

You can use holes or ask the REPL for the type of things.

f :: _
f = fmap . fmap

tells us

    • Found type wildcard ‘_’
        standing for ‘(a -> b) -> f0 (f1 a) -> f0 (f1 b)’

and

    • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’
      prevents the constraint ‘(Functor f0)’ from being solved.

and

    • Ambiguous type variable ‘f1’ arising from a use of ‘fmap’
      prevents the constraint ‘(Functor f1)’ from being solved.

so we conclude

f :: (Functor f0, Functor f1) => (a -> b) -> f0 (f1 a) -> f0 (f1 b)
f = fmap . fmap

Next, applying sum, and repeating the same finding out process:

g :: (Foldable t0, Functor f0, Functor f1) => f0 (f1 (t0 Integer)) -> f0 (f1 Integer)
g = f sum

Note, this is actually:

g :: (Foldable t0, Functor f0, Functor f1, Num a) => f0 (f1 (t0 a)) -> f0 (f1 a)
g = f sum
-- recall sum
-- sum :: (Foldable t, Num a) => t a -> a

And again:

h :: (Foldable t0, Num a) => t0 a -> Maybe a
h = g Just

And again:

i :: Maybe Integer
i = h [1, 2, 3]

You can do the reverse to verify:

j = let f2 = fmap . fmap
        g2 = f2 sum
        h2 = g2 Just :: _
    in h2 [1, 2, 3]

reveals

h2 :: [Integer] -> Maybe Integer

and

j = let f2 = fmap . fmap
        g2 = f2 sum :: _
        h2 = g2 Just :: [Integer] -> Maybe Integer
    in h2 [1, 2, 3]

reveals

g2 :: ([Integer] -> Maybe [Integer]) -> [Integer] -> Maybe Integer

and

j = let f2 = fmap . fmap :: _
        g2 = f2 sum :: ([Integer] -> Maybe [Integer]) -> [Integer] -> Maybe Integer
        h2 = g2 Just :: [Integer] -> Maybe Integer
    in h2 [1, 2, 3]

reveals

f2 :: (a1 -> b1) -> ([Integer] -> Maybe a1) -> [Integer] -> Maybe b1

and now you can match them, for example:

g :: (Foldable t0, Functor f0, Functor f1, Num a) => f0 (f1 (t0 a)) -> f0 (f1 a)
g2 :: ([Integer] -> Maybe [Integer]) -> [Integer] -> Maybe Integer

remembering that functions always take one value and return one value, I add redundant parens

g2 :: ([Integer] -> Maybe [Integer]) -> ([Integer] -> Maybe Integer)

remembering that a -> b is (->) a b

g2 :: ((->) [Integer] Maybe [Integer]) -> ((->) [Integer] Maybe Integer)

a bit of redundant parens

g2 :: (((->) [Integer]) Maybe [Integer]) -> (((->) [Integer]) Maybe Integer)

and we can see it checks out

[] satisfies Foldable t0
(-> [Integer]) satisfies Functor f0
Maybe satisfies Functor f1
Integer satisfies Num a

And why does (fmap . fmap) look like that? Function application, too:

fmap :: Functor f => (a -> b) -> f a -> f b
(.) :: (b -> c) -> (a -> b) -> a -> c

-- fmap :: (a -> b) -> f a -> f b ~ (a -> b) -> (f a -> f b)
-- in first argument of (.) we have: b ~ (a1 -> b1); c ~ (f1 a1 -> f1 b1)
-- applying we have: (.) fmap :: Functor f1 => (a -> (a1 -> b1)) -> a -> (f1 a1 -> f1 b1)
-- in first argument of (.) fmap we have a ~ (a2 -> b2); (a1 -> b1) ~ (f2 a2 -> f2 b2)
-- applying we have: (.) fmap fmap :: Functor f1, f2 => (a2 -> b2) -> (f1 (f2 a2) -> f1 (f2 b2))
-- cleaning up we have: (.) fmap fmap :: Functor f0, f1 => (a -> b) -> f0 (f1 a) -> f0 (f1 b)

see

f :: _
f = (.) fmap
    • Found type wildcard ‘_’
        standing for ‘(a -> a1 -> b) -> a -> f0 a1 -> f0 b’

checks out!

2 Likes

Thanks for your clear answer. It makes sense.
While reading further, I stumble on that one:

data Query = Query
data SomeObj = SomeObj
data IoOnlyObj = IoOnlyObj

fetchFn :: Query -> IO [String]
decodeFn :: String -> Either Err SomeObj
decodeFn = undefined

makeIoOnlyObj :: [SomeObj] -> IO [(SomeObj, IoOnlyObj)]

pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn = (traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn

I was trying to understand the first part of the pipelineFn function. So I did:

ghci> :t (traverse makeIoOnlyObj . traverse decodeFn =<<)
(traverse makeIoOnlyObj . traverse decodeFn =<<) :: IO [String] -> IO (Either Err [(SomeObj, IoOnlyObj)])

And I tried to parenthesize the expression to see if I understand how this is actually evaluated.

So there is an infix function composition so I tried:

ghci> :t (.) (traverse makeIoOnlyObj) (traverse decodeFn =<<)
(.) (traverse makeIoOnlyObj) (traverse decodeFn =<<)
  :: Either Err [String] -> IO (Either Err [(SomeObj, IoOnlyObj)])

Nope. Missed something. Oh wait (=<<) is also an infix operator but with a lower precedence…

Could it be:

ghci> :t (=<<) (traverse makeIoOnlyObj . traverse decodeFn)
(=<<) (traverse makeIoOnlyObj . traverse decodeFn)
  :: IO [String] -> IO (Either Err [(SomeObj, IoOnlyObj)])

Yeah! Victory!

But seriously this is like reading C function pointer typedef declarations where you have to read backward!!!
How much of this mushy syntax is really necessary?!
Wouldn’t be possible to make it a bit less terse and MUCH more readable while keeping the expressive power by adding some required parenthesis here and there?

1 Like

Nothing prevents you to add the parentheses to make it clearer.
If we take the simple example of addition and multiplication, then 2 * 3 + 4 will be parsed as (2 * 3) + 4 because multiplication has a higher precedence than addition. Which you can write like that if you want. [Note that the parentheses are necessary if you want it to be 2 * (3 + 4).]

o_0 …is that also from Haskell Programming from 1st Principles?

Instead of code golfing, I would have just written that definition using standard Haskell 2010 do-notation:

pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn q = do sl <- fetchFn q
                  let ol' = traverse decodeFn sl
                  traverse makeIoOnlyObj ol'

Noticing that traverse decodeFn is an ordinary Haskell function (no I/O), then:

pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn q = do ol' <- fmap (traverse decodeFn) (fetchFn q)
                  traverse makeIoOnlyObj ol'

Having reduced the do-block to just two lines:

pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn q =
  fmap (traverse decodeFn) (fetchFn q) >>= traverse makeIoOnlyObj

K.I.S.S.

3 Likes

I would hate to read code like this in a codebase I was working in. It’s not necessary at all. I suggest the following:

(traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn
== ((traverse makeIoOnlyObj . traverse decodeFn) =<<) . fetchFn
== (=<<) (traverse makeIoOnlyObj . traverse decodeFn) . fetchFn
== \x -> ((=<<) (traverse makeIoOnlyObj . traverse decodeFn) (fetchFn x))
== \x -> (traverse makeIoOnlyObj . traverse decodeFn) =<< fetchFn x)
== \x -> do
    y <- fetchFn x
    (traverse makeIoOnlyObj . traverse decodeFn) y
== \x -> do
    y <- fetchFn x
    traverse (makeIoOnlyObj . decodeFn) y
== \x -> do
    y <- fetchFn x
    for y (makeIoOnlyObj . decodeFn)
== \x -> do
    y <- fetchFn x
    for y $ \z ->
        (makeIoOnlyObj . decodeFn) z
== \x -> do
    y <- fetchFn x
    for y $ \z ->
        makeIoOnlyObj (decodeFn z)

Let’s compare:

(traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn

vs

\x -> do
    y <- fetchFn x
    for y $ \z ->
        makeIoOnlyObj (decodeFn z)

I hugely prefer the latter (and it would be even better if descriptive names were chosen instead of x and y).

1 Like

Yep.

The whole point of (traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn was to write the whole pipeline in point-free style.

But, is it really worth it ? I don’t think so. Especially when I see your version: clean and readable.

2 Likes

Exactly. Just because you can… doesn’t mean you should :upside_down_face:

Happy learning :+1:

Exactly.


Hi,

Thank for your answer. I like how you apply equational reasoning.
However, there is on step in your reasoning that I don’t get, and I am not sure it actually works:

== \x -> do
    y <- fetchFn x
    (traverse makeIoOnlyObj . traverse decodeFn) y
== \x -> do
    y <- fetchFn x
    traverse (makeIoOnlyObj . decodeFn) y

How can (traverse makeIoOnlyObj . traverse decodeFn) y be equal to
traverse (makeIoOnlyObj . decodeFn) y ?
How can makeIoOnlyObj and decodeFn compose ?

Thanks for help

As someone who overindulges in point-free style, I wouldn’t use the =<< operator section here. Writing it out in longhand with do-notation is probably pedagogically preferable in many ways, but I think there’s also a certain clarity to the following:

pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn = traverse makeIoOnlyObj . traverse decodeFn <=< fetchFn

-- In some contexts I would choose the left-to-right version:
pipelineFn = fetchFn >=> traverse decodeFn >>> traverse makeIoOnlyObj

The <=< and >=> operators compose ‘Kleisli arrows’, or functions that return something wrapped in a monad. Per the docs:

Since the types of fetchFn, the composed traverse-als, and your final pipelineFn all have this a -> m b form, it’s a natural operator to reach for.

1 Like

Ah yes, you’re right! My in-brain type checker failed. I guess the sequence should continue like

\x -> do
    y <- fetchFn x
    (traverse makeIoOnlyObj . traverse decodeFn) y
== \x -> do
    y <- fetchFn x
    let z :: Either Err [SomeObj]
        z = traverse decodeFn y

    traverse makeIoOnlyObj z

I’m a proponent of effect systems (particularly Bluefin and effectful), and I think using one could make the code clearer, because it would allow the error handling and the I/O to be done in the same monad. It could look something like

\x -> do
    y <- fetchFn x
    z <- traverse decodeFn y
    makeIoOnlyObj z

or, for someone who insists on point-free style

makeIoOnlyObj <=< traverse decodeFn <=< fetchFn

Each is much clearer to me than

(traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn