用Control.Dsl代替MonadControl.Dsl为Haskell提供了一套工具集来创建“可扩展”的领域特定语

Control.Dsl为Haskell提供了一套工具集来创建“可扩展”的领域特定语言，定制DSLdo语句块。

DSL do语句块可以包含来自不同作者提供的各种操作。每个操作可以定义为一个GADT，由Dsl类型类来解释执行，既可以有副作用，也可以是纯函数。

DSL do语句块是个抽象的“脚本”，其依赖的类型类可以自动推断。因此，只要提供不同的类型类实例，数据结构和解释器实现都可以随之改变。

本文剩下部分将会介绍如何用Control.Dsl创建一门可扩展DSL，以及可以切换的两个解释器。文中所有代码都基于control-dsl包，可以在ghci中运行。

Getting started

Dsl类型类提供了>>、 >>=、return、fail等操作，用来代替Monad中的对应操作。你可以使用RebindableSyntax扩展来启用Dsl版的定制do语句块。

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

DSL model

如果你要创建一门DSL来执行控制台的IO操作，你可以以GADT方式定义一些DSL中的基本操作：

>>> 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`语句块

以上操作可以用于do语句块：

>>> :{
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 ()
:}

以上dslBlock函数利用刚定义的操作和Control.Dsl内置操作创建了一段DSL抽象脚本。

GADT操作和结果语句（return和fail）都是特设多态的限界continuation（ad-hoc polymorphic delimited continuations），由类型类PolyCont解释执行。GHC可以把所需的PolyCont类型自动推断出来：

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

创建无副作用解释器

只要提供了适用的PolyCont 实例，r可以是任意类型。比如：以下代码定义了无副作用的解释器PureInterpreter以及对应的PolyCont实例：

>>> 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
:}

以上三个PolyCont实例简单的转发到Control.Dsl的内置操作上。

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

GetLine的PolyCont实例要稍微复杂一些，实现为一个Cont ，由若干个内置操作组合而成。

无副作用地运行DSL

>>> 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>..."]

创建有副作用的解释器

此外，只要提供了有副作用的PolyCont实例，dslBlock还能以带副作用的方式运行。

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

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

Monadic是个内置操作，可以在DSL do语句块执行monad操作，比如IO。其他操作（比如Get）可以和Monadic出现在同一个do语句块，而不需要任何monad transformer。

>>> :{
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)
:}

以副作用方式运行DSL

>>> 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

结论

本文介绍了如何用Control.Dsl创建自己的DSL。不同于Monad，用Control.Dsl创建的DSL可以扩展。只要创建GADT和对应的PolyCont，就可以为现有的解释器添加新操作。

用Control.Dsl代替Monad