Automatic generation of free monadic actions.

To generate free monadic actions from a Type, it must be a data declaration with at least one free variable. For each constructor of the type, a new function will be declared.

Consider the following generalized definitions:

 data Type a1 a2 … aN param = …
                            | FooBar t1 t2 t3 … tJ
                            | (:+) t1 t2 t3 … tJ
                            | t1 :* t2
                            | t1 `Bar` t2
                            | Baz { x :: t1, y :: t2, …, z :: tJ }
                            | …

where each of the constructor arguments t1, …, tJ is either:

1. A type, perhaps depending on some of the a1, …, aN.
2. A type dependent on param, of the form s1 -> … -> sM -> param, M ≥ 0. At most 2 of the t1, …, tJ may be of this form. And, out of these two, at most 1 of them may have M == 0; that is, be of the form param.

For each constructor, a function will be generated. First, the name of the function is derived from the name of the constructor:

• For prefix constructors, the name of the constructor with the first letter in lowercase (e.g. FooBar turns into fooBar).
• For infix constructors, the name of the constructor with the first character (a colon :), removed (e.g. :+ turns into +).

Then, the type of the function is derived from the arguments to the constructor:

 …
 fooBar :: (MonadFree Type m) => t1' -> … -> tK' -> m ret
 (+)    :: (MonadFree Type m) => t1' -> … -> tK' -> m ret
 baz    :: (MonadFree Type m) => t1' -> … -> tK' -> m ret
 …

The t1', …, tK' are those t1 … tJ that only depend on the a1, …, aN.

The type ret depends on those constructor arguments that reference the param type variable:

1. If no arguments to the constructor depend on param, ret ≡ a, where a is a fresh type variable.
2. If only one argument in the constructor depends on param, then ret ≡ (s1, …, sM). In particular, f M == 0, then ret ≡ (); if M == 1, ret ≡ s1.
3. If two arguments depend on param, (e.g. u1 -> … -> uL -> param and v1 -> … -> vM -> param, then ret ≡ Either (u1, …, uL) (v1, …, vM).

Note that Either a () and Either () a are both isomorphic to Maybe a. Because of this, when L == 0 or M == 0 in case 3., the type of ret is simplified:

• ret ≡ Either (u1, …, uL) () is rewritten to ret ≡ Maybe (u1, …, uL).
• ret ≡ Either () (v1, …, vM) is rewritten to ret ≡ Maybe (v1, …, vM).

This is literate Haskell! To run this example, open the source of this module and copy the whole comment block into a file with '.lhs' extension. For example, Teletype.lhs.

{-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-}

  --

 import Control.Monad         (mfilter)
 import Control.Monad.Loops   (unfoldM)
 import Control.Monad.Free    (liftF, Free, iterM, MonadFree)
 import Control.Monad.Free.TH (makeFree)
 import Control.Applicative   ((<$>))
 import System.IO             (isEOF)
 import Control.Exception     (catch)
 import System.IO.Error       (ioeGetErrorString)
 import System.Exit           (exitSuccess)

First, we define a data type with the primitive actions of a teleprinter. The param will stand for the next action to execute.

 type Error = String

 data Teletype param = Halt                                  -- Abort (ignore all following instructions)
                 | NL param                              -- Newline
                 | Read (Char -> param)                  -- Get a character from the terminal
                 | ReadOrEOF { onEOF  :: param,
                               onChar :: Char -> param } -- GetChar if not end of file
                 | ReadOrError (Error -> param)
                               (Char -> param)           -- GetChar with error code
                 | param :\^^ String                     -- Write a message to the terminal
                 | (:%) param String [String]            -- String interpolation
                 deriving (Functor)

By including a makeFree declaration:

 makeFree ''Teletype

the following functions have been made available:

 halt        :: (MonadFree Teletype m) => m a
 nL          :: (MonadFree Teletype m) => m ()
 read        :: (MonadFree Teletype m) => m Char
 readOrEOF   :: (MonadFree Teletype m) => m (Maybe Char)
 readOrError :: (MonadFree Teletype m) => m (Either Error Char)
 (\^^)       :: (MonadFree Teletype m) => String -> m ()
 (%)         :: (MonadFree Teletype m) => String -> [String] -> m ()

To make use of them, we need an instance of 'MonadFree Teletype'. Since Teletype is a Functor, we can use the one provided in the Free package.

 type TeletypeM = Free Teletype

Programs can be run in different ways. For example, we can use the system terminal through the IO monad.

 runTeletypeIO :: TeletypeM a -> IO a
 runTeletypeIO = iterM run where
   run :: Teletype (IO a) -> IO a
   run Halt                      = do
     putStrLn "This conversation can serve no purpose anymore. Goodbye."
     exitSuccess

   run (Read f)                  = getChar >>= f
   run (ReadOrEOF eof f)         = isEOF >>= \b -> if b then eof
                                                        else getChar >>= f

   run (ReadOrError ferror f)    = catch (getChar >>= f) (ferror . ioeGetErrorString)
   run (NL rest)                 = putChar '\n' >> rest
   run (rest :\^^ str)           = putStr str >> rest
   run ((:%) rest format tokens) = ttFormat format tokens >> rest

   ttFormat :: String -> [String] -> IO ()
   ttFormat []            _          = return ()
   ttFormat ('\\':'%':cs) tokens     = putChar '%'  >> ttFormat cs tokens
   ttFormat ('%':cs)      (t:tokens) = putStr t     >> ttFormat cs tokens
   ttFormat (c:cs)        tokens     = putChar c    >> ttFormat cs tokens

Now, we can write some helper functions:

 readLine :: TeletypeM String
 readLine = unfoldM $ mfilter (/= '\n') <$> readOrEOF

And use them to interact with the user:

 hello :: TeletypeM ()
 hello = do
           (\^^) "Hello! What's your name?"; nL
           name <- readLine
           "Nice to meet you, %." % [name]; nL
           halt

We can transform any TeletypeM into an IO action, and run it:

 main :: IO ()
 main = runTeletypeIO hello

 Hello! What's your name?
 $ Dave
 Nice to meet you, Dave.
 This conversation can serve no purpose anymore. Goodbye.

When specifying DSLs in this way, we only need to define the semantics for each of the actions; the plumbing of values is taken care of by the generated monad instance.