applicative rewrite (Haskell) - haskell

When I don't grasp how an expression in Haskell works I often find it helps to decompose it into a more basic form.
Using the following definitions
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA [] = pure []
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
instance Applicative ((->) r) where
pure x = (\_ -> x)
f <*> g = \x -> f x (g x)
I rewrote sequenceA [(+3),(+2)] 3 as
(\_ -> (:)) <*> (+3) <*> ((\_ -> (:)) <*> (+2) <*> (\_-> [])) $ 3
And then turned it into (please excuse the format; I'm not sure what the convention is for splitting lines)
(\d ->(\c->(\b -> (\a -> (\_ -> (:)) a (+3) a) b (\_ -> (:)) b) c (+2) c) d (\_ -> []) d) 3
This seems right when I work through it by hand, but I can't get GHCi to accept it. What have I done wrong here? My second question is how to convert from this form into functional composition. I've tried substituing dots in various combinations, but GHCi rejects all of them....

Being an idle goodfornothing, I thought I would make a computer do the expansion for me. So into GHCi, I typed
let pu x = "(\\_ -> " ++ x ++ ")"
let f >*< a = "(\\g -> " ++ f ++ " g (" ++ a ++ " g))"
So now I have funny versions of pure and <*> which map strings which look like expressions to string which look like more complicated expressions. I then defined, similarly, the analogue of sequenceA, replacing functions by strings.
let sqa [] = pu "[]" ; sqa (f : fs) = (pu "(:)" >*< f) >*< sqa fs
I was then able to generate the expanded form of the example as follows
putStrLn $ sqa ["(+3)","(+2)"] ++ " 3"
which duly printed
(\g -> (\g -> (\_ -> (:)) g ((+3) g)) g ((\g -> (\g -> (\_ -> (:)) g ((+2) g)) g ((\_ -> []) g)) g)) 3
This last, copied to the prompt, yielded
[6,5]
Comparing the output from my "metaprogram" with the attempt in the question shows a shorter initial prefix of lambdas, arising from a shallower nesting of <*> operations. Remember, it's
(pure (:) <*> (+3)) <*> ((pure (:) <*> (+2)) <*> pure [])
so the outer (:) should be only three lambdas deep. I suspect the proposed expansion may correspond to a differently bracketed version of the above, perhaps
pure (:) <*> (+3) <*> pure (:) <*> (+2) <*> pure []
Indeed, when I evaluate
putStrLn $ pu "(:)" >*< "(+3)" >*< pu "(:)" >*< "(+2)" >*< pu "[]" ++ " 3 "
I get
(\g -> (\g -> (\g -> (\g -> (\_ -> (:)) g ((+3) g)) g ((\_ -> (:)) g)) g ((+2) g)) g ((\_ -> []) g)) 3
which looks like it matches the (updated)
(\d -> (\c -> (\b -> (\a -> (\_ -> (:)) a ((+3) a)) b ((\_ -> (:)) b)) c ((+2) c)) d ((\_ -> []) d)) 3
I hope this machine-assisted investigation helps to clarify what's going on.

You rewrote (\_ -> (:)) <*> (+3) as \a -> (\_ -> (:)) a (+3) a, which is rewriting f <*> g as f x g x instead of f x (g x). I think you made that mistake for every <*>.

It might be easier to use combinators, e.g. _S and _K, symbolically, and not their definitions as lambda-expressions,
_S f g x = f x (g x)
_K x y = x
With functions, fmap is (.) and <*> is _S, as others already mentioned. So,
sequenceA [(+3),(+2)] 3 ==
( ((:) <$> (+3)) <*> sequenceA [(+2)] ) 3 ==
_S ((:).(+3)) ( ((:) <$> (+2)) <*> pure [] ) 3 ==
_S ((:).(+3)) ( _S ((:).(+2)) (_K []) ) 3 ==
((:).(+3)) 3 ( _S ((:).(+2)) (_K []) 3 ) ==
((:).(+3)) 3 ( ((:).(+2)) 3 (_K [] 3) ) ==
(6:) ( (5:) [] ) ==
[6,5]
So it might be easier to decompose expressions down to basic functions and combinators and stop there (i.e. not decomposing them to their lambda expressions), using their "re-write rules" in manipulating the expression to find its more comprehensible form.
If you wanted to, you could now write down for yourself a more abstract, informal re-write rule for sequenceA as
sequenceA [f,g,..., z] ==
_S ((:).f) . _S ((:).g) . _S ..... . _S ((:).z) . _K []
and so
sequenceA [f,g,..., z] a ==
((:).f) a $ ((:).g) a $ ..... $ ((:).z) a $ _K [] a ==
(f a:) $ (g a:) $ ..... $ (z a:) $ [] ==
[f a, g a, ..., z a]
and hence
sequenceA fs a == map ($ a) fs == flip (map . flip ($)) fs a
to wit,
Prelude Control.Applicative> flip (map . flip ($)) [(+3),(+2)] 3
[6,5]

Related

Simplification of way too long Haskell function

I wrote a function to query currency exchanges rate from an API. It works fine, but the code is way too long and unreadable. I thought someone would be able to help me simplify this, especially because there are many repeated patterns and operators like the repeated use of
EDIT: I didn't realize that binding anything to pure is absolutely useless!
... <&> (=<<) (something >>= pure) ...
I've just started learning Haskell and therefore don't know many clever operators/functions/lenses that could be used here.
Btw, I am aware that do-notation exists.
forex :: (String, String) -> IO (Maybe (Scientific, UnixTime))
forex cp = (get ("https://www.freeforexapi.com/api/live?pairs=" ++ uncurry (++) cp) <&> decode . flip (^.) responseBody <&> (=<<) (parseMaybe (.: "rates") >>= pure) :: IO (Maybe (Map Key (Map Key Scientific)))) <&> (=<<) (Data.Map.lookup (fromString (uncurry (++) cp)) >>= pure) <&> (=<<) ((pure . toList) >>= pure) <&> (=<<) (pure . map snd >>= pure) <&> fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
The received JSON looks like this
{"rates":{"EURUSD":{"rate":1.087583,"timestamp":1649600523}},"code":200}
Thanks in advance.
Wow, that is too long. Let's take it step by step; by the end, we will arrive at the following code snippet which I find much more natural to read but which performs exactly the same computation:
forex (c, p) = extractFirstTime c p
<$> get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
extractFirstTime c p response = firstTime
<$> parseAndLookUp c p (response ^. responseBody)
parseAndLookUp c p body =
decode body >>=
parseMaybe (.: "rates") >>=
Data.Map.lookup (fromString (c ++ p))
firstTime = case Data.Map.elems m of
k:t:_ -> (k, UnixTime ((CTime . fromRight 0 . floatingOrInteger) t) 0)
Let's see how.
To start, I think it's easier to see and edit if there are strategically chosen line breaks.
forex cp =
(get ("https://www.freeforexapi.com/api/live?pairs=" ++ uncurry (++) cp)
<&> decode . flip (^.) responseBody
<&> (=<<) (parseMaybe (.: "rates") >>= pure)
:: IO (Maybe (Map Key (Map Key Scientific)))
)
<&> (=<<) (Data.Map.lookup (fromString (uncurry (++) cp)) >>= pure)
<&> (=<<) ((pure . toList) >>= pure)
<&> (=<<) (pure . map snd >>= pure)
<&> fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
One of the monad laws is m >>= pure = m, so let's delete >>= pure everywhere. (One each on lines 4, 7, 8, and 9.)
forex cp =
(get ("https://www.freeforexapi.com/api/live?pairs=" ++ uncurry (++) cp)
<&> decode . flip (^.) responseBody
<&> (=<<) (parseMaybe (.: "rates"))
:: IO (Maybe (Map Key (Map Key Scientific)))
)
<&> (=<<) Data.Map.lookup (fromString (uncurry (++) cp))
<&> (=<<) (pure . toList)
<&> (=<<) (pure . map snd)
<&> fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
Another monad law is m >>= pure . f = fmap f m. Let's simplify with that law where possible. (One each on lines 8 and 9.)
forex cp =
(get ("https://www.freeforexapi.com/api/live?pairs=" ++ uncurry (++) cp)
<&> decode . flip (^.) responseBody
<&> (=<<) (parseMaybe (.: "rates"))
:: IO (Maybe (Map Key (Map Key Scientific)))
)
<&> (=<<) Data.Map.lookup (fromString (uncurry (++) cp))
<&> fmap toList
<&> fmap (map snd)
<&> fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
The uses of uncurry are happening because we're not pattern-matching on cp. Let's fix that up. (Lines 1, 2, and 7.)
forex (c, p) =
(get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
<&> decode . flip (^.) responseBody
<&> (=<<) (parseMaybe (.: "rates"))
:: IO (Maybe (Map Key (Map Key Scientific)))
)
<&> (=<<) Data.Map.lookup (fromString (c ++ p))
<&> fmap toList
<&> fmap (map snd)
<&> fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
My mental type-checker is going nuts. Let's split this calculation into three different kinds of things: one that works in IO, one that works in Maybe, and one that is pure. First let's split the IO from everything else.
forex (c, p) = extractFirstTime c p
<$> get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
extractFirstTime c p response = response
& decode . flip (^.) responseBody
& (=<<) (parseMaybe (.: "rates"))
& (=<<) Data.Map.lookup (fromString (c ++ p))
& fmap toList
& fmap (map snd)
& fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
Now let's split out the Maybe parts.
forex (c, p) = extractFirstTime c p
<$> get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
extractFirstTime c p response = parseAndLookUp c p (response ^. responseBody)
& fmap toList
& fmap (map snd)
& fmap (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
parseAndLookUp c p body =
decode body >>=
parseMaybe (.: "rates") >>=
Data.Map.lookup (fromString (c ++ p))
And let's split out the pure parts. One of the functor laws is fmap f . fmap g = fmap (f . g), so we can merge the three fmaps in extractFirstTime. At that point, the two arguments to (&) that remain are short enough that we can inline the definition of (&). I'll also use the name (<$>) instead of fmap; I think it reads a bit clearer.
forex (c, p) = extractFirstTime c p
<$> get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
extractFirstTime c p response = firstTime
<$> parseAndLookUp c p (response ^. responseBody)
parseAndLookUp c p body =
decode body >>=
parseMaybe (.: "rates") >>=
Data.Map.lookup (fromString (c ++ p))
firstTime m = m
& toList
& map snd
& (\y -> (head y, UnixTime ((CTime . fromRight 0 . floatingOrInteger) (y !! 1)) 0))
Data.Map has a name for map snd . toList, namely, elems. Instead of using head and !!, let's use pattern matching to pick out the elements we want. (All changes are in firstTime.)
forex (c, p) = extractFirstTime c p
<$> get ("https://www.freeforexapi.com/api/live?pairs=" ++ c ++ p)
extractFirstTime c p response = firstTime
<$> parseAndLookUp c p (response ^. responseBody)
parseAndLookUp c p body =
decode body >>=
parseMaybe (.: "rates") >>=
Data.Map.lookup (fromString (c ++ p))
firstTime = case Data.Map.elems m of
k:t:_ -> (k, UnixTime ((CTime . fromRight 0 . floatingOrInteger) t) 0)
There are likely additional beautifying things that could be done (adding type signatures comes to mind, and I have several ideas that change/improve the behavior of the code), but I think by this point you have something that's fairly reasonable to read and understand. Along the way, making things readable has, as a side effect, eliminated the repeated code snippets you found unnerving, so that's a little bonus; but if they had remained, it would be very natural to try to address them as an additional step.

How to implement uncurry point-free in Haskell without app?

I have been wondering how different standard Haskell functions could be implemented point-free. Currently, I am interested in uncurry and I feel this one is quite non-trivial.
The main problem is that we are unable (or as it seems to me) to group the arguments. If we had uncurry (in fact, uncurry ($) would suffice) in use, the solution would have been quite simple:
Make a tuple (f, (x, y)).
Apply assoc1 :: (a, (b, c)) -> ((a, b), c) to the tuple and get ((f, x), y).
Apply the uncurried ($) to the first element of the pair and get (f x, y).
Apply the uncurried ($) to the pair itself and get f x y.
Without the uncurried ($) we would have to extract both elements of the pair separately. E.g.:
uncurry f pair = f (fst pair) (snd pair)
I do not reckon this to be a smooth way to implement something point-free.
In fact, we have got this uncurried ($) at our behest: Control.Arrow.apply (other useful for the solution combinators could also be imported from Control.Arrow). Therefore:
import Control.Arrow ((>>>), (&&&), first, app)
myUncurry = let myAssoc1 = (fst &&& (fst . snd)) &&& (snd . snd)
in (,) >>> (>>> myAssoc1 >>> first app >>> app)
Yet, this feels a small bit like cheating.
Are there any other approaches towards this problem which do not require anything like app?
join on functions gives you (a -> a -> b) -> a -> b, so:
myUncurry f = join (\x y -> f (fst x) (snd y))
myUncurry f = join (\x -> f (fst x) . snd)
myUncurry f = join ((.snd) . f . fst)
myUncurry f = join ((.fst) ((.snd) . f))
myUncurry f = join ((.fst) ((.) (.snd) f))
myUncurry = join . (.fst) . \f -> (.) (.snd) f
myUncurry = join . (.fst) . ((.snd).)
join . (.fst) . ((.snd).) is very readable indeed
The artless, mechanical solution, by "pushing lambdas inward".
uncurry f (x,y) = f x y
uncurry f p = f (fst p) (snd p)
uncurry f = \p -> f (fst p) (snd p)
uncurry f = (<*>) (\p -> f (fst p)) (\p -> snd p)
uncurry f = (<*>) (f . fst) snd
uncurry = \f -> (<*>) (f . fst) snd
uncurry = flip (\f -> (<*>) (f . fst)) snd
uncurry = flip ((<*>) . (\f -> f . fst)) snd
uncurry = flip ((<*>) . (. fst)) snd
With Lambda Calculus' S combinator, Sabc = (a <*> b) c = a c $ b c,
uncurry f (x,y) = f (fst (x,y)) (snd (x,y))
= (f . fst <*> snd) (x,y)
uncurry f = (<*> snd) (f . fst)
= (<*> snd) . (. fst) $ f
hence,
uncurry :: (a -> b -> c) -> (a, b) -> c
uncurry = (<*> snd) . (. fst)
(edit:)
Still it's much more readable (and somewhat elucidating) with one explicit argument left there, as seen above:
uncurry f = f . fst <*> snd
But then this variant, shown by Jon Purdy in the comments,
uncurry f = liftA2 f fst snd
just might be the clearest.
This is because for functions, the monad and the applicative are equivalent in power,
(k =<< f) x = k (f x) x = flip k x (f x) = (flip k <*> f) x
-- i.e., uncurry f = flip (f . fst) =<< snd
and liftA2 f fst snd means, by definition,
= [ f a b | a <- fst ; b <- snd ]
=
do { a <- fst ;
b <- snd ;
return (f a b)
}
= \x -> let
{ a = fst x ;
b = snd x ;
}
in const (f a b) x
(the first one written with Monad Comprehensions). Thus,
uncurry f x = liftA2 f fst snd x
= let
{ a = fst x ;
b = snd x ;
}
in f a b
=
f (fst x) (snd x)
=
(f . fst <*> snd) x
=
(flip (f . fst) =<< snd) x
=
flip (f . fst) (snd x) x
=
(flip (f . fst) . snd) x x
=
join (flip (f . fst) . snd) x
=
join (flip (f . fst) <$> snd) x
following the well known equivalence, k =<< m = join (fmap k m) (and for functions, (<$>) = fmap = (.)).
So we've found yet another expression here,
uncurry f x = join (flip (f . fst) . snd)
= liftA2 f fst snd
= f . fst <*> snd
= flip (f . fst) =<< snd
The liftA2 one just might be the clearest and the least noisy.

How to combine two composed applicative functors?

I have two composed applicative functors Maybe [Integer] and want to combine them with <$>/<*> but I am stuck with applying the applicative operation. The following does not typecheck:
(<*>) (<*>) ((<$>) ((+) <$>) $ Just [1,2,3]) $ Just [4,5,6]
Expected result:
Just [5,6,7,6,7,8,7,8,9]
The functor part works, i.e. the intermediate value passed to <*> as the first argument is Just [Integer -> Integer]. I am used to S-expressions so I have a hard time with the Haskell syntax. I know of Compose but I am interested in the mere composition wihtout abstraction.
As Li-yao Xia said, using liftA2 makes it a lot less confusing.
But if you still what to see what it becomes in terms of the underlaying operations, we can expand the definition of liftA2:
liftA2 :: (a -> b -> c) -> f a -> f b -> f c
liftA2 f x y = f <$> x <*> y
so the solution becomes
(liftA2 . liftA2) (+) (Just [1,2,3]) (Just [4,5,6])
= liftA2 (liftA2 (+)) (Just [1,2,3]) (Just [4,5,6])
= (\f x y -> f <$> x <*> y) ((\f x y -> f <$> x <*> y) (+)) (Just [1,2,3]) (Just [4,5,6])
= ((\f x y -> f <$> x <*> y) (+)) <$> Just [1,2,3] <*> Just [4,5,6]
= (\x y -> (+) <$> x <*> y) <$> Just [1,2,3] <*> Just [4,5,6]
Now, this is not in point free style like your example above, and I really don't think it's helpful to convert it into point free, but here's the output from http://pointfree.io:
((<*>) . ((+) <$>)) <$> Just [1, 2, 3] <*> Just [4, 5, 6]
we can see that this is the same by eta-expanding:
(<*>) . ((+) <$>)
= \x y -> ((<*>) . ((+) <$>)) x y
= \x y -> ((<*>) $ ((+) <$>) x) y
= \x y -> ((<*>) ((+) <$> x)) y
= \x y -> (<*>) ((+) <$> x) y
= \x y -> ((+) <$> x) <*> y
= \x y -> (+) <$> x <*> y
liftA2 might be less confusing for this than (<*>).
(+) :: Int -> Int -> Int
liftA2 (+) :: [Int] -> [Int] -> [Int]
liftA2 (liftA2 (+)) :: Maybe [Int] -> Maybe [Int] -> Maybe [Int]
liftA2 (liftA2 (+)) (Just [1,2,3]) (Just [4,5,6])
The composition of two Applicatives is always an Applicative (unlike the case for Monad).
We can use this to our advantage here with the Compose newtype from Data.Functor.Compose:
newtype Compose f g a = Compose { getCompose :: f (g a) }
It requires a bit of wrapping, but this kind of solution could be useful under the right circumstances:
example :: Maybe [Int]
example =
getCompose ((+) <$> Compose (Just [1,2,3]) <*> Compose (Just [4,5,6]))
One other way could be to use the ListT transformer. While it works just fine in this case, for some reason it's a depreciated transformer, marked in red with "Deprecated: This transformer is invalid on most monads".
import Control.Monad.Trans.List
doit :: (Int-> Int -> Int) -> Maybe [Int] -> Maybe [Int] -> Maybe [Int]
doit f mt1 mt2 = runListT $ f <$> (ListT mt1) <*> (ListT mt2)
λ> doit (+) (Just [1,2,3]) (Just [4,5,6])
Just [5,6,7,6,7,8,7,8,9]

Eta reduction in haskell

I tried for a long time to reduct this function in haskell, I want to express for example:
mySum x y = x + y
mySum x y = (+) x y
mySum x = (+) x
mySum = (+) -- it's Messi's goal!
My function it a little more complex, but I really can't do it, I was looking out here and there, and I know there are some techniques, like modify the right side, and use flip. I tried and I got stuck here:
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f x y = map (uncurry f) (zip x y)
Steps:
zipWith' f x y = map (uncurry f) (zip x y)
zipWith' f x y = flip map (zip x y) (uncurry f)
zipWith' f x y = flip map (zip x y) $ uncurry f
and then I don't know how to continue...
I'm looking for an answer that could explain step by step how to achieve the "Messi's goal", I know is a lot to ask, so I will add as soon as I can a bounty to thank the effort
zipWith' f x y = map (uncurry f) (zip x y)
Rewrite application to composition and eta-reduce:
-- \y -> let g = map (uncurry f); h = zip x in (g . h) y
-- let g = map (uncurry f); h = zip x in g . h
zipWith' f x = map (uncurry f) . zip x
Rewrite infix to prefix:
-- g . h = (.) g h
zipWith' f x = (.) (map (uncurry f)) (zip x)
Rewrite application to composition and eta-reduce:
-- \x -> let g = (.) (map (uncurry f)); h = zip in (g . h) x
-- let g = (.) (map (uncurry f)); h = zip in g . h
zipWith' f = (.) (map (uncurry f)) . zip
Rewrite infix to prefix:
-- g . h = (.) g h
zipWith' f = (.) ((.) (map (uncurry f))) zip
Use flip to move f to the right-hand side:
-- flip f x y = f y x
zipWith' f = flip (.) zip ((.) (map (uncurry f)))
Rewrite application to composition:
-- g (h (i x)) = (g . h . i) x
zipWith' f = flip (.) zip (((.) . map . uncurry) f)
Rewrite application to composition and eta-reduce:
-- \f -> let g = flip (.) zip; h = (.) . map . uncurry in (g . h) f
-- let g = flip (.) zip; h = (.) . map . uncurry in g . h
zipWith' = (flip (.) zip) . ((.) . map . uncurry)
Remove redundant parentheses:
zipWith' = flip (.) zip . (.) . map . uncurry
And simplify to infix if you like:
zipWith' = (. zip) . (.) . map . uncurry
This result isn’t very readable, though.
Often when writing fully point-free code, you want to take advantage of the -> applicative and arrow combinators from Control.Arrow. Rather than trying to write a function like \ f x y -> ..., you can start by grouping the arguments into tuples to make them easier to rearrange and pipe around. In this case I’ll use \ (f, (x, y)) -> ...
\ (f, (x, y)) -> map (uncurry f) (zip x y)
We can eliminate the unpacking of (x, y) by applying uncurry to zip:
\ (f, (x, y)) -> map (uncurry f) (uncurry zip (x, y))
\ (f, xy) -> map (uncurry f) (uncurry zip xy)
Now we have a simple case: applying two functions (uncurry and uncurry zip) to two arguments (f and xy), then combining the results (with map). For this we can use the *** combinator from Control.Arrow, of type:
(***) :: Arrow a => a b c -> a b' c' -> a (b, b') (c, c')
Specialised to functions, that’s:
(***) #(->) :: (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
This just lets us apply a function to each element of a pair. Perfect!
uncurry *** uncurry zip
:: (a -> b -> c, ([x], [y])) -> ((a, b) -> c, [(x, y)])
You can think of uncurry f as combining the elements of a pair using the function f. So here we can combine the results using uncurry map:
uncurry map . (uncurry *** uncurry zip)
:: (a -> b -> c, ([a], [b])) -> [c]
And you can think of curry as turning a function on tuples into a multi-argument function. Here we have two levels of tuples, the outer (f, xy) and the inner (x, y). We can unpack the outer one with curry:
curry $ uncurry map . (uncurry *** uncurry zip)
:: (a -> b -> c) -> ([a], [b]) -> [c]
Now, you can think of fmap f in the -> applicative as “skipping over” the first argument:
fmap #((->) _) :: (a -> b) -> (t -> a) -> t -> b
So we can unpack the second tuple using fmap curry:
fmap curry $ curry $ uncurry map . (uncurry *** uncurry zip)
:: (a -> b -> c) -> [a] -> [b] -> [c]
And we’re done! Or not quite. When writing point-free code, it pays to break things out into many small reusable functions with clearer names, for example:
zipWith' = untuple2 $ combineWith map apply zipped
where
untuple2 = fmap curry . curry
combineWith f g h = uncurry f . (g *** h)
apply = uncurry
zipped = uncurry zip
However, while knowing these techniques is useful, all this is just unproductive trickery that’s easy to get lost in. Most of the time, you should only use point-free style in Haskell when it’s a clear win for readability, and neither of these results is clearer than the simple original version:
zipWith' f x y = map (uncurry f) (zip x y)
Or a partially point-free version:
zipWith' f = map (uncurry f) .: zip
where (.:) = (.) . (.)

How does this piece of obfuscated Haskell code work?

While reading https://en.uncyclopedia.co/wiki/Haskell (and ignoring all the "offensive" stuff), I stumbled upon the following piece of obfuscated code:
fix$(<$>)<$>(:)<*>((<$>((:[{- thor's mother -}])<$>))(=<<)<$>(*)<$>(*2))$1
When I run that piece of code in ghci (after importing Data.Function and Control.Applicative), ghci prints the list of all powers of 2.
How does this piece of code work?
To begin with, we have the lovely definition
x = 1 : map (2*) x
which by itself is a bit mind-bending if you've never seen it before. Anyway it's a fairly standard trick of laziness and recursion. Now, we'll get rid of the explicit recursion using fix, and point-free-ify.
x = fix (\vs -> 1 : map (2*) vs)
x = fix ((1:) . map (2*))
The next thing we're going to do is expand the : section and make the map needlessly complex.
x = fix ((:) 1 . (map . (*) . (*2)) 1)
Well, now we have two copies of that constant 1. That will never do, so we'll use the reader applicative to de-duplicate that. Also, function composition is a bit rubbish, so let's replace that with (<$>) wherever we can.
x = fix (liftA2 (.) (:) (map . (*) . (*2)) 1)
x = fix (((.) <$> (:) <*> (map . (*) . (*2))) 1)
x = fix (((<$>) <$> (:) <*> (map <$> (*) <$> (*2))) 1)
Next up: that call to map is much too readable. But there's nothing to fear: we can use the monad laws to expand it a bit. In particular, fmap f x = x >>= return . f, so
map f x = x >>= return . f
map f x = ((:[]) <$> f) =<< x
We can point-free-ify, replace (.) with (<$>), and then add some spurious sections:
map = (=<<) . ((:[]) <$>)
map = (=<<) <$> ((:[]) <$>)
map = (<$> ((:[]) <$>)) (=<<)
Substituting this equation in our previous step:
x = fix (((<$>) <$> (:) <*> ((<$> ((:[]) <$>)) (=<<) <$> (*) <$> (*2))) 1)
Finally, you break your spacebar and produce the wonderful final equation
x=fix(((<$>)<$>(:)<*>((<$>((:[])<$>))(=<<)<$>(*)<$>(*2)))1)
Was writing a long answer with a full run-through of my IRC logs of the experiments leading up to the final code (this was in early 2008), but I accidentally all the text :) Not that much of a loss though - for the most part Daniel's analysis is spot on.
Here's what I started with:
Jan 25 23:47:23 <olsner> #pl let q = 2 : map (2*) q in q
Jan 25 23:47:23 <lambdabot> fix ((2 :) . map (2 *))
The differences mostly come down to the order in which the refactorings happened.
Instead of x = 1 : map (2*) x I started with 2 : map ..., and I kept that initial 2 right up until the very last version, where I squeezed in a (*2) and changed the $2 at the end into $1. The "make the map needlessly complex" step didn't happen (that early).
I used liftM2 instead of liftA2
The obfuscated map function was put in before replacing liftM2 with Applicative combinators. That's also when all the spaces disappeared.
Even my "final" version had lots of . for function composition left over. Replacing all of those with <$> apparently happened some time in the months between that and uncyclopedia.
BTW, here's an updated version that no longer mentions the number 2:
fix$(<$>)<$>(:)<*>((<$>((:[{- Jörð -}])<$>))(=<<)<$>(*)<$>(>>=)(+)($))$1
Both answers derive the obfuscated code snippet from the short original given out of the blue, but the question actually asks how does the long obfuscated code do its job.
Here's how:
fix$(<$>)<$>(:)<*>((<$>((:[{- thor's mother -}])<$>))(=<<)<$>(*)<$>(*2))$1
= {- add spaces, remove comment -}
fix $ (<$>) <$> (:) <*> ( (<$> ((:[]) <$>) ) (=<<) <$> (*) <$> (*2) ) $ 1
-- \__\______________/_____________________________/
= {- A <$> B <*> C $ 1 = A (B 1) (C 1) -}
fix $ (<$>) (1 :) ( ( (<$> ((:[]) <$>) ) (=<<) <$> (*) <$> (*2) ) 1 )
-- \__\______________/____________________________/
= {- (<$>) A B = (A <$> B) ; (<$> B) A = (A <$> B) -}
fix $ (1 :) <$> ( (((=<<) <$> ((:[]) <$>) ) <$> (*) <$> (*2) ) 1 )
-- \\____________________/____________________________/
= {- <$> is left associative anyway -}
fix $ (1 :) <$> ( ( (=<<) <$> ((:[]) <$>) <$> (*) <$> (*2) ) 1 )
-- \__________________________________________________/
= {- A <$> foo = A . foo when foo is a function -}
fix $ (1 :) <$> ( ( (=<<) <$> ((:[]) <$>) . (*) . (*2) ) 1 )
-- \__________________________________________________/
= {- ((:[]) <$>) = (<$>) (:[]) = fmap (:[]) is a function -}
fix $ (1 :) <$> ( ( (=<<) . ((:[]) <$>) . (*) . (*2) ) 1 )
-- \__________________________________________________/
= {- ( A . B . C . D) 1 = A (B (C (D 1))) -}
fix $ (1 :) <$> (=<<) ( ((:[]) <$>) ( (*) ( (*2) 1 )))
= {- (*2) 1 = (1*2) = 2 -}
fix $ (1 :) <$> (=<<) ( ((:[]) <$>) ( (*) 2 ))
= {- (*) 2 = (2*) -}
fix $ (1 :) <$> (=<<) ( ((:[]) <$>) (2*) )
= {- ( A <$>) B = A <$> B -}
fix $ (1 :) <$> (=<<) ( (:[]) <$> (2*) )
= {- A <$> foo = A . foo when foo is a function -}
fix $ (1 :) <$> (=<<) ( (:[]) . (2*) )
= {- (f . g) = (\ x -> f (g x)) -}
fix $ (1 :) <$> (=<<) (\ x -> [2*x] )
= {- (=<<) A = ( A =<<) -}
fix $ (1 :) <$> ( (\ x -> [2*x] ) =<<)
Here ( (\ x -> [2*x]) =<<) = (>>= (\ x -> [2*x])) = concatMap (\ x -> [2*x]) = map (2*) is a function, so again, <$> = .:
=
fix $ (1 :) . map (2*)
= {- substitute the definition of fix -}
let xs = (1 :) . map (2*) $ xs in xs
=
let xs = 1 : [ 2*x | x <- xs] in xs
= {- xs = 1 : ys -}
let ys = [ 2*x | x <- 1:ys] in 1:ys
= {- ys = 2 : zs -}
let zs = [ 2*x | x <- 2:zs] in 1:2:zs
= {- zs = 4 : ws -}
let ws = [ 2*x | x <- 4:ws] in 1:2:4:ws
=
iterate (2*) 1
=
[2^n | n <- [0..]]
are all the powers of 2, in increasing order.
This uses
A <$> B <*> C $ x = liftA2 A B C x and since liftA2 A B C is applied to x it's a function, an as a function it means liftA2 A B C x = A (B x) (C x).
(f `op` g) = op f g = (f `op`) g = (`op` g) f are the three laws of operator sections
>>= is monadic bind, and since (`op` g) f = op f g and the types are
(>>=) :: Monad m => m a -> (a -> m b ) -> m b
(\ x -> [2*x]) :: Num t => t -> [ t]
(>>= (\ x -> [2*x])) :: Num t => [ t] -> [ t]
by type application and substitution we see that the monad in question is [] for which (>>= g) = concatMap g.
concatMap (\ x -> [2*x]) xs is simplified as
concat $ map (\ x -> [2*x])
=
concat $ [ [2*x] | x <- xs]
=
[ 2*x | x <- xs]
=
map (\ x -> 2*x )
and by definition,
(f . g) x = f (g x)
fix f = let x = f x in x
iterate f x = x : iterate f (f x)
= x : let y = f x in
y : iterate f (f y)
= x : let y = f x in
y : let z = f y in
z : iterate f (f z)
= ...
= [ (f^n) x | n <- [0..]]
where
f^n = f . f . ... . f
-- \_____n_times _______/
so that
((2*)^n) 1 = ((2*) . (2*) . ... . (2*)) 1
= 2* ( 2* ( ... ( 2* 1 )...))
= 2^n , for n in [0..]

Resources