FreeMonad + Interpreter

DSL.hs

module DSL
  ( get
  , set
  , end
  , DSL(..)
  ) where

import Control.Monad.Free

data DSL next = Get String (String -> next)
              | Set String String next
              | End

instance Functor DSL where
  fmap f (Get name k) = Get name (f . k)
  fmap f (Set name value next) = Set name value (f next)
  fmap _ End = End

get :: String -> Free DSL String
get key = liftF (Get key id)

set :: String -> String -> Free DSL ()
set key value = liftF (Set key value ())

end :: Free DSL a
end = liftF (End)

IOInterpreter.hs

module IOInterpreter where

import Control.Monad.Free
import DSL

runIO :: Free DSL a -> IO ()
runIO (Free (Get name k)) = do
  putStrLn ("Get " ++ name)
  let result = "something"
  runIO $ k result

runIO (Free (Set key name next)) = do
  putStrLn ("Set " ++ key ++ " " ++ name)
  runIO next

runIO (Free End) = putStrLn "End"
runIO (Pure _) = return ()

Main.hs

module Main where

import Control.Monad.Free

import DSL
import IOInterpreter

fn :: Free DSL a
fn = do foo <- get "foo"
        set "foo" foo
        end

main :: IO ()
main = do
  runIO fn
  return ()