Doodle for better understanding Monads.

Monoid.hs

{-# LANGUAGE FlexibleInstances #-}

module Monoid where

-- https://www.youtube.com/watch?v=ZhuHCtR3xq8
-- https://stackoverflow.com/questions/3870088/a-monad-is-just-a-monoid-in-the-category-of-endofunctors-whats-the-problem
-- https://stackoverflow.com/questions/10342876/differences-between-functors-and-endofunctors

import Prelude (($), (.), const, foldr, fst, id, snd)

class Semigroup a where
    (<>) :: a -> a -> a

instance Semigroup (a -> a) where
    (<>) = (.)

class Semigroup a => Monoid a where
    mempty :: a

    mappend :: a -> a -> a
    mappend = (<>)

    mconcat :: [a] -> a
    mconcat = foldr mappend mempty

instance Monoid (a -> a) where
    mempty = id

class Functor f where
    fmap :: (a -> b) -> f a -> f b

    (<$) :: a -> f b -> f a
    (<$) = fmap . const

class Functor m => Monad m where
    return :: a -> m a

    (>>=) :: m a -> (a -> m b) -> m b
    x >>= f = join (fmap f x)

    join :: m (m a) -> m a
    join x = x >>= id
    {-# MINIMAL return, ((>>=) | join) #-}

data Maybe a
    = Just a
    | Nothing

instance Functor Maybe where
    fmap f (Just x) = Just (f x)
    fmap f Nothing  = Nothing

instance Monad Maybe where
    return x = Just x

    Just x  >>= f = f x
    Nothing >>= f = Nothing

    join Nothing         = Nothing
    join (Just Nothing)  = Nothing
    join (Just (Just x)) = Just x

instance Semigroup a => Semigroup (Maybe a) where
    Nothing <> y       = y
    x       <> Nothing = x
    Just x  <> Just y  = Just (x <> y)

instance Semigroup a => Monoid (Maybe a) where
    mempty = Nothing

instance Functor ((->) a) where
    fmap = (.)

instance Monad ((->) a) where
    return = const

    f >>= g = \x -> g (f x) x

newtype State s a = State { runState :: s -> (a, s) }

evalState :: State s a -> s -> a
evalState x s = fst $ runState x s

execState :: State s a -> s -> s
execState x s = snd $ runState x s

instance Functor (State s) where
    fmap f x = State $ \s ->
        let (x', s') = runState x s in (f x', s')

instance Monad (State s) where
    return x = State $ \s -> (x, s)

    x >>= f = State $ \s ->
        let (x', s') = runState x s in runState (f x') s'

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

newtype Reader r a = Reader { runReader :: r -> a }

instance Functor (Reader r) where
    fmap f x = Reader $ \r -> f (runReader x r)

instance Monad (Reader r) where
    return x = Reader (const x)

    x >>= f = Reader $ \r -> runReader (f (runReader x r)) r

ask :: Reader r r
ask = Reader id

local :: (r -> r') -> Reader r' a -> Reader r a
local f x = Reader $ runReader x . f