Composition of Applicative vs. Monads

applicative_monad_compose.hs

-- Source https://stackoverflow.com/a/13209294/2748415

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators     #-}

-- Thud just goes 'Thud'.
data Thud a = Thud
  deriving (Show, Functor)

instance Applicative Thud where
  pure _  = Thud
  _ <*> _ = Thud

instance Monad Thud where
  return _ = Thud
  _ >>= _  = Thud

-- Flip is the Writer of Bool.
data Flip x = Flip Bool x
  deriving (Show, Functor)

instance Applicative Flip where
  pure = return
  (Flip b0 f) <*> (Flip b1 x) = Flip (not $ b0 && b1) (f x)

instance Monad Flip where
  return = Flip False
  Flip False x >>= f = f x
  Flip True x >>= f = Flip (not b) y where Flip b y = f x

-- Introduce composition.
newtype (:.:) f g x = C (f (g x))
  deriving (Show, Functor)

instance Applicative (Flip :.: Thud) where
  pure _ = C (Flip True Thud)
  C (Flip b0 _) <*> C (Flip b1 x) = C (Flip (not $ b0 && b1) Thud)

-- We cannot write the below instance.
--
-- The reason being that `join . return = id` will fail
-- as the given hole in `return` means we can't depend on
-- what `x` may be, so it must be a constant.
--
-- One can look at the Applicative instance for a concrete
-- example of `(Flip :.: Thud)` being a constant.
{-
instance Monad (Flip :.: Thud) where
  return x = C (Flip _ Thud)
  ...
-}