Control.Dsl

This Control.Dsl module and its submodules provide a toolkit to create extensible Domain Specific Languages in do-notation.

A DSL do block contains heterogeneous statements from different vendors. A statement can be defined as a GADT, interpreted by a Dsl type class instance, either effectfully or purely.

A DSL do block is abstract. When creating the block, the type class requirements is automatically inferred. Therefore, the data structures and implementation of interpreters can be switched by providing different instances.

Getting started

This package provides Dsl type class used in do notation, as a replacement to Monad.

RebindableSyntax extension is required to enable DSL do notation.

>>> :set -XRebindableSyntax
>>> import Prelude hiding ((>>), (>>=), return, fail)
>>> import Control.Dsl

DSL model

Suppose you are creating a DSL for console IO, you need to define some keywords allowed in the DSL.

Each keyword is a GADT:

>>> data MaxLengthConfig r a where MaxLengthConfig :: MaxLengthConfig r Int
>>> data GetLine r a where GetLine :: GetLine r String
>>> data PutStrLn r a where PutStrLn :: String -> PutStrLn r ()

DSL do block

Then those keywords can be used in do blocks:

>>> :{
dslBlock = do
  maxLength <- MaxLengthConfig
  line1 <- GetLine
  line2 <- GetLine
  when (length line1 + length line2 > maxLength) $ do
    PutStrLn "The input is too long"
    fail "Illegal input"
  PutStrLn ("The input is " ++ line1 ++ " and " ++ line2)
  return ()
:}

The above dslBlock function creates an abstract code block of DSL from keywords and some built-in control flow functions.

Keywords and the result statement return and fail are ad-hoc polymorphic delimited continuations, interpreted by PolyCont, which can be automatically inferred:

>>> :type dslBlock
dslBlock
  :: (PolyCont (Return IOError) r Void, PolyCont (Return ()) r Void,
      PolyCont MaxLengthConfig r Int, PolyCont GetLine r [Char],
      PolyCont PutStrLn r ()) =>
     r

Creating a pure interpreter

The type r varies from different PolyCont instances. By defining PolyCont instances for PureInterpreter, you can make r be a pure interpreter:

>>> type PureInterpreter = Int -> [String] -> Cont [String] IOError

>>> :{
instance PolyCont MaxLengthConfig PureInterpreter Int where
  runPolyCont MaxLengthConfig = runPolyCont Get
:}

>>> :{
instance PolyCont PutStrLn PureInterpreter () where
  runPolyCont (PutStrLn s) = runPolyCont (Yield s)
:}

>>> :{
instance PolyCont (Return ()) PureInterpreter Void where
  runPolyCont (Return ()) = runPolyCont Empty
:}

The above three PolyCont instances are implemented as forwarders to other existing keywords.

>>> :{
instance PolyCont GetLine PureInterpreter String where
  runPolyCont k = runCont $ do
    x : xs <- Get @[String]
    Put xs
    return x
:}
...

The PolyCont instance for GetLine is implemented as a Cont that contains a DSL do block of atomic statements.

Running the DSL purely

>>> runPurely = dslBlock :: PureInterpreter

>>> errorHandler e = ["(handled) " ++ show e]
>>> runCont (runPurely 80 ["LINE_1", "LINE_2"]) errorHandler
["The input is LINE_1 and LINE_2"]

>>> longInput = [replicate 40 '*', replicate 41 '*']
>>> runCont (runPurely 80 longInput) errorHandler
["The input is too long","(handled) user error (Illegal input)"]

>>> runCont (runPurely 80 ["ONE_LINE"]) errorHandler
["(handled) user error (Pattern match failure in do expression at <interactive>..."]

Creating an effectful interpreter

Alternatively, dslBlock can run effectfully by providing effectful PolyCont instances.

>>> type EffectfulInterpreter = Handle -> IO ()

>>> :{
instance PolyCont GetLine EffectfulInterpreter String where
  runPolyCont GetLine = runCont $ do
    h <- Get
    line <- Monadic (hGetLine h)
    return line
:}

Monadic is a built-in keyword to perform old-fashioned monadic action in a DSL do block.

Other keywords can be used together with Monadic. No monad transformer is required.

>>> :{
instance PolyCont MaxLengthConfig (IO ()) Int where
  runPolyCont MaxLengthConfig f = f 80
:}

>>> :{
instance PolyCont PutStrLn (IO ()) () where
  runPolyCont (PutStrLn s) = (Prelude.>>=) (putStrLn s)
:}

>>> :{
instance PolyCont (Return IOError) (IO ()) Void where
  runPolyCont (Return e) _ = hPutStrLn stderr (show e)
:}

The above three PolyCont instances are not directly implemented for EffectfulInterpreter. Instead, they are implemented for IO (). Then, instances for EffectfulInterpreter can be automatically derived from instances for IO (). There are two built-in PolyCont derivation rules, for Cont and State, respectively. What interesting is that State is defined as plain function, which exactly matches the type of EffectfulInterpreter.

Running the DSL effectfully

>>> runEffectfully = dslBlock :: EffectfulInterpreter

>>> :{
withSystemTempFile "tmp-input-file" $ \_ -> \h -> do
  Monadic $ hPutStrLn h "LINE_1"
  Monadic $ hPutStrLn h "LINE_2"
  Monadic $ hSeek h AbsoluteSeek 0
  runEffectfully h
:}
The input is LINE_1 and LINE_2

