(Not really)Extensible effects using final encoding of handlers

final_effects.hs

module Main where

import Control.Concurrent.MVar

data Reader (m :: * -> *) (a :: *) = Reader { ask :: m a }

data State m s = State { get :: m s
                       , put :: s -> m ()
                       }

data EIO m a = EIO { liftIO :: IO a -> m a }

{- INLINE (&) -}
infixr 1 &
a & f = f a


--------------------------------

-- "Stack"
data Effects m = Effects { config :: Reader m String
                         , eio :: forall a . EIO m a
                         , state :: State m Int
                         }

-- "Handlers"
handleStateIO :: s -> IO (State IO s)
handleStateIO s = do
  state <- newMVar s
  return $ State { get = readMVar state
                 , put = \s' -> modifyMVar state (\_ -> return (s', ()))
                 }

runEffects :: Int -> String -> IO (Effects IO)
runEffects n msg = do
  state <- handleStateIO n
  return $ Effects { config = Reader (return msg)
                   , eio = EIO id
                   , state = state
                   }

--------------------------------

program e = do
  msg <- config e & ask
  eio e & liftIO $ putStrLn msg
  s <- state e & get
  if s > 1 then do
    state e & put $ s - 1
    program e
  else return ()

main :: IO ()
main = runEffects 5 "Hello World" >>= program

imagine using a Readerish thing to pass around the e in progam and using classy lenses to avoid a concrete Effects type