MonadDefinitions.hs

{-# LANGUAGE FlexibleInstances, UndecidableInstances, InstanceSigs, NoImplicitPrelude #-}

import Prelude(id, ($), (.), putStrLn, undefined)

-- The standard(?) haskell monad definition
class StdMonad m where
  (>>=) :: m a -> (a -> m b) -> m b
  return :: a -> m a 

-- The more mathematical monad defintion
class Functor f where
  fmap :: (a -> b) -> (f a -> f b)

class Functor m => MathMonad m where
    join :: m (m a) -> m a
    jreturn :: a -> m a
    
-- A MathMonad is a StdMonad
instance MathMonad m => StdMonad m where
    ma >>= f = join $ fmap f ma
    return = jreturn
    
-- A StdMonad is a MathMonad (and a Functor)
instance StdMonad m => Functor m where
  fmap f = \ma -> ma >>= (return . f)

{-
-- duplicate instance
instance StdMonad m => MathMonad m where
    join :: StdMonad m => m (m a) -> m a
    join mma = mma >>= id
    jreturn = return
-}

-- Monads defined using Kleisli arrows    
class KleisliMonad m where
    kid :: a -> m a
    (>=>) :: (a -> m b) -> (b -> m c) -> (a -> m c)
    
-- A StdMonad (and also MathMonad since they are equivalent) is a KleisliMonad
instance StdMonad m => KleisliMonad m where
    f >=> g = \a -> let mb = f a in mb >>= g
    kid = return

-- A KleisliMonad is also a StdMonad
{-
-- duplicate instance
instance KleisliMonad m => StdMonad m where
    ma >>= f = id >=> f $ ma
    return = kid
-}

-- Defintion of monad via Free
-- ref: https://www.tweag.io/blog/2018-02-05-free-monads/

data Free f a = 
    Pure a
  | Free (f (Free f a))
  
class Functor m => FMonad m where
    monad :: Free m a -> m a

instance FMonad m => MathMonad m where
    jreturn a = monad $ Pure a
    join = monad . Free . fmap (Free . fmap Pure)

-- fmap :: a -> b -> m a -> m b    
-- monad :: Free m a -> m a
-- Pure :: a -> Free m a
-- Free :: m (Free m a) -> Free m a

-- fmap Pure :: m a -> m (Free m a)
-- Free . fmap Pure :: m a -> Free m a
-- fmap (Free . fmap Pure) :: m (m a) -> m (Free m a)
-- Free . fmap (Free . fmap Pure) :: m (m a) -> Free m a
-- monad . Free . fmap (Free . fmap Pure) :: m (m a) -> m a

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


instance MathMonad m => FMonad m where
    monad (Pure a) = jreturn a
    monad (Free m) = join $ fmap monad m

main = putStrLn "type checked"