example.hs

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad.Free
import Text.ParserCombinators.Parsec

data ExampleF a
  = Foo Int a
  | Bar String (Int -> a)
  deriving Functor

type Example = Free ExampleF

foo :: Int -> Example ()
foo i = liftF $ Foo i ()

bar :: String -> Example Int
bar s = liftF $ Bar s id

fooThenBar :: Example Int
fooThenBar =
  do
    foo 10
    bar "nice"

showE :: (Show a) => Example a -> String
showE p =
  case p of
    (Free (Foo i n)) -> "foo-ing " ++ show i ++ "\n" ++ showE n
    (Free (Bar s g)) -> "bar-ing " ++ s ++ "\n" ++ showE (g 42)
    (Pure r)         -> "-- result : " ++ show r

printE = putStrLn . showE

intParser :: Parser Int
intParser = read <$> many1 digit

-- let's create the parser
fooParser :: Parser (Example ())
fooParser =
  do
    string "foo "
    i <- intParser
    return $ foo i

barParser :: Parser (Example Int)
barParser =
  do
    string "bar "
    s <- many1 $ noneOf " \n\t\r"
    return $ bar s

-- Here, I'm stuck
-- exampleParser :: Parser ??
-- exampleParser = barParser <|> fooParser

main =
  printE $ do
    foo 1
    fooThenBar
    bar "ok"