{-|

Module      : MyState
Description : Deriving the State Monad
Copyright   : © Frank Jung, 2020,2021,2022
License     : GPL-3

A simple State monad implementation to explore it's characteristics.

Based on many articles, but principally from:
<http://brandon.si/code/the-state-monad-a-tutorial-for-the-confused/ The State Monad: A Tutorial for the Confused?>

-}

{-# LANGUAGE TupleSections #-}

module MyState (
                MyState(..)   -- MyState type with runState function
              , get         -- Get current state
              , put         -- Set current state
              , modify      -- Modify state function
              , evalState   -- Results of state function
              , execState   -- Final state
             ) where

-- | Mock of MyState data type. (Not yet a Monad, Functor or Applicative.)
newtype MyState s a = MyState { forall s a. MyState s a -> s -> (a, s)
runState :: s -> (a, s) }

-- | Returns current state.
get :: MyState s s
get :: forall s. MyState s s
get = (s -> (s, s)) -> MyState s s
forall s a. (s -> (a, s)) -> MyState s a
MyState ((s -> (s, s)) -> MyState s s) -> (s -> (s, s)) -> MyState s s
forall a b. (a -> b) -> a -> b
$ \s
s -> (s
s, s
s)

-- | Replace current state with the given value. Returns unit.
put :: s -> MyState s ()
put :: forall s. s -> MyState s ()
put s
s = (s -> ((), s)) -> MyState s ()
forall s a. (s -> (a, s)) -> MyState s a
MyState ((s -> ((), s)) -> MyState s ()) -> (s -> ((), s)) -> MyState s ()
forall a b. (a -> b) -> a -> b
$ ((), s) -> s -> ((), s)
forall a b. a -> b -> a
const ((), s
s)

-- | Update current state using the given function.
modify :: (s -> s) -> MyState s ()
modify :: forall s. (s -> s) -> MyState s ()
modify s -> s
f = MyState s s
forall s. MyState s s
get MyState s s -> (s -> MyState s ()) -> MyState s ()
forall a b. MyState s a -> (a -> MyState s b) -> MyState s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> MyState s ()
forall s. s -> MyState s ()
put (s -> MyState s ()) -> (s -> s) -> s -> MyState s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f

-- | Returns results of state function.
evalState :: MyState s a -> s -> a
evalState :: forall s a. MyState s a -> s -> a
evalState MyState s a
f = (a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> (s -> (a, s)) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyState s a -> s -> (a, s)
forall s a. MyState s a -> s -> (a, s)
runState MyState s a
f

-- | Returns final state.
execState :: MyState s a -> s -> s
execState :: forall s a. MyState s a -> s -> s
execState MyState s a
f = (a, s) -> s
forall a b. (a, b) -> b
snd ((a, s) -> s) -> (s -> (a, s)) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyState s a -> s -> (a, s)
forall s a. MyState s a -> s -> (a, s)
runState MyState s a
f

-- Functor
instance Functor (MyState s) where
  fmap :: forall a b. (a -> b) -> MyState s a -> MyState s b
fmap a -> b
f (MyState s -> (a, s)
stateFx) =
    (s -> (b, s)) -> MyState s b
forall s a. (s -> (a, s)) -> MyState s a
MyState (\s
s -> let (a
fx, s
s') = s -> (a, s)
stateFx s
s
                 in (a -> b
f a
fx, s
s'))

-- Applicative
instance Applicative (MyState s) where
  pure :: forall a. a -> MyState s a
pure a
x = (s -> (a, s)) -> MyState s a
forall s a. (s -> (a, s)) -> MyState s a
MyState (a
x,)
  <*> :: forall a b. MyState s (a -> b) -> MyState s a -> MyState s b
(<*>) (MyState s -> (a -> b, s)
stateFx) (MyState s -> (a, s)
nextFx) =
    (s -> (b, s)) -> MyState s b
forall s a. (s -> (a, s)) -> MyState s a
MyState (\s
s -> let (a -> b
fx', s
s')   = s -> (a -> b, s)
stateFx s
s
                       (a
fx'', s
s'') = s -> (a, s)
nextFx s
s'
                   in (a -> b
fx' a
fx'', s
s''))

-- Monad
instance Monad (MyState s) where
  return :: forall a. a -> MyState s a
return = a -> MyState s a
forall a. a -> MyState s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  -- Bind signature:
  -- (>>=) :: Monad m => m a -> (a -> m b) -> m b
  -- (>>=) :: MyState s a -> (a -> MyState s b) -> MyState s b
  -- (>>=) :: (s -> (a, s)) -> (a -> s -> (b, s)) -> (s -> (b, s))
  >>= :: forall a b. MyState s a -> (a -> MyState s b) -> MyState s b
(>>=) (MyState s -> (a, s)
stateFx) a -> MyState s b
nextFx =
    (s -> (b, s)) -> MyState s b
forall s a. (s -> (a, s)) -> MyState s a
MyState (\s
s -> let (a
fx, s
s') = s -> (a, s)
stateFx s
s
                 in MyState s b -> s -> (b, s)
forall s a. MyState s a -> s -> (a, s)
runState (a -> MyState s b
nextFx a
fx) s
s')