test.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad
import Control.Monad.Free
import Control.Monad.Free.TH

data Lang next
  = Done
  | Failure String
  | Output String next
  | Input (String -> next)
  | Prompt String (String -> next)
  | InputWithNo (Int -> String -> next)
  | Fork next (Int -> next)
  | AnyOf (Int -> Int -> Int -> next) (String -> next)
  deriving (Functor)
makeFree ''Lang

test :: Free Lang ()
test = do
  output "Hi!"
  name <- prompt "What's your name?"
  when (null name) $ failure "No name given!"
  output $ "Nice to meet you, " ++ name ++ ")!"
  done

runLang :: Free Lang () -> IO ()
runLang = iterM runF
  where
    runF Done = return ()
    runF (Failure s) = putStrLn $ "Error: " ++ s
    runF (Output s next) = putStrLn s >> next
    runF (Input next) = getLine >>= next
    runF (InputWithNo next) = getLine >>= next 23
    runF (Prompt s next) = putStrLn s >> getLine >>= next

main :: IO ()
main = runLang test

For the code from Control.Monad.Free.TH look here.