Fun with Applicative, Monad and Monoidal

Applicative.hs

-- See http://blog.ezyang.com/2012/08/applicative-functors/
module Main
       where

import Prelude hiding ((**))
import Control.Monad

bind :: Monad m => m a -> (a -> m b) -> m b
bind = (>>=)

-- join :: Monad m => m (m a) -> m a

join_via_bind :: Monad m => m (m a) -> m a
join_via_bind = (>>= id)

bind_via_join :: (Functor m, Monad m) => m a -> (a -> m b) -> m b
bind_via_join ma f = join $ fmap f ma

class Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

class Functor f => Monoidal f where
  unit :: f ()
  (**) :: f a -> f b -> f (a,b)

-- Functor f => (a -> b) -> f a -> f b

pure_via_monoidal :: Monoidal f => a -> f a
pure_via_monoidal a = fmap (const a) unit

star_via_monoidal :: Monoidal f => f (a -> b) -> f a -> f b
star_via_monoidal ff fa = fmap (\(f,a) -> f a) (ff ** fa)