http://myuon-myon.hatenablog.com/entry/2013/01/18/012935

free_monad.hs

import Control.Monad.Free

-- data Maybe  a      = Nothing  | Just a
data    Simple a next = End next | Data a next | Skip a next
                      deriving (Show)

instance Functor (Simple a) where
  fmap f (End next) = End (f next)
  fmap f (Data a next) = Data a (f next)
  fmap f (Skip a next) = Skip a (f next)
  
putF :: Int -> Free (Simple Int) () -> IO ()
putF n (Free (Data a next)) = do 
  putStrLn ("Data:" ++ show a)
  putF (a+n) next
putF n (Free (End _)) = do
  putStrLn "End"
  putStrLn ("Result:" ++ show n)
putF n (Pure _) = putStr "Result:" >> print n
putF n (Free (Skip a next)) = do
  putStrLn ("Skip " ++ show a ++ "steps.")
  putF n $ backTo a next

dataF :: Int -> Free (Simple Int) ()
dataF a = liftF $ Data a ()

endF :: Free (Simple Int) ()
endF = liftF $ End ()

skipF :: Int -> Free (Simple Int) ()
skipF a = liftF $ Skip a ()

backTo :: Int -> Free (Simple Int) () -> Free (Simple Int) ()
backTo 0 x = x
backTo n (Free (Data _ next)) = backTo (n-1) next
backTo n (Free (End next)) = backTo (n-1) next
backTo n (Free (Skip _ next)) = backTo (n-1) next

main = putF 0 $ tinyProgram

tinyProgram :: Free (Simple Int) ()
tinyProgram = do
  dataF 2
  skipF 3
  dataF 2
  dataF 2
  dataF 2
  dataF 10