跳转到内容

另一个 Haskell 教程/单子

来自 Wikibooks,开放世界中的开放书籍
Haskell
另一个 Haskell 教程
前言
简介
入门
语言基础 (解决方案)
类型基础 (解决方案)
IO (解决方案)
模块 (解决方案)
高级语言 (解决方案)
高级类型 (解决方案)
单子 (解决方案)
高级 IO
递归
复杂度

学习 Haskell 时最难掌握的概念是理解和使用单子。我们可以在这里区分两个子部分:(1) 学习如何使用现有的单子,以及 (2) 学习如何编写新的单子。如果你想使用 Haskell,你必须学习如何使用现有的单子。另一方面,只有当你想要成为“超级 Haskell 大师”时,你才需要学习编写自己的单子。不过,如果你能掌握编写自己的单子,那么在 Haskell 中编程会更加愉快。

到目前为止,我们已经看到了单子的两种用法。第一种用法是 IO 操作:我们已经看到,通过使用单子,我们可以摆脱困扰“真实世界” IO 解决方案的问题,如在“IO”章节中所述。第二种用法是在“类-计算”部分中表示不同类型的计算。在这两种情况下,我们都需要一种方法来对操作进行排序,并发现一个足够定义(至少对于计算而言)是

class Computation c where
    success :: a -> c a
    failure :: String -> c a
    augment :: c a -> (a -> c b) -> c b
    combine :: c a -> c a -> c a

让我们看看这个定义是否能够让我们执行 IO。本质上,我们需要一种方法来表示从一个操作中取出一个值,并对其执行一些新的操作(如“函数-IO”部分中的示例,稍微改写一下)

main = do
  s <- readFile "somefile"
  putStrLn (show (f s))

但这正是 augment 的作用。使用 augment,我们可以将上面的代码写成

main =  -- note the lack of a "do"
  readFile "somefile" `augment` \s ->
  putStrLn (show (f s))

这似乎已经足够了。事实上,它比我们需要的还要多。

单子的定义是我们 Computation 类的简化版本。Monad 类有四种方法(但第四种方法可以用第三种方法来定义)

class Monad m where
    return  :: a -> m a
    fail    :: String -> m a
    (>>=)   :: m a -> (a -> m b) -> m b
    (>>)    :: m a -> m b -> m b

在这个定义中,return 等效于我们的 successfail 等效于我们的 failure>>=(读作:“绑定”)等效于我们的 augment>>(读作:“然后”)方法只是 >>= 的一个版本,它忽略了 a。这将被证明是有用的;尽管如前所述,它可以根据 >>= 来定义

a >> x = a >>= \_ -> x


Do 语法

[编辑 | 编辑源代码]

我们已经暗示单子与 do 语法之间存在联系。在这里,我们使这种关系具体化。do 语法实际上没有任何魔法之处——它只是单子操作的“语法糖”。

如前所述,使用我们的 Computation 类,我们可以将上面的程序定义为

main =
    readFile "somefile" `augment` \s ->
    putStrLn (show (f s))

但我们现在知道在单子世界中 augment 被称为 >>=。因此,此程序实际上读取的是

main =
    readFile "somefile" >>= \s ->
    putStrLn (show (f s))

在这一点上,这完全是有效的 Haskell:如果你定义了一个函数 f :: Show a => String -> a,你就可以编译并运行这个程序)

这表明我们可以将

  x <- f
  g x

转换为 f >>= \x -> g x。这正是编译器所做的。如果我们不使用隐式布局(参见有关“布局”部分的说明,了解如何执行此操作),那么谈论 do 会变得更容易。有四个转换规则

  1. do {e}e
  2. do {e; es}e >> do {es}
  3. do {let decls; es}let decls in do {es}
  4. do {p <- e; es}let ok p = do {es} ; ok _ = fail "..." in e >>= ok

同样,我们将逐一详细说明这些规则

转换规则 1

[编辑 | 编辑源代码]

第一个转换规则 do {e}e 指出(正如我们之前所说)在执行单个操作时,使用或不使用 do 是无关紧要的。这本质上是 do 的归纳定义的基例。基例有一个操作(这里就是 e);另外三个转换规则处理存在多个操作的情况。

转换规则 2

[编辑 | 编辑源代码]

这表明 do {e; es}e >> do {es}。这告诉我们在有一个操作(e)后跟一个操作列表(es)时该怎么做。在这里,我们使用的是之前定义的 >> 函数。此规则只是简单地指出要 do {e; es},我们首先执行操作 e,丢弃结果,然后 do es

例如,如果 e 是某个字符串 sputStrLn s,那么 do {e; es} 的转换就是执行 e(即打印字符串),然后 do es。这显然是我们想要的。

转换规则 3

[编辑 | 编辑源代码]

这表明 do {let decls; es}let decls in do {es}。此规则告诉我们如何处理 do 语句中的 let。我们将 let 中的声明提升出来,并 do 声明之后的任何内容。

转换规则 4

[编辑 | 编辑源代码]

这说明 do {p <- e; es}let ok p = do {es} ; ok _ = fail "..." in e >>= ok。同样地,这段代码的作用并不十分明了。然而,该规则的另一种等价形式是:do {p <- e; es}e >>= \p -> es。在这里,我们可以清楚地看到发生了什么。我们执行操作 e,并将结果传递给 es,但首先将结果命名为 p

复杂定义的原因在于,p 不仅仅是一个变量,它可以是一个复杂的模式。例如,以下代码是有效的

foo = do ('a':'b':'c':x:xs) <- getLine
      putStrLn (x:xs)

在这里,我们假设操作 getLine 的结果将以字符串 "abc" 开头,并且至少包含一个额外的字符。问题在于,如果模式匹配失败,应该发生什么。编译器可以像往常一样简单地抛出一个错误,用于失败的模式匹配。但是,由于我们是在一个单子中,我们可以访问一个特殊的 fail 函数,我们更倾向于使用该函数而不是 "catch all" 的 error 函数来失败。因此,根据定义,翻译允许编译器使用适当的错误消息填充 ...,以说明模式匹配失败。除此之外,这两个定义是等效的。



所有单子都必须遵守三个规则,称为 "单子定律" (保证你的单子遵守这些规则是你的责任)。

  1. return a >>= ff a
  2. f >>= returnf
  3. f >>= (\x -> g x >>= h)(f >>= g) >>= h

让我们逐个看一下这些定律。

这说明 return a >>= ff a。假设我们将单子视为计算。这意味着,如果我们创建一个简单的计算,它仅仅返回值 a,而不考虑其他任何事情 (这就是 return a 部分);然后将它与其他计算 f 绑定在一起,那么这等效于直接对 a 执行计算 f

例如,假设 f 是函数 putStrLna 是字符串 "Hello World"。该规则指出,将结果为 "Hello World" 的计算绑定到 putStrLn 与直接将它打印到屏幕上相同。这似乎很有道理。

do 符号中,该定律指出以下两个程序是等效的

law1a = do
  x <- return a
  f x

law1b = do
  f a

第二个单子定律指出,对于某个计算 ff >>= returnf。换句话说,该定律指出,如果我们执行计算 f,然后将结果传递给简单的 return 函数,那么我们所做的只是执行了该计算。

该定律必须成立应该很明显。要了解这一点,可以将 f 视为 getLine (从键盘读取字符串)。该定律指出,读取字符串然后返回读取的值与仅仅读取字符串是完全一样的。

do 符号中,该定律指出以下两个程序是等效的

law2a = do
  x <- f
  return x

law2b = do
  f

