A naive implementation of State Monad with Free Monad and left Kan extension.

FreeState.hs

{-# LANGUAGE DeriveFunctor, GADTs, StandaloneDeriving #-}

import Control.Monad.Free

data Lan g a where
    Lan :: (b -> a) -> g b -> Lan g a

deriving instance Functor (Lan g)

data State s a where
    Get :: State s s
    Put :: s -> State s ()

type StateFunctor s = Lan (State s)
type StateMonad s = Free (StateFunctor s)

runStateMonad :: StateMonad s a -> s -> (a,s)
runStateMonad (Pure a) s = (a,s)
runStateMonad (Free (Lan f Get)) s = runStateMonad (f s) s
runStateMonad (Free (Lan f (Put s))) _ = runStateMonad (f ()) s

runStateMonadIO :: (Show s, Show a) => StateMonad s a -> s -> IO (a,s)
runStateMonadIO (Pure a) s = putStrLn ("Returned " ++ show a ++ ", current state: " ++ show s) *> pure (a,s)
runStateMonadIO (Free (Lan f Get)) s = putStrLn ("Asked for current state: " ++ show s) *> runStateMonadIO (f s) s
runStateMonadIO (Free (Lan f (Put s))) _ = putStrLn ("Current state is set to: " ++ show s) *> runStateMonadIO (f ()) s

get :: StateMonad s s
get = liftF $ Lan id Get

put :: s -> StateMonad s ()
put s = liftF $ Lan id $ Put s

test :: StateMonad Int Int
test = do
    x <- get
    if x == 233 then put 666 else put 0
    get