Documentation

class Dsl k r a

Witnesses a use case of a statement in a do block.

Allowed statements in DSL do blocks

Statements in a DSL do block are delimited continuations (except the last statement), which can be either ad-hoc polymorphic GADT keywords, or monomorphic control flow operators.

The last statement is the final result of the do block, or the answer type of other delimited continuation statements.

	Keywords	Control flow operators	Results
Examples	Shift, Yield, Get, Put, Monadic, Return, Empty	ifThenElse, when, unless, guard	return, fail, empty, forever
Type	custom GADT	Cont	the answer type r
Interpreted by	PolyCont	N/A	PolyCont
Can be present at	not the last statement in a do block	any position in a do block	the last statement in a do block

Don't create custom instances of Dsl for statement. Instead, create PolyCont instances for your custom GADT keywords.

Examples

>>> :set -XGADTs
>>> :set -XMultiParamTypeClasses
>>> :set -XFlexibleInstances
>>> :set -XFlexibleContexts
>>> :set -XRebindableSyntax
>>> :set -XTypeApplications
>>> import qualified Prelude
>>> import Prelude hiding ((>>), (>>=), return, fail)
>>> import Control.Dsl
>>> import Control.Dsl.State.Get
>>> import Control.Dsl.Yield
>>> import Control.Dsl.Return
>>> import Data.Void

>>> :{
f = do
  Yield "foo"
  config <- Get @Bool
  when config $ do
    Yield "bar"
    return ()
  return "baz"
:}

f is a do block that contains keywords of Get, Yield, and return. With the help of built-in PolyCont instances for those keywords, f can be used as a function that accepts a boolean parameter.

>>> f False :: [String]
["foo","baz"]

>>> f True :: [String]
["foo","bar","baz"]

In fact, f can be any type as long as PolyCont instances for involved keywords are provided.

>>> :type f
f :: (PolyCont (Yield [Char]) r (),
      PolyCont (Return [Char]) r Void, PolyCont Get r Bool) =>
     r

For example, f can be interpreted as an impure IO (), providing the following instances:

>>> :{
instance PolyCont (Yield String) (IO ()) () where
  runPolyCont (Yield a) = (Prelude.>>=) (putStrLn $ "Yield " ++ a)
instance PolyCont Get (IO ()) Bool where
  runPolyCont Get f = putStrLn "Get" Prelude.>> f False
instance PolyCont (Return String) (IO ()) Void where
  runPolyCont (Return r) _ = putStrLn $ "Return " ++ r
:}

>>> f :: IO ()
Yield foo
Get
Return baz

Minimal complete definition

cpsApply

Instances

PolyCont k r a => Dsl k r a

Statements based on ad-hoc polymorphic delimited continuations.

Defined in Control.Dsl.Dsl

Methods

cpsApply :: k r a -> (a -> r) -> r

Dsl Cont r a

Statements based on monomorphic delimited continuations.

Defined in Control.Dsl.Dsl

Methods

cpsApply :: Cont r a -> (a -> r) -> r

(>>=) :: Dsl k r a => k r a -> (a -> r) -> r

The implementation of <- statements in a do block, which forwards to runCont if k is Cont, otherwise forwards to runPolyCont from PolyCont.

(=<<) :: Dsl k r a => (a -> r) -> k r a -> r

(>=>) :: Dsl k r a => (t -> k r a) -> (a -> r) -> t -> r

(<=<) :: Dsl k r a => (a -> r) -> (t -> k r a) -> t -> r

(>>) :: Dsl k r b => k r b -> r -> r

The implementation of statements with no value in a do block.

forever :: Dsl k r a => k r a -> r

ifThenElse :: Bool -> p -> p -> p

return :: PolyCont (Return r') r Void => r' -> r

Lift r to the answer type, similar to return.

This return function aims to be used as the last statement of a do block.

When return is present in a nested do block for when or unless, if the r' is not (), it will create a Cont that performs early return, skipping the rest statements of the outer do notation.

Examples

>>> :set -XTypeOperators
>>> :set -XRebindableSyntax
>>> import Prelude hiding ((>>), (>>=), return, fail)
>>> import Control.Dsl
>>> import Control.Dsl.Return
>>> import Control.Dsl.Yield
>>> import Control.Dsl.Cont
>>> import Control.Dsl.Empty

>>> :{
earlyGenerator :: Bool -> Cont [String] Integer
earlyGenerator earlyReturn = do
  Yield "inside earlyGenerator"
  when earlyReturn $ do
    Yield "early return"
    return 1
  Yield "normal return"
  return 0
:}

>>> :{
earlyGeneratorTest :: [String]
earlyGeneratorTest = do
  Yield "before earlyGenerator"
  i <- earlyGenerator True
  Yield "after earlyGenerator"
  Yield $ "the return value of earlyGenerator is " ++ show i
  empty
:}

>>> earlyGeneratorTest
["before earlyGenerator","inside earlyGenerator","early return","after earlyGenerator","the return value of earlyGenerator is 1"]

fail :: PolyCont (Return IOError) r Void => String -> r

Lift an IOError to the answer type, similar to fail.

This fail function aims to be used as the last statement of a do block.

when :: Bool -> Cont r () -> Cont r ()

unless :: Bool -> Cont r () -> Cont r ()

guard :: PolyCont Empty r Void => Bool -> Cont r ()