这说明 f >>= (\x -> g x >>= h)(f >>= g) >>= h。乍一看,该定律并不像其他两个定律那样容易理解。它本质上是单子的结合律。

注意

在单子世界之外,一个函数 是结合的,如果 。例如,+* 是结合的,因为对这些函数进行括号操作不会产生影响。另一方面,-/ 不是结合的,例如,

如果我们忽略掉 lambda 的复杂性,我们会发现该定律指出:f >>= (g >>= h)(f >>= g) >>= h。该定律背后的直觉是,当我们将操作串联在一起时,操作的组合方式无关紧要。

举个具体的例子,令 fgetLine。令 g 为一个操作,它接收一个值作为输入,将它打印到屏幕上,通过 getLine 读取另一个字符串,然后返回新读取的字符串。令 hputStrLn

让我们考虑 (\x -> g x >>= h) 的作用。它接收一个名为 x 的值,并对其运行 g,将结果传递给 h。在本例中,这意味着它将接收一个值,打印它,读取另一个值,然后打印该值。因此,整个定律的左侧首先读取一个字符串,然后执行我们刚刚描述的操作。

另一方面,考虑 (f >>= g)。该操作从键盘读取一个字符串,打印它,然后读取另一个字符串,将新读取的字符串作为结果返回。当我们将它与定律右侧的 h 绑定时,我们将得到一个操作,它执行 (f >>= g) 所描述的操作,然后打印结果。

显然,这两个操作是相同的。

虽然这个解释非常复杂,定律的文本也相当复杂,但它真正的含义很简单:如果我们有三个操作,并且以相同的顺序组合它们,那么我们将括号放在哪里并不重要。其他部分仅仅是符号。

do 符号中,该定律指出以下两个程序是等效的

law3a = do
  x <- f
  do y <- g x
     h y

law3b = do
  y <- do x <- f
          g x
  h y


一个简单的状态单子

[编辑 | 编辑源代码]

我们可以创建的最简单的单子之一是状态传递单子。在 Haskell 中,所有状态信息通常必须作为参数显式传递给函数。使用单子,我们可以有效地隐藏一些状态信息。

假设我们有一个类型为 a -> b 的函数 f,并且需要为该函数添加状态。通常,如果状态的类型为 state,我们可以通过将 f 的类型更改为 a -> state -> (state, b) 来对其进行编码。也就是说,新版本的 f 接收原始类型的参数 a 和一个新的状态参数。此外,除了返回类型为 b 的值之外,它还返回一个更新后的状态,以元组的形式进行编码。

例如,假设我们有一个二叉树,定义如下

data Tree a
  = Leaf a
  | Branch (Tree a) (Tree a)

现在,我们可以编写一个简单的 map 函数,将某个函数应用于所有叶节点的值

mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f (Leaf a) = Leaf (f a)
mapTree f (Branch lhs rhs) =
    Branch (mapTree f lhs) (mapTree f rhs)

这很好用,直到我们需要编写一个对叶节点从左到右进行编号的函数。从某种意义上说,我们需要将状态添加到 mapTree 函数中,该状态跟踪到目前为止我们已经编号了多少个叶节点。我们可以将该函数扩展为类似以下内容

mapTreeState :: (a -> state -> (state, b)) ->
                Tree a -> state -> (state, Tree b)
