Monad Bind, Associativity Matters

{-# LANGUAGE DeriveFunctor #-}

import Debug.Trace (trace)
import Control.Monad ((>=>))

data Tree a = Node (Tree a) (Tree a) | Leaf a deriving Functor

instance Applicative Tree where
  pure = Leaf
  Leaf f <*> Leaf a = Leaf $ f a
  Leaf f <*> Node a b =  Node (f <$> a) (f <$> b)
  Node f g <*> leaf@(Leaf x) = Node (f <*> leaf) (g <*> leaf)
  Node f g <*> Node a b = Node (f <*> a) (g <*> b)

instance Monad Tree where
  return = pure
  (>>=) = (<-/)

(<-/) :: Tree a -> (a -> Tree b) -> Tree b
(Leaf a) <-/ f = f a
Node l r <-/ f = trace "<-/" (Node (l <-/ f) (r <-/ f))


instance Show a => Show (Tree a) where
  show (Leaf a) = "Leaf " ++ show a
  show (Node l r) = "Node (" ++ show l ++ ") (" ++ show r ++ ")"

x :: Tree Int
x =
  Node
    (Node
      (Leaf 9)
      (Node (Leaf 8) (Leaf 7))
    )
    (Leaf 2)

f x = Leaf $ x * 5
g x = Leaf $ x + 1

main = do

  -- time: |x| + |(x >>= f)| steps
  print $ (x >>= f) >>= g

  trace (replicate 10 '-') (return ())

  -- time: |x >>= f| steps
  print $ x >>= (\x -> f x >>= g)

  trace (replicate 10 '-') (return ())

  print $ x >>= (f >=> g)