mapTreeState f (Leaf a) state =
    let (state', b) = f a state
    in  (state', Leaf b)
mapTreeState f (Branch lhs rhs) state =
    let (state' , lhs') = mapTreeState f lhs state
        (state'', rhs') = mapTreeState f rhs state'
    in  (state'', Branch lhs' rhs')

这开始变得有点笨拙,类型签名也越来越难以理解。我们想要做的是抽象化掉状态传递部分。也就是说,mapTreemapTreeState 之间的区别在于:(1) 扩展后的 f 类型,(2) 我们用 -> state -> (state, Tree b) 替换了类型 -> Tree b。注意,这两种类型都以完全相同的方式发生了变化。我们可以使用类型同义词声明来抽象化掉这些变化

type State st a = st -> (st, a)

为了配合该类型,我们编写了两个函数

returnState :: a -> State st a
returnState a = \st -> (st, a)

bindState :: State st a -> (a -> State st b) ->
             State st b
bindState m k = \st ->
    let (st', a) = m st
        m'       = k a
    in  m' st'

让我们依次检查一下这些函数。第一个函数 returnState 接收类型为 a 的值,并创建一个类型为 State st a 的值。如果我们将 st 视为状态,并将类型为 a 的值视为值,那么这是一个不改变状态并返回值 a 的函数。

bindState 函数看起来非常类似于 mapTreeState 中的内部 let 声明。它接收两个参数。第一个参数是一个操作,它返回类型为 a 的值,并带有状态 st。第二个参数是一个函数,它接收该 a 并生成类型为 b 的值,并带有相同的状态。bindState 的结果本质上是将 a 转换为 b 的结果。

bindState 的定义接受一个初始状态 st。它首先将此状态应用于名为 mState st a 参数。这将返回一个新的状态 st' 和一个值 a。然后,它让函数 k 作用于 a,生成一个类型为 State st b 的值,称为 m'。最后,我们用新的状态 st' 运行 m'

我们写一个新函数 mapTreeStateM 并赋予它类型

mapTreeStateM :: (a -> State st b) -> Tree a -> State st (Tree b)

使用这些“管道”函数(returnStatebindState),我们可以编写这个函数,而无需显式地提及状态。

mapTreeStateM f (Leaf a) =
  f a `bindState` \b ->
  returnState (Leaf b)
mapTreeStateM f (Branch lhs rhs) =
  mapTreeStateM f lhs `bindState` \lhs' ->
  mapTreeStateM f rhs `bindState` \rhs' ->
  returnState (Branch lhs' rhs')

Leaf 的情况下,我们将 f 应用于 a,然后将结果与一个函数绑定,该函数接受结果并返回一个具有新值的 Leaf

Branch 的情况下,我们在左侧递归,将结果与一个函数绑定,该函数在右侧递归,将结果与一个简单的函数绑定,该函数返回新创建的 Branch

正如你可能已经猜到,State st 是一个单子,returnState 类比于重载的 return 方法,而 bindState 类比于重载的 >>= 方法。事实上,我们可以验证 State st a 遵守单子定律。

定律 1 规定:return a >>= ff a。让我们在等式左侧进行计算,代入我们的名字

     returnState a `bindState` f
==>
     \st -> let (st', a) = (returnState a) st
                m'       = f a
            in  m' st'
==>
     \st -> let (st', a) = (\st -> (st, a)) st
            in  (f a) st'
==>
     \st -> let (st', a) = (st, a)
            in  (f a) st'
==>
     \st -> (f a) st
==>
     f a

在第一步中,我们只是代入 bindState 的定义。在第二步中,我们简化最后两行并代入 returnState 的定义。在第三步中,我们将 st 应用于 lambda 函数。在第四步中,我们将 st' 重命名为 st 并删除 let。在最后一步中,我们进行 eta 简化。

继续 定律 2,我们需要证明 f >>= returnf。这可以通过以下方式证明

     f `bindState` returnState
==>
     \st -> let (st', a) = f st
            in  (returnState a) st'
==>
     \st -> let (st', a) = f st
            in  (\st -> (st, a)) st'
==>
     \st -> let (st', a) = f st
            in  (st', a)
==>
     \st -> f st
==>
     f

最后,我们需要证明 State 遵守第三定律:f >>= (\x -> g x >>= h)(f >>= g) >>= h。这证明起来比较复杂,因此我们只在这里概述证明过程。请注意,我们可以将等式左侧写成

     \st -> let (st', a) = f st
            in  (\x -> g x `bindState` h) a st'
==>
     \st -> let (st', a) = f st
            in  (g a `bindState` h) st'
==>
     \st -> let (st', a) = f st
            in  (\st' -> let (st'', b) = g a
                         in  h b st'') st'
==>
     \st -> let (st' , a) = f st
                (st'', b) = g a st'
                (st''',c) = h b st''
            in  (st''',c)

这里有趣的地方在于,我们在相同的 let 层次上都有动作应用。由于 let 是结合性的,这意味着我们可以按任何我们喜欢的括号方式进行分组,结果不会改变。当然,这是一个非正式的,“手势”论证,需要我们进行几个额外的推导才能真正证明,但这提供了总体思路。

现在我们知道 State st 实际上是一个单子,我们希望将其设为 Monad 类的实例。不幸的是,直接这样做不可行。我们不能写

instance Monad (State st) where { ... }

这是因为你不能从未完全应用的类型别名创建实例。相反,我们需要做的将类型别名转换为 newtype,如下所示

newtype State st a = State (st -> (st, a))

不幸的是,这意味着我们需要在 Monad 实例声明中对 State 构造函数进行一些打包和解包,但这并不难。

instance Monad (State state) where
    return a = State (\state -> (state, a))
    State run >>= action = State run'
        where run' st =
                  let (st', a)    = run st
                      State run'' = action a
                  in  run'' st'

现在,我们可以将我们的 mapTreeM 函数写成

mapTreeM :: (a -> State state b) -> Tree a ->
            State state (Tree b)
mapTreeM f (Leaf a) = do
  b <- f a
  return (Leaf b)
mapTreeM f (Branch lhs rhs) = do
  lhs' <- mapTreeM f lhs
  rhs' <- mapTreeM f rhs
  return (Branch lhs' rhs')

这比以前干净得多。事实上,如果我们删除类型签名,我们会得到更通用的类型

mapTreeM :: Monad m => (a -> m b) -> Tree a ->
            m (Tree b)

也就是说,mapTreeM 可以运行在任何单子中,而不仅仅是我们自己的 State 单子。

现在,将计算的有状态方面封装起来的好处在于,我们可以提供函数来获取和更改当前状态。这些函数看起来像

getState :: State state state
getState = State (\state -> (state, state))

putState :: state -> State state ()
putState new = State (\_ -> (new, ()))

这里,getState 是一个单子操作,它获取当前状态,将其不变地传递,然后将其作为值返回。putState 函数接受一个新状态,并生成一个动作,该动作忽略当前状态并插入新状态。

现在,我们可以将我们的 numberTree 函数写成

numberTree :: Tree a -> State Int (Tree (a, Int))
numberTree tree = mapTreeM number tree
    where number v = do
            cur <- getState
            putState (cur+1)
            return (v,cur)

最后,我们需要能够通过提供初始状态来运行该动作

runStateM :: State state a -> state -> a
runStateM (State f) st = snd (f st)

现在,我们可以提供一个示例 Tree

testTree =
  Branch
    (Branch
      (Leaf 'a')
      (Branch
        (Leaf 'b')
        (Leaf 'c')))
    (Branch
      (Leaf 'd')
      (Leaf 'e'))

并对其进行编号

示例

State> runStateM (numberTree testTree) 1
Branch (Branch (Leaf ('a',1)) (Branch (Leaf ('b',2))
       (Leaf ('c',3)))) (Branch (Leaf ('d',4))
       (Leaf ('e',5)))

这看起来像是为了做一些简单的事情而做了很多工作。但是,请注意 mapTreeM 的新功能。我们还可以以从左到右的方式打印出树的叶子,如下所示

示例

State> mapTreeM print testTree
'a'
'b'
'c'
'd'
'e'

这至关重要地依赖于这样一个事实,即 mapTreeM 具有更通用的类型,涉及任意单子,而不仅仅是状态单子。此外,我们可以编写一个动作,该动作将每个叶子的值设置为其旧值以及所有前面的值

fluffLeaves tree = mapTreeM fluff tree
    where fluff v = do
            cur <- getState
            putState (v:cur)
            return (v:cur)

并且可以观察其运行情况

示例

State> runStateM (fluffLeaves testTree) []
Branch (Branch (Leaf "a") (Branch (Leaf "ba")
       (Leaf "cba"))) (Branch (Leaf "dcba")
       (Leaf "edcba"))

事实上,你甚至不需要编写自己的单子实例和数据类型。所有这些都内置在 Control.Monad.State 模块中。在那里,我们的 runStateM 被称为 evalState;我们的 getState 被称为 get;我们的 putState 被称为 put

该模块还包含一个状态转换器单子,我们将在关于 Transformer 的部分中讨论它。



常见单子

[edit | edit source]

事实证明,我们许多最喜欢的类型本身就是单子。例如,考虑列表。它们有一个单子的定义,看起来像这样

instance Monad [] where
    return x = [x]
    l >>= f  = concatMap f l
    fail _   = []

这使我们能够在 do 语法中使用列表。例如,给定以下定义

cross l1 l2 = do
  x <- l1
  y <- l2
  return (x,y)

我们得到一个叉积函数

示例

Monads> cross "ab" "def"
[('a','d'),('a','e'),('a','f'),('b','d'),('b','e'),
 ('b','f')]

这与列表推导形式非常相似,这绝非偶然

示例

Prelude> [(x,y) | x <- "ab", y <- "def"]
[('a','d'),('a','e'),('a','f'),('b','d'),('b','e'),
 ('b','f')]

列表推导形式只是使用列表的单子语句的缩写形式。事实上,在早期的 Haskell 版本中,列表推导形式可以用于任何单子,而不仅仅是列表。然而,在当前版本的 Haskell 中,这不再允许。

Maybe 类型也是一个单子,其中失败表示为 Nothing,成功表示为 Just。我们得到以下实例声明

instance Monad Maybe where
    return a      = Just a
    Nothing >>= f = Nothing
    Just x  >>= f = f x
    fail _        = Nothing

我们可以在 Maybe 上使用与列表相同的叉积函数。这是因为 do 语法适用于任何单子,并且 cross 函数中没有特定于列表的部分。

示例

Monads> cross (Just 'a') (Just 'b')
Just ('a','b')
Monads> cross (Nothing :: Maybe Char) (Just 'b')
Nothing
Monads> cross (Just 'a') (Nothing :: Maybe Char)
Nothing
Monads> cross (Nothing :: Maybe Char)
                   (Nothing :: Maybe Char)
Nothing

这意味着如果我们写一个函数(比如来自关于 Classes 的部分的 searchAll),它只用单子操作符来写,那么我们就可以根据我们的意思,在任何单子中使用它。使用真正的单子函数(不是 do 语法),searchAll 函数看起来像这样

searchAll g@(Graph vl el) src dst
    | src == dst = return [src]
    | otherwise  = search' el
    where search' [] = fail "no path"
          search' ((u,v,_):es)
              | src == u  =
                   searchAll g v dst >>= \path ->
                   return (u:path)
              | otherwise = search' es

该函数的类型为 Monad m => Graph v e -> Int -> Int -> m [Int]。这意味着无论我们当前使用什么单子,该函数都将执行计算。假设我们有以下图表

gr = Graph [(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd')]
           [(0,1,'l'), (0,2,'m'), (1,3,'n'), (2,3,'m')]

这表示一个具有四个节点的图,分别标记为 a,b,cd。从 abc 都有边。从 bcd 也都有边。使用 Maybe 单子,我们可以计算从 ad 的路径

示例

Monads> searchAll gr 0 3 :: Maybe [Int]
Just [0,1,3]

我们提供类型签名,以便解释器知道我们使用的是什么单子。如果我们尝试在相反方向搜索,则没有路径。无法找到路径在 Maybe 单子中表示为 Nothing

示例

Monads> searchAll gr 3 0 :: Maybe [Int]
Nothing

请注意,字符串“no path”已经消失,因为 Maybe 单子没有办法记录它。

如果我们在列表单子中执行相同的不可能的搜索,我们会得到空列表,表示没有路径

示例

Monads> searchAll gr 3 0 :: [[Int]]
[]

如果我们执行可能的搜索,我们会得到一个包含第一条路径的列表

示例

Monads> searchAll gr 0 3 :: [[Int]]
[[0,1,3]]

你可能期望此函数调用返回所有路径,但正如代码所示,它没有。请参阅关于 Plus 的部分,了解有关使用列表来表示非确定性的更多信息。

如果我们使用 IO 单子,我们实际上可以获取错误消息,因为 IO 知道如何跟踪错误消息

示例

Monads> searchAll gr 0 3 :: IO [Int]
Monads> it
[0,1,3]
Monads> searchAll gr 3 0 :: IO [Int]
*** Exception: user error
Reason: no path

在第一种情况下,我们需要键入 it 才能让 GHCi 实际评估搜索。

searchAll 实现有一个问题:如果它找到一条不导致解决方案的边,它将无法回溯。这与 search' 内部对 searchAll 的递归调用有关。例如,考虑如果 searchAll g v dst 没有找到路径会发生什么。此实现没有办法恢复。例如,如果我们删除从节点 b 到节点 d 的边,我们仍然应该能够找到从 ad 的路径,但是此算法找不到它。我们定义

gr2 = Graph [(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd')]
            [(0,1,'l'), (0,2,'m'), (2,3,'m')]

然后尝试搜索

示例

Monads> searchAll gr2 0 3
*** Exception: user error
Reason: no path

为了解决这个问题,我们需要一个类似于 Computation 类中的 combine 的函数。我们将在关于 Plus 的部分中看到如何做到这一点。

练习
验证 Maybe 是否遵守三个单子定律。
练习

类型 Either String 是一个可以跟踪错误的单子。为它编写一个实例,然后尝试使用此单子执行本章的搜索。

提示:你的实例声明应该以 instance Monad (Either String) where 开头。


单子组合器

[edit | edit source]

Monad/Control.Monad 库包含一些非常有用的单子组合器,这些组合器还没有得到充分的讨论。我们将在本节中讨论的组合器及其类型如下所示

  • (=<<)  :: (a -> m b) -> m a -> m b
  • mapM  :: (a -> m b) -> [a] -> m [b]
  • mapM_  :: (a -> m b) -> [a] -> m ()
  • filterM  :: (a -> m Bool) -> [a] -> m [a]
  • foldM  :: (a -> b -> m a) -> a -> [b] -> m a
  • sequence  :: [m a] -> m [a]
  • sequence_ :: [m a] -> m ()
  • liftM  :: (a -> b) -> m a -> m b
  • when  :: Bool -> m () -> m ()
  • join  :: m (m a) -> m a

在上述中,始终假设 mMonad 的一个实例。

一般而言,以下划线结尾的函数等效于没有下划线的函数,只是它们不返回值。

=<< 函数与 >>= 完全相同,只是它的参数顺序相反。例如,在 IO 单子中,我们可以编写以下两种方式中的任何一种

示例

Monads> writeFile "foo" "hello world!" >>
             (readFile "foo" >>= putStrLn)
hello world!
Monads> writeFile "foo" "hello world!" >>
             (putStrLn =<< readFile "foo")
hello world!

mapMfilterMfoldM 是我们以前用过的 mapfilterfoldl,包装在单子中。这些函数在使用单子时非常有用(尤其是 foldM)。例如,我们可以使用 mapM_ 将一个列表中的内容打印到屏幕上

示例

Monads> mapM_ print [1,2,3,4,5]
1
2
3
4
5

我们可以使用foldM对列表求和,并在每一步打印中间和

示例

Monads> foldM (\a b ->
               putStrLn (show a ++ "+" ++ show b ++
                         "=" ++ show (a+b)) >>
               return (a+b)) 0 [1..5]
0+1=1
1+2=3
3+3=6
6+4=10
10+5=15
Monads> it
15

sequencesequence_函数只是“执行”一系列操作。例如

示例

Monads> sequence [print 1, print 2, print 'a']
1
2
'a'
Monads> it
[(),(),()]
Monads> sequence_ [print 1, print 2, print 'a']
1
2
'a'
Monads> it
()

我们可以看到带下划线的版本没有返回每个值,而没有下划线的版本返回返回值的列表。

liftM函数将非单子函数“提升”到单子函数。(不要将它与用于单子转换器(在关于转换器的部分)的lift函数混淆。)这对于缩短代码(以及其他事情)很有用。例如,我们可能想编写一个函数,用它的行号在文件的每一行前面加上一个前缀。我们可以用以下方法做到这一点

numberFile :: FilePath -> IO ()
numberFile fp = do
  text <- readFile fp
  let l = lines text
  let n = zipWith (\n t -> show n ++ ' ' : t) [1..] l
  mapM_ putStrLn n

但是,我们可以使用liftM缩短它

numberFile :: FilePath -> IO ()
numberFile fp = do
  l <- lines `liftM` readFile fp
  let n = zipWith (\n t -> show n ++ ' ' : t) [1..] l
  mapM_ putStrLn n

事实上,您可以使用liftM对文件应用任何类型的(纯)处理。例如,也许我们还想将行分成单词;我们可以用以下方法做到这一点

  ...
  w <- (map words . lines) `liftM` readFile fp
  ...

注意,括号是必需的,因为(.)函数的固定性与`liftM`相同。

将纯函数提升到单子中在其他单子中也很有用。例如,liftM可以用来在Just中应用函数。例如

Monads> liftM (+1) (Just 5)
Just 6
Monads> liftM (+1) Nothing
Nothing

when函数仅在满足条件时执行单子操作。所以,如果我们只想打印非空行

示例

Monads> mapM_ (\l -> when (not $ null l) (putStrLn l))
                   ["","abc","def","","","ghi"]
abc
def
ghi

当然,也可以用filter来实现,但有时when更方便。

最后,join函数是单子等效于列表上的concat。实际上,当m是列表单子时,join正好是concat。在其他单子中,它执行类似的任务

示例

Monads> join (Just (Just 'a'))
Just 'a'
Monads> join (Just (Nothing :: Maybe Char))
Nothing
Monads> join (Nothing :: Maybe (Maybe Char))
Nothing
Monads> join (return (putStrLn "hello"))
hello
Monads> return (putStrLn "hello")
Monads> join [[1,2,3],[4,5]]
[1,2,3,4,5]

当我们进入本章Io 高级中的更高级主题时,这些函数将变得更加有用。



MonadPlus

[编辑 | 编辑源代码]

仅给出>>=return函数,不可能写出像combine这样的函数,它的类型为c a -> c a -> c a。但是,这样的函数非常有用,以至于它存在于另一个名为MonadPlus的类中。除了具有combine函数之外,MonadPlus的实例还具有一个“零”元素,它是“加”操作(即组合)下的单位元。定义是

class Monad m => MonadPlus m where
  mzero :: m a
  mplus :: m a -> m a -> m a

为了获得对MonadPlus的访问权限,您需要导入Monad模块(或分层库中的Control.Monad)。

在关于通用的部分中,我们展示了Maybe和列表都是单子。事实上,它们也都是MonadPlus的实例。在Maybe的情况下,零元素是Nothing;在列表的情况下,它是空列表。Maybe上的mplus操作是Nothing,如果两个元素都是Nothing;否则,它是第一个Just值。对于列表,mplus++相同。

也就是说,实例声明看起来像

instance MonadPlus Maybe where
  mzero = Nothing
  mplus Nothing y = y
  mplus x       _ = x

instance MonadPlus [] where
  mzero = []
  mplus x y = x ++ y

我们可以使用这个类来重新实现我们一直在探索的搜索函数,以便它能够探索所有可能的路径。新函数看起来像

searchAll2 g@(Graph vl el) src dst
    | src == dst = return [src]
    | otherwise  = search' el
    where search' [] = fail "no path"
          search' ((u,v,_):es)
              | src == u  =
                 (searchAll2 g v dst >>= \path ->
                  return (u:path)) `mplus`
                 search' es
              | otherwise = search' es

现在,当我们遍历search'中的边列表时,如果我们遇到匹配的边,我们不仅探索这条路径,而且还会在对search'的递归调用中继续探索当前节点的出边。

IO 单子不是MonadPlus的实例;我们无法用这个单子执行搜索。我们可以看到,当使用列表作为单子时,我们(a)在gr中获得所有可能的路径,以及(b)在gr2中获得一条路径。

示例

MPlus> searchAll2 gr 0 3 :: [[Int]]
[[0,1,3],[0,2,3]]
MPlus> searchAll2 gr2 0 3 :: [[Int]]
[[0,2,3]]

您可能想将其实现为

searchAll2 g@(Graph vl el) src dst
    | src == dst = return [src]
    | otherwise  = search' el
    where search' [] = fail "no path"
          search' ((u,v,_):es)
              | src == u  = do
                 path <- searchAll2 g v dst
                 rest <- search' es
                 return ((u:path) `mplus` rest)
              | otherwise = search' es

但请注意,这不是我们想要的。这里,如果对searchAll2的递归调用失败,我们不会尝试继续执行search' es。对mplus的调用必须位于顶层才能正常工作。

练习

假设我们改变了mplus的参数顺序。也就是说,search'的匹配情况看起来像

                 search' es `mplus`
                 (searchAll2 g v dst >>= \path ->
                  return (u:path))

当在gr上使用列表

单子时,您期望这会如何改变结果?为什么?



单子转换器

[编辑 | 编辑源代码]

通常我们想将单子“叠加”在一起。例如,可能有一种情况,您需要通过 IO 单子访问 IO 操作,并通过某个状态单子访问状态函数。为了实现这一点,我们引入了MonadTrans类,它本质上将一个单子的操作“提升”到另一个单子中。您可以将其视为将单子堆叠在一起。这个类有一个简单的方法:liftMonadTrans的类声明是

class MonadTrans t where
  lift :: Monad m => m a -> t m a

这里的想法是t是外部单子,m存在于其中。为了执行类型为Monad m => m a的命令,我们首先将其提升到转换器中。

转换器最简单的示例(可能也是最有用)是状态转换器单子,它是一个状态单子,包装在任意单子周围。之前,我们定义状态单子为

newtype State state a = State (state -> (state, a))

现在,我们不再使用类型为state -> (state, a)的函数作为单子,而是假设存在另一个单子m,并将内部操作转换为类型为state -> m (state, a)的东西。这产生了状态转换器的以下定义

newtype StateT state m a =
        StateT (state -> m (state, a))

例如,我们可以将m视为 IO。在这种情况下,我们的状态转换器单子能够在 IO 单子中执行操作。首先,我们将其设为MonadTrans的实例

instance MonadTrans (StateT state) where
    lift m = StateT (\s -> do a <- m
                              return (s,a))

这里,将函数从m域提升到StateT state域,只需保持状态(s值)不变并执行操作即可。

当然,我们还需要使StateT本身成为一个单子。这很简单,前提是m已经是单子

instance Monad m => Monad (StateT state m) where
  return a = StateT (\s -> return (s,a))
  StateT m >>= k = StateT (\s -> do
    (s', a) <- m s
    let StateT m' = k a
    m' s')
  fail s = StateT (\_ -> fail s)

return定义背后的想法是我们保持状态不变,并简单地在封闭的单子中返回状态/a 对。请注意,returnreturn的定义中的使用是指封闭的单子,而不是状态转换器。

在绑定定义中,我们创建了一个新的StateT,它以状态s作为参数。首先,它将此状态应用于第一个操作(StateT m)并获得新的状态和答案作为结果。然后,它在此新状态上运行k操作,并获得一个新的转换器。最后,它将新状态应用于此转换器。这个定义几乎与我们在关于状态的部分中描述的标准(非转换器)State单子的绑定定义相同。

fail函数将对封闭单子中的fail的调用传递过去,因为状态转换器本身不知道如何处理失败。

当然,为了实际使用这个单子,我们需要提供函数getTputTevalStateT。它们类似于我们在关于状态的部分中描述的getStateputStaterunStateM

getT :: Monad m => StateT s m s
getT = StateT (\s -> return (s, s))

putT :: Monad m => s -> StateT s m ()
putT s = StateT (\_ -> return (s, ()))

evalStateT :: Monad m => StateT s m a -> s -> m a
evalStateT (StateT m) state = do
  (s', a) <- m state
  return a

这些函数应该很直观。但是请注意,evalStateT的结果实际上是封闭单子中的单子操作。这是单子转换器的典型特征:它们不知道如何在封闭的单子中实际运行事物(它们只知道如何提升操作)。因此,您得到的将是内部单子中的单子操作(在我们的例子中是 IO),然后您需要自己运行它。

我们可以使用状态转换器来重新实现我们在关于状态的部分中描述的mapTreeM函数的版本。这里唯一的变化是,当我们到达叶子时,我们打印出叶子的值;当我们到达分支时,我们只打印出“分支”。

mapTreeM action (Leaf a) = do
  lift (putStrLn ("Leaf " ++ show a))
  b <- action a
  return (Leaf b)
mapTreeM action (Branch lhs rhs) = do
  lift (putStrLn "Branch")
  lhs' <- mapTreeM action lhs
  rhs' <- mapTreeM action rhs
  return (Branch lhs' rhs')

这个函数与我们在关于状态的部分中描述的函数唯一的区别是lift (putStrLn ...)作为第一行。lift告诉我们,我们将要在一个封闭的单子中执行命令。在本例中,封闭的单子是IO,因为提升的命令是putStrLn

这个函数的类型比较复杂

mapTreeM :: (MonadTrans t, Monad (t IO), Show a) =>
            (a -> t IO a1) -> Tree a -> t IO (Tree a1)

先忽略类约束,它表示mapTreeM接受一个操作和一棵树,并返回一棵树。这与之前一样。在这个过程中,我们要求t是一个单子转换器(因为我们对它应用了lift);我们要求t IO是一个单子,因为我们使用putStrLn,我们知道封闭的单子是IO;最后,我们要求ashow的实例——这仅仅是因为我们使用show来显示叶子的值。

现在,我们只需将numberTree更改为使用此版本的mapTreeM以及getput的新版本,最终得到

numberTree tree = mapTreeM number tree
    where number v = do
            cur <- getT
            putT (cur+1)
            return (v,cur)

使用它,我们可以运行我们的单子

示例

MTrans> evalStateT (numberTree testTree) 0
Branch
Branch
Leaf 'a'
Branch
Leaf 'b'
Leaf 'c'
Branch
Leaf 'd'
Leaf 'e'
*MTrans> it
Branch (Branch (Leaf ('a',0))
       (Branch (Leaf ('b',1)) (Leaf ('c',2))))
       (Branch (Leaf ('d',3)) (Leaf ('e',4)))

我们在MonadPlus的讨论中没有提到一个问题,即我们的搜索算法将无法在包含循环的图中终止。考虑

gr3 = Graph [(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd')]
            [(0,1,'l'), (1,0,'m'), (0,2,'n'),
             (1,3,'o'), (2,3,'p')]

在这个图中,从节点b到节点a有一条回边。如果我们尝试运行searchAll2,无论我们使用哪个单子,它都将无法终止。此外,如果我们将此错误边移到列表的末尾(并将其称为gr4),那么searchAll2 gr4 0 3的结果将包含无限条路径:我们可能只想要不包含循环的路径。

为了解决这个问题,我们需要引入状态。也就是说,我们需要跟踪我们访问过的节点,这样我们就不再访问它们。

我们可以用以下方法做到这一点

searchAll5 g@(Graph vl el) src dst
  | src == dst = do
      visited <- getT
      putT (src:visited)
      return [src]
  | otherwise  = do
      visited <- getT
      putT (src:visited)
      if src `elem` visited
        then mzero
        else search' el
  where
    search' [] = mzero
    search' ((u,v,_):es)
        | src == u  =
          (do path <- searchAll5 g v dst
              return (u:path)) `mplus`
          search' es
        | otherwise = search' es

这里,我们隐式地使用状态转换器(参见对getTputT的调用)来跟踪访问过的状态。只有在我们遇到尚未访问过的状态时,我们才会继续递归。此外,当我们递归时,我们将当前状态添加到我们的已访问状态集中。

现在,我们可以运行状态转换器,即使在循环图上,也能得到正确的路径

示例

MTrans> evalStateT (searchAll5 gr3 0 3) [] :: [[Int]]
[[0,1,3],[0,2,3]]
MTrans> evalStateT (searchAll5 gr4 0 3) [] :: [[Int]]
[[0,1,3],[0,2,3]]

这里,作为evalStateT参数提供的空列表是初始状态(即,初始已访问列表)。在我们的例子中,它是空的。

我们还可以提供一个execStateT方法,该方法不返回结果,而是返回最终状态。这个函数看起来像

execStateT :: Monad m => StateT s m a -> s -> m s
execStateT (StateT m) state = do
  (s', a) <- m state
  return s'

这在我们这里不太有用,因为它将返回与evalStateT完全相反的结果(尝试一下,您就会发现!),但在一般情况下可能有用(例如,如果我们需要知道numberTree中使用了多少个数字)。

练习

编写一个基于searchAll2代码的函数searchAll6,在每次进入主函数(而不是对边列表的递归)时,打印正在进行的搜索。例如,为searchAll6 gr 0 3生成的输出应该看起来像

示例

Exploring 0 -> 3
Exploring 1 -> 3
Exploring 3 -> 3
Exploring 2 -> 3
Exploring 3 -> 3
MTrans> it
[[0,1,3],[0,2,3]]

为了做到这一点,您必须定义自己的列表单子

转换器,并为其创建适当的实例。
练习

将本节中的 searchAll5 函数与上一练习中的 searchAll6 函数合并成一个名为 searchAll7 的函数。此函数应执行 searchAll6 中的 IO 操作,但还应使用状态转换器来跟踪状态。

转换器。


解析 Monad

[编辑 | 编辑源代码]

事实证明,某些类型的解析器都是 Monad。这使得在 Haskell 中构建解析库变得非常简洁。在本章中,我们首先在关于 简单解析 Monad 的部分构建自己的(小型)解析库,然后在最后一部分介绍 Parsec 解析库。

简单解析 Monad

[编辑 | 编辑源代码]

考虑解析任务。一个简单的解析 Monad 就像一个状态 Monad,其中状态是未解析的字符串。我们可以精确地表示为

newtype Parser a = Parser
    { runParser :: String -> Either String (String, a) }

我们再次使用 Left err 表示错误状态。这产生了 MonadMonadPlus 的标准实例

instance Monad Parser where
    return a = Parser (\xl -> Right (xl,a))
    fail   s = Parser (\xl -> Left  s)
    Parser m >>= k = Parser $ \xl ->
      case m xl of
        Left  s -> Left s
        Right (xl', a) ->
            let Parser n = k a
            in  n xl'

instance MonadPlus Parser where
    mzero = Parser (\xl -> Left "mzero")
    Parser p `mplus` Parser q = Parser $ \xl ->
      case p xl of
        Right a -> Right a
        Left  err -> case q xl of
                       Right a -> Right a
                       Left  _ -> Left err

现在,我们想要构建一个解析“基本元素”的库。最基本的基本元素是一个解析特定字符的解析器。此函数看起来像

char :: Char -> Parser Char
char c = Parser char'
    where char' [] = Left ("expecting " ++ show c ++
                           " got EOF")
          char' (x:xs)
              | x == c    = Right (xs, c)
              | otherwise = Left  ("expecting " ++
                                   show c ++ " got " ++
                                   show x)

在这里,解析器仅当输入的第一个字符是预期的字符时才成功。

我们可以使用此解析器来构建解析字符串“Hello”的解析器

helloParser :: Parser String
helloParser = do
  char 'H'
  char 'e'
  char 'l'
  char 'l'
  char 'o'
  return "Hello"

这表明将这些解析器组合在一起是多么容易。我们不需要担心底层字符串——Monad 会为我们处理它。我们只需要将这些解析器基本元素组合起来。我们可以通过使用 runParser 并提供输入来测试此解析器

示例

Parsing> runParser helloParser "Hello"
Right ("","Hello")
Parsing> runParser helloParser "Hello World!"
Right (" World!","Hello")
Parsing> runParser helloParser "hello World!"
Left "expecting 'H' got 'h'"

我们可以有一个稍微更通用的函数,它将匹配任何符合描述的字符

matchChar :: (Char -> Bool) -> Parser Char
matchChar c = Parser matchChar'
    where matchChar' [] =
              Left ("expecting char, got EOF")
          matchChar' (x:xs)
              | c x       = Right (xs, x)
              | otherwise =
                Left  ("expecting char, got " ++
                       show x)

使用它,我们可以编写一个不区分大小写的“Hello”解析器

ciHelloParser = do
  c1 <- matchChar (`elem` "Hh")
  c2 <- matchChar (`elem` "Ee")
  c3 <- matchChar (`elem` "Ll")
  c4 <- matchChar (`elem` "Ll")
  c5 <- matchChar (`elem` "Oo")
  return [c1,c2,c3,c4,c5]

当然,我们可以使用类似 matchChar ((=='h') . toLower) 的东西,但上面的实现也能正常工作。我们可以测试此函数

示例

Parsing> runParser ciHelloParser "hELlO world!"
Right (" world!","hELlO")

最后,我们可以有一个函数,它将匹配任何字符

anyChar :: Parser Char
anyChar = Parser anyChar'
    where anyChar' []     =
             Left  ("expecting character, got EOF")
          anyChar' (x:xs) = Right (xs, x)

在这些基本元素之上,我们通常构建一些组合器。例如,many 组合器将接收一个解析类型为 a 的实体的解析器,并将其转换为一个解析类型为 [a] 的实体的解析器(这是一个 Kleene 星号运算符)

many :: Parser a -> Parser [a]
many (Parser p) = Parser many'
    where many' xl =
              case p xl of
                Left  err -> Right (xl, [])
                Right (xl',a) ->
                    let Right (xl'', rest) = many' xl'
                    in  Right (xl'', a:rest)

这里的想法是,首先我们尝试应用给定的解析器 p。如果失败,我们成功,但返回空列表。如果 p 成功,我们递归并继续尝试应用 p 直到它失败。然后我们返回我们积累的成功列表。

一般来说,会有很多类似的函数,它们会被隐藏在一个库中,这样用户实际上就无法查看 Parser 类型内部。但是,使用它们,你可以构建例如一个解析(非负)整数的解析器

int :: Parser Int
int = do
  t1 <- matchChar isDigit
  tr <- many (matchChar isDigit)
  return (read (t1:tr))

在这个函数中,我们首先匹配一个数字(isDigit 函数来自模块 Char/Data.Char),然后匹配尽可能多的数字。然后我们read结果并返回它。我们可以像以前一样测试这个解析器

示例

Parsing> runParser int "54"
Right ("",54)
*Parsing> runParser int "54abc"
Right ("abc",54)
*Parsing> runParser int "a54abc"
Left "expecting char, got 'a'"

现在,假设我们想要解析一个 Haskell 风格的 Int 列表。这变得有点困难,因为在某个时候,我们将解析一个逗号或一个右括号,但我们不知道什么时候会发生这种情况。这就是 ParserMonadPlus 实例的用武之地:首先我们尝试一个,然后我们尝试另一个。

考虑以下代码

intList :: Parser [Int]
intList = do
  char '['
  intList' `mplus` (char ']' >> return [])
    where intList' = do
            i <- int
            r <- (char ',' >> intList') `mplus`
                 (char ']' >> return [])
            return (i:r)

此代码首先解析并打开一个左括号。然后,使用 mplus,它尝试两种事情中的一种:使用 intList' 解析,或解析一个右括号并返回一个空列表。

intList' 函数假设我们还没有到达列表的末尾,因此它首先解析一个整数。然后它解析列表的其余部分。但是,它不知道我们是否已经到达末尾,因此它再次使用 mplus。一方面,它试图解析一个逗号,然后递归;另一方面,它解析一个右括号并返回一个空列表。无论哪种方式,它都只是将其解析的整数自身附加到开头。

你应该注意的一件事是,你为 mplus 提供参数的顺序。考虑以下解析器

tricky =
  mplus (string "Hal") (string "Hall")

你可能期望此解析器解析“Hal”和“Hall”这两个词;但是,它只解析前者。你可以通过以下方式看到这一点

示例

Parsing> runParser tricky "Hal"
Right ("","Hal")
Parsing> runParser tricky "Hall"
Right ("l","Hal")

这是因为它试图解析“Hal”,它成功了,然后它没有费心去尝试解析“Hall”。

你可以尝试通过提供一个解析器基本元素来修复它,该基本元素检测文件结尾(实际上是字符串结尾)

eof :: Parser ()
eof = Parser eof'
    where eof' [] = Right ([], ())
          eof' xl = Left ("Expecting EOF, got " ++
                          show (take 10 xl))

然后你可以使用 eof 重写 tricky

tricky2 = do
  s <- mplus (string "Hal") (string "Hall")
  eof
  return s

但这也不起作用,正如我们可以轻易看到的那样

示例

Parsing> runParser tricky2 "Hal"
Right ("",())
Parsing> runParser tricky2 "Hall"
Left "Expecting EOF, got \"l\""

这是因为,同样地,mplus 不知道它需要解析整个输入。因此,当你提供它“Hall”时,它只解析“Hal”并将最后的“l”留着供以后解析。这会导致 eof 产生错误消息。

正确的实现方法是

tricky3 =
  mplus (do s <- string "Hal"
            eof
            return s)
        (do s <- string "Hall"
            eof
            return s)

我们可以看到这有效

示例

Parsing> runParser tricky3 "Hal"
Right ("","Hal")
Parsing> runParser tricky3 "Hall"
Right ("","Hall")

这有效正是因为 mplus 的每一侧都知道它必须读取末尾。

在这种情况下,修复解析器以接受“Hal”和“Hall”两者都很简单,因为我们假设我们将在之后立即读取文件结尾。不幸的是,如果我们不能立即消除歧义,生活会变得更加复杂。这是一个解析中的普遍问题,与 Monadic 解析关系不大。大多数解析器库(例如,Parsec,参见关于 Parsec 的部分)采用的解决方案是只识别“LL(1)”语法:这意味着你必须能够用一个标记前瞻来消除输入的歧义。

练习

编写一个解析器 intListSpace,它将解析整数列表,但允许在逗号和括号之间使用任意空白(空格、制表符或换行符)。

逗号和括号之间。

有了这个 Monadic 解析器,添加关于源位置的信息就相当容易了。例如,如果我们正在解析一个大型文件,报告错误发生的哪一行可能会很有用。我们可以简单地通过扩展 Parser 类型并修改实例和基本元素来做到这一点

newtype Parser a = Parser
    { runParser :: Int -> String ->
                   Either String (Int, String, a) }

instance Monad Parser where
  return a = Parser (\n xl -> Right (n,xl,a))
  fail   s = Parser (\n xl -> Left  (show n ++
                                     ": " ++ s))
  Parser m >>= k = Parser $ \n xl ->
    case m n xl of
      Left  s -> Left s
      Right (n', xl', a) ->
          let Parser m2 = k a
          in  m2 n' xl'

instance MonadPlus Parser where
  mzero = Parser (\n xl -> Left "mzero")
  Parser p `mplus` Parser q = Parser $ \n xl ->
    case p n xl of
      Right a -> Right a
      Left  err -> case q n xl of
                     Right a -> Right a
                     Left  _ -> Left err

matchChar :: (Char -> Bool) -> Parser Char
matchChar c = Parser matchChar'
  where matchChar' n [] =
            Left ("expecting char, got EOF")
        matchChar' n (x:xs)
            | c x       =
              Right (n+if x=='\n' then 1 else 0
                    , xs, x)
            | otherwise =
              Left  ("expecting char, got " ++
                     show x)

charanyChar 的定义没有给出,因为它们可以用 matchChar 来编写。many 函数只需要修改以包含新的状态。

现在,当我们运行解析器并且出现错误时,它会告诉我们哪一行包含错误

示例

Parsing2> runParser helloParser 1 "Hello"
Right (1,"","Hello")
Parsing2> runParser int 1 "a54"
Left "1: expecting char, got 'a'"
Parsing2> runParser intList 1 "[1,2,3,a]"
Left "1: expecting ']' got '1'"

我们可以使用之前练习中的 intListSpace 解析器来查看它实际上是否有效

示例

Parsing2> runParser intListSpace 1
               "[1 ,2 , 4  \n\n ,a\n]"
Left "3: expecting char, got 'a'"
Parsing2> runParser intListSpace 1
               "[1 ,2 , 4  \n\n\n ,a\n]"
Left "4: expecting char, got 'a'"
Parsing2> runParser intListSpace 1
               "[1 ,\n2 , 4  \n\n\n ,a\n]"
Left "5: expecting char, got 'a'"

我们可以看到,错误发生的哪一行随着我们在错误的“a”之前添加更多换行符而增加。

当你继续开发你的解析器时,你可能想要添加越来越多的功能。幸运的是,Graham Hutton 和 Daan Leijen 已经在 Parsec 库中为我们做好了这些。本节旨在介绍 Parsec 库;它绝不涵盖整个库,但应该足以让你入门。

与我们的库一样,Parsec 提供了一些基本函数来从字符构建解析器。这些是:char,它与我们的 char 相同;anyChar,它与我们的 anyChar 相同;satisfy,它与我们的 matchChar 相同;oneOf,它接收一个 Char 列表并匹配其中的任何一个;以及 noneOf,它是 oneOf 的反面。

Parsec 用于运行解析器的主要函数是 parse。但是,除了解析器之外,此函数还接收一个字符串,该字符串代表你要解析的文件的名称。这样它就可以给出更好的错误消息。我们可以尝试使用上面的函数进行解析

示例

ParsecI> parse (char 'a') "stdin" "a"
Right 'a'
ParsecI> parse (char 'a') "stdin" "ab"
Right 'a'
ParsecI> parse (char 'a') "stdin" "b"
Left "stdin" (line 1, column 1):
unexpected "b"
expecting "a"
ParsecI> parse (char 'H' >> char 'a' >> char 'l')
            "stdin" "Hal"
Right 'l'
ParsecI> parse (char 'H' >> char 'a' >> char 'l')
            "stdin" "Hap"
Left "stdin" (line 1, column 3):
unexpected "p"
expecting "l"

在这里,我们可以看到我们的解析器和 Parsec 之间的几个区别:首先,当我们运行 parse 时,字符串的其余部分不会被返回。其次,产生的错误消息要好得多。

除了基本字符解析函数之外,Parsec 还提供了用于以下方面的基本元素:spaces,它与我们的相同;space,它解析单个空格;letter,它解析一个字母;digit,它解析一个数字;string,它与我们的相同;以及其他一些。

我们可以用 Parsec 编写我们的 intintList 函数

int :: CharParser st Int
int = do
  i1 <- digit
  ir <- many digit
  return (read (i1:ir))

intList :: CharParser st [Int]
intList = do
  char '['
  intList' `mplus` (char ']' >> return [])
    where intList' = do
            i <- int
            r <- (char ',' >> intList') `mplus`
                 (char ']' >> return [])
            return (i:r)

首先,注意类型签名。st 类型变量只是一个我们没有使用的状态变量。在 int 函数中,我们使用 many 函数(内置于 Parsec)和 digit 函数(也内置于 Parsec)。intList 函数实际上与我们之前编写的一模一样。

但是,请注意,显式使用 mplus 不是组合解析器的首选方法:Parsec 提供了一个 <|> 函数,它是 mplus 的同义词,但看起来更漂亮

intList :: CharParser st [Int]
intList = do
  char '['
  intList' <|> (char ']' >> return [])
    where intList' = do
            i <- int
            r <- (char ',' >> intList') <|>
                 (char ']' >> return [])
            return (i:r)

我们可以测试一下

示例

ParsecI> parse intList "stdin" "[3,5,2,10]"
Right [3,5,2,10]
ParsecI> parse intList "stdin" "[3,5,a,10]"
Left "stdin" (line 1, column 6):
unexpected "a"
expecting digit

除了这些基本组合器之外,Parsec 还提供了一些其他有用的组合器

  • choice 接收一个解析器列表,并在它们之间执行一个操作(<|>)。
  • option 接收一个类型为 a 的默认值和一个返回类型为 a 的解析器。然后它尝试使用解析器进行解析,但如果解析失败,它使用默认值作为返回值。
  • optional 接收一个返回 () 的解析器,并可选地运行它。
  • between 接受三个解析器:一个起始解析器、一个结束解析器和一个中间解析器。它按顺序运行它们并返回中间解析器的值。例如,这可以用来处理我们 intList 解析器的括号。
  • notFollowedBy 接收一个解析器并返回一个仅在给定解析器失败时才成功的解析器。

假设我们想要解析一个简单的计算器语言,其中只包含加号和乘号。此外,为了简单起见,假设每个嵌入的表达式必须用括号括起来。我们可以为这种语言给出数据类型如下

data Expr = Value Int
          | Expr :+: Expr
          | Expr :*: Expr
          deriving (Eq, Ord, Show)

然后为这种语言编写一个解析器如下

parseExpr :: Parser Expr
parseExpr = choice
  [ do i <- int; return (Value i)
  , between (char '(') (char ')') $ do
      e1 <- parseExpr
      op <- oneOf "+*"
      e2 <- parseExpr
      case op of
        '+' -> return (e1 :+: e2)
        '*' -> return (e1 :*: e2)
  ]

在这里,解析器在两种选项之间交替(我们本可以使用 <|>,但我想要展示 choice 组合器的实际应用)。第一个选项简单地解析一个整数,然后将其包装在 Value 构造函数中。第二个选项使用 between 来解析括号之间的文本。它首先解析一个表达式,然后解析加号或乘号,然后解析另一个表达式。根据运算符是什么,它返回 e1 :+: e2e1 :*: e2

我们可以修改这个解析器,使其不再计算 Expr,而是简单地计算值

parseValue :: Parser Int
parseValue = choice
  [int
  ,between (char '(') (char ')') $ do
     e1 <- parseValue
     op <- oneOf "+*"
     e2 <- parseValue
     case op of
       '+' -> return (e1 + e2)
       '*' -> return (e1 * e2)
  ]

我们可以将其用作

示例

ParsecI> parse parseValue "stdin" "(3*(4+3))"
Right 21

现在,假设我们想要在我们的语言中引入绑定。也就是说,我们也想要能够在我们的表达式中说“let x = 5 in”,然后使用我们定义的变量。为了做到这一点,我们需要使用 Parsec 中内置的 getStatesetState(或 updateState)函数。

parseValueLet :: CharParser (FiniteMap Char Int) Int
parseValueLet = choice
  [ int
  , do string "let "
       c <- letter
       char '='
       e <- parseValueLet
       string " in "
       updateState (\fm -> addToFM fm c e)
       parseValueLet
  , do c  <- letter
       fm <- getState
       case lookupFM fm c of
         Nothing -> unexpected ("variable " ++ show c ++
                                " unbound")
         Just  i -> return i
  , between (char '(') (char ')') $ do
      e1 <- parseValueLet
      op <- oneOf "+*"
      e2 <- parseValueLet
      case op of
        '+' -> return (e1 + e2)
        '*' -> return (e1 * e2)
  ]

int 和递归情况保持不变。我们添加了另外两种情况,一种处理 let 绑定,另一种处理使用。

在 let 绑定情况下,我们首先解析一个“let”字符串,然后解析我们要绑定的字符(letter 函数是 Parsec 的一个原语,用于解析字母字符),然后解析其值(一个 parseValueLet)。然后,我们解析“in”并将状态更新为包含此绑定。最后,我们继续并解析剩下的部分。

在使用情况下,我们只需解析字符,然后在状态中查找它。但是,如果它不存在,我们使用 Parsec 原语 unexpected 来报告错误。

我们可以使用 runParser 命令来查看这个解析器的实际应用,它使我们能够提供一个初始状态

示例

ParsecI> runParser parseValueLet emptyFM "stdin"
                 "let c=5 in ((5+4)*c)"
Right 45
*ParsecI> runParser parseValueLet emptyFM "stdin"
                 "let c=5 in ((5+4)*let x=2 in (c+x))"
Right 63
*ParsecI> runParser parseValueLet emptyFM "stdin"
                 "((let x=2 in 3+4)*x)"
Right 14

请注意,括号不影响变量的定义。例如,在最后一个示例中,在某种意义上,“x”的使用超出了定义的范围。但是,我们的解析器没有注意到这一点,因为它以严格的从左到右的方式运行。为了解决这个遗漏,绑定必须被移除(参见练习)。

练习

修改 parseValueLet 解析器,使其遵守括号。为了做到这一点,你需要将状态更改为类似于 FiniteMap Char [Int] 的东西,其中 [Int] 是一个

定义的栈。
华夏公益教科书