Real World Haskell 中文版

«  第 15 章:使用 Monad 编程   ::   Contents   ::   第 18 章: Monad变换器  »

第 16 章:使用Parsec

为一个文本文件或者不同类型的数据做语法分析(parsing),对程序员来说是个很常见的任务,在本书第198页“使用正则表达式”一节中,我们已经学习了 Haskell 对正则表达式的支持。对很多这样的任务,正则表达式都很好用。

不过,当处理复杂的数据格式时,正则表达式很快就会变得不实用、甚至完全不可用。比如说,对于多数编程语言来说,我们没法(只)用正则表达式去 parse 其源代码。

Parsec 是一个很有用的 parser combinator 库,使用 Parsec,我们可以将一些小的、简单的 parser 组合成更复杂的 parser。Parsec 提供了一些简单的 parser,以及一些用于将这些 parser 组合在一起的组合子。毫不意外,这个为 Haskell 设计的 parser 库是函数式的。

将 Parsec 同其他语言的 parse 工具做下对比是很有帮助的,语法分析有时会被分为两个阶段:词法分析(这方面的工具比如 flex )和语法分析(比如 bison ). Parsec 可以同时处理词法分析和语法分析。 (译注:词法分析将输入的字符串序列转化为一个个的 token,而语法分析进一步接受这些 token 作为输入生成语法树)

Parsec 初步:简单的 CSV parser

让我们来写一个解析 CSV 文件的代码。CSV 是纯文本文件,常被用来表示表格或者数据库。每行是一个记录,一个记录中的字段用逗号分隔。至于包含逗号的字段,有特殊的处理方法,不过在这一节我们暂时不考虑这种情况。

下面的代码比实际需要的代码要长一些,不过接下来,我们很快就会介绍一些 Parsec 的特性,应用这些特性,整个 parser 只需要四行。

-- file: ch16/csv1.hs
import Text.ParserCombinators.Parsec

{- A CSV file contains 0 or more lines, each of which is terminated
   by the end-of-line character (eol). -}
csvFile :: GenParser Char st [[String]]
csvFile =
    do result <- many line
       eof
       return result

-- Each line contains 1 or more cells, separated by a comma
line :: GenParser Char st [String]
line =
    do result <- cells
       eol                       -- end of line
       return result

-- Build up a list of cells.  Try to parse the first cell, then figure out
-- what ends the cell.
cells :: GenParser Char st [String]
cells =
    do first <- cellContent
       next <- remainingCells
       return (first : next)

-- The cell either ends with a comma, indicating that 1 or more cells follow,
-- or it doesn't, indicating that we're at the end of the cells for this line
remainingCells :: GenParser Char st [String]
remainingCells =
    (char ',' >> cells)            -- Found comma?  More cells coming
    <|> (return [])                -- No comma?  Return [], no more cells

-- Each cell contains 0 or more characters, which must not be a comma or
-- EOL
cellContent :: GenParser Char st String
cellContent =
    many (noneOf ",\n")


-- The end of line character is \n
eol :: GenParser Char st Char
eol = char '\n'

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

我们来讲解下这段代码,在这段代码中,我们并没有使用 Parsec 的特性,因此要记住这段代码还能写得更简洁!

我们自顶向下的构建了一个 CSV 的 parser,第一个函数是 csvFile。它的类型是 GenParser Char st [[String]], 这表示这个函数的输入是字符序列,也就是 Haskell 中的字符串,因为 String 不过是 [Char] 的别名,而这个函数的返回类型是 [[String]] : 一个字符串列表的列表。至于 st ,我们暂时忽略它

Parsec 程序员经常会写一些小函数,因此他们常常懒得写函数的类型签名。Haskell 的类型推导系统能够自动识别函数类型。而在上面第一个例子中,我们写出了所有函数的类型,方便你了解函数到底在干什么。另外你可以在 ghci 中使用 :t 来查看函数的类型。

csvFile 函数使用了 do 语句,如其所示,Parsec 库是 monadic 的,它定义了用于语法分析的[1][ref1]:Genparser monad。

csvFile 函数首先运行的是 many linemany是一个高阶函数,它接受一个 parser 函数作为参数,不断对输入应用这个 parser,并把每次 parse 的结果组成一个列表返回。在 csvFile 中,我们把对 csv 文件中所有行的解析结果存储到 result中,然后,当我们遇到文件终结符 EOF 时,就返回 result。也就是说:一个 CSV 文件有好多行组成,以 EOF 结尾。Parsec 写成的函数如此简洁,我们常常能够像这样直接用语言来解释。

上一段说,一个 CSV 文件由许多行组成,现在,我们需要说明,什么是“一行”,为此,我们定义了 line 函数来解析 CSV 文件中的一行,通过阅读函数代码,我们可以发现,CSV 文件中的一行,包括许多“单元格”,最后跟着一个换行符。

那么,什么是“许多单元格”呢,我们通过 cells 函数来解析一行中的所有单元格。一行中的所有单元格,包括一个到多个单元格。因此,我们首先解析第一个单元格的内容,然后,解析剩下的单元格,返回剩下的单元格内容组成的列表,最后,cells 把第一个单元格与剩余单元格列表组成一个新的单元格列表返回。

我们先跳过 remainingCells 函数,去看 cellContent函数,cellContent 解析一个单元格的内容。一个单元格可以包含任意数量的字符,但每一个字符都不能是逗号或者换行符(译注:实际可以包含逗号,不过我们目前不考虑这种情况),我们使用 noneOf 函数来匹配这两个特殊字符,来确保我们遇到的不是这样的字符,于是,many noneOf ",\n"定义了一个单元格。

然后再来看 remainingCells 函数,这个函数用来在解析完一行中第一个单元格之后,解析该行中剩余的单元格。在这个函数中,我们初次使用了 Parsec 中的选择操作,选择操作符是 <|>。这个操作符是这样定义的:它会首先尝试操作符左边的 parser 函数,如果这个parser没能成功消耗任何输入字符(译注:没有消耗任何输入,即是说,从输入字符串的第一个字符,就可以判定无法成功解析,例如,我们希望解析”html”这个字符串,遇到的却是”php”,那从”php”的第一个字符’p’,就可以判定不会解析成功。而如果遇到的是”http”,那么我们需要消耗掉”ht”这两个字符之后,才判定匹配失败,此时,即使已经匹配失败,”ht”这两个字符仍然是被消耗掉了),那么,就尝试操作符右边的 parser。

在函数 remainingCells 中,我们的任务是去解析第一个单元格之后的所有单元格,cellContent 函数使用了 noneOf ",\n",所以逗号和换行符不会被 cellContent 消耗掉,因此,如果我们在解析完一个单元格之后,见到了一个逗号,这说明这一行不止一个单元格。所以,remainingCells 选择操作中的第一个选择的开始是一个 char ',' 来判断是否还有剩余单元格,char 这个 parser 简单的匹配输入中传入的字符,如果我们发现一个逗号,我们希望这个去继续解析剩余的单元格,这个时候,“剩下的单元格”看上去跟一行中的所有单元格在格式上一致。所以,我们递归地调用 cells 去解析它们。如果我们没有发现逗号,说明这一行中再没有剩余的单元格,就返回一个空列表。

最后,我们需要定义换行符,我们将换行符设定为字符’\n’,这个设定到目前来讲已经够用了。

在整个程序的最后,我们定义函数 parseCSV,它接受一个 String 类型的参数,并将其作为 CSV 文件进行解析。这个函数只是对 Parsec 中 parse 函数的简单封装,parse 函数返回 Either ParseError [[String]]类型, 如果输入格式有错误,则返回的是用 Left 标记的错误信息,否则,返回用 Right 标记的解析生成的数据类型。

理解了上面的代码之后,我们试着在 ghci 中运行一下来看下它:

ghci> :l csv1.hs
[1 of 1] Compiling Main             ( csv1.hs, interpreted )
Ok, modules loaded: Main.
ghci> parseCSV ""
Loading package parsec-2.1.0.0 ... linking ... done.
Right []

结果倒是合情合理, parse 一个空字符串,返回一个空列表。接下来,我们去 parse 一个单元格:

ghci> parseCSV "hi"
Left "(unknown)" (line 1, column 3):
unexpected end of input
expecting "," or "\n"

看下上面的报错信息,我们定义“一行”必须以一个换行符结尾,而在上面的输入中,我们并没有给出换行符。Parsec 的报错信息给出了错误的行号和列号,甚至告诉了我们它期望得到的输入。我们对上面的输入给出换行符,并且继续尝试新的输入:

ghci> parseCSV "hi\n"
Right [["hi"]]
ghci> parseCSV "line1\nline2\nline3\n"
Right [["line1"],["line2"],["line3"]]
ghci> parseCSV "cell1,cell2,cell3\n"
Right [["cell1","cell2","cell3"]]
ghci> parseCSV "l1c1,l1c2\nl2c1,l2c2\n"
Right [["l1c1","l1c2"],["l2c1","l2c2"]]
ghci> parseCSV "Hi,\n\n,Hello\n"
Right [["Hi",""],[""],["","Hello"]]

可以看出,parseCSV 的行为与预期一致,甚至空单元格与空行它也能正确处理。

sepBy 与 endBy 组合子

我们早先向您承诺过,上一节中的 CSV parser 可以通过几个辅助函数大大简化。有两个函数可以大幅度简化上一节中的代码。

第一个工具是 sepBy 函数,这个函数接受两个 parser 函数作为参数。第一个函数解析有效内容,第二个函数解析一个分隔符。sepBy 首先尝试解析有效内容,然后去解析分隔符,然后有效内容与分隔符依次交替解析,直到解析完有效内容之后无法继续解析到分隔符为止。它返回有效内容的列表。

第二个工具是 endBy, 它与 sepBy相似,不过它期望它的最后一个有效内容之后,还跟着一个分隔符(译注,就是 parse “a\nb\nc\n”这种,而 sepBy 是 parse “a,b,c” 这种)。也就是说,它将一直进行 parse,直到它无法继续消耗任何输入。

于是,我们可以用 endBy 来解析行,因为每一行必定是以一个换行字符结尾。 我们可以用 sepBy 来解析一行中的所有单元格,因为一行中的单元格以逗号分割,而最后一个单元格后面并不跟着逗号。我们来看下现在的 parser 有多么简单:

-- file: ch16/csv2.hs
import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line    = sepBy cell (char ',')
cell    = many (noneOf ",\n")
eol     = char '\n'

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

这个程序的行为同上一节中的一样,我们可以通过使用 ghci 重新运行上一节中的测试用例来验证,我们会得到完全相同的结果。然而现在的程序更短、可读性更好。你不用花太多时间就能把这段代码翻译成中文描述,当你阅读这段代码时,你将看到:

  • 一个 CSV 文件包含0行或者更多行,每一行都是以换行符结尾。
  • 一行包含一个或者多个单元格(译者注, sepBy应该是允许0个单元格的)
  • 一个单元格包含0个或者更多个字符,这些字符不能是逗号或者换行符
  • 换行符是’\n’

选择与错误处理

不同操作系统采用不同的字符来表示换行,例如,Unix/Linux 系统中,以及 Windows 的 text mode 中,简单地用 “\n” 来表示。DOS 以及 Windows 系统,使用 “\r\n”,而 Mac 一直采用 “\r”。我们还可以添加对 “\n\r” 的支持,因为有些人可能会需要。

我们可以很容易地修改下上面的代码来适应这些不同的换行符。我们只需要做两处改动,修改下 eol 的定义,使它识别不同的换行符,修改下 cell 函数中的 noneOf 的匹配模式,让它忽略 “\r”。

这事做起来得小心些,之前 eol 的定义就是简单的 char '\n',而现在我们使用另一个内置的 parser 函数叫做 string,它可以匹配一个给定的字符串,我们来考虑下如何用这个函数来增加对 “\n\r” 的支持。

我们的初次尝试,就像这样:

-- file: ch16/csv3.hs
-- This function is not correct!
eol = string "\n" <|> string "\n\r"

然而上面的例子并不正确,<|> 操作符总是首先尝试左边的 parser,即 string "\n", 但是对于 “\n” 和 “\n\r” 这两种换行符, string "\n" 都会匹配成功,这可不是我们想要的,不妨在 ghci 中尝试一下:

ghci> :m Text.ParserCombinators.Parsec
ghci> let eol = string "\n" <|> string "\n\r"
Loading package parsec-2.1.0.0 ... linking ... done.
ghci> parse eol "" "\n"
Right "\n"
ghci> parse eol "" "\n\r"
Right "\n"

看上去这个 parser 对与两种换行符都能够正常工作,不过,仅凭上面的结果我们并不能确认这一点。如果 parser 留下了一些没有解析的部分,我们也无从知晓,因为我们解析完换行符后没有再试图去消耗剩余输入。所以让我们在换行符后面加一个文件终止符 eof,表示我们期望在解析完换行符之后,没有剩余的带解析输入了:

ghci> parse (eol >> eof) "" "\n\r"
Left (line 2, column 1):
unexpected "\r"
expecting end of input
ghci> parse (eol >> eof) "" "\n"
Right ()

正如预期的那样,当解析 “\n\r” 换行符时出现了错误,所以接下来我们可能会想这样尝试:

-- file: ch16/csv4.hs
-- This function is not correct!
eol = string "\n\r" <|> string "\n"haskell

这也是不对的。回想一下,<|> 仅在左侧的选项没有消耗输入时,才会尝试在右边的 parser。但是,当我们去看在 “\n” 后面是不是有一个 “\r” 的时候,我们早就已经消耗掉了一个 “\n”,我们会在 parse “\n” 时遇到错误:

ghci> :m Text.ParserCombinators.Parsec
ghci> let eol = string "\n\r" <|> string "\n"
Loading package parsec-2.1.0.0 ... linking ... done.
ghci> parse (eol >> eof) "" "\n\r"
Right ()
ghci> parse (eol >> eof) "" "\n"
Left (line 1, column 1):
unexpected end of input
expecting "\n\r"

我们在超前查看的问题上栽了跟头,看起来,在写 parser 的时候,能够在数据到来时 “超前查看” 是很有用的。Parsec 是支持这一特性的,不过在我们展示这一特性的时候,先来看看怎样能够不利用超前查看特性完成这个任务。你必须要自己去考虑 “\n” 之后的所有可能:

-- file: ch16/csv5.hs
eol =
    do char '\n'
       char '\r' <|> return '\n'

这个函数首先寻找 “\n”,如果找到了,就去寻找 “\r”,如果找到了 “\r”,就消耗掉 “\r”。既然 char '\r' 的返回类型是 Char,那么没有找到 ‘\r’ 时的行为就是简单的返回一个 ‘Char’ 而不试图 parse 任何输入。Parsec 有一个内置函数 option 可以将这种情况表达为 option '\n' (char '\r')。我们在 ghci 中试一下:

ghci> :l csv5.hs
[1 of 1] Compiling Main             ( csv5.hs, interpreted )
Ok, modules loaded: Main.
ghci> parse (eol >> eof) "" "\n\r"
Loading package parsec-2.1.0.0 ... linking ... done.
Right ()
ghci> parse (eol >> eof) "" "\n"
Right ()

这次结果是对的!不过,利用 Parsec 对 lookahead 的支持,代码可以更加简洁。

超前查看

Parsec 有一个内置函数叫做 try 用来支持超前查看,try 接受一个 parser 函数,将它应用到输入。如果这个 parser 没有成功,那么 try 表现地就像它不曾消耗任何输入。所以,如果你在 <|> 的左侧应用 try,那么,即使左侧 parser 在失败时会消耗掉一些输入, Parsec 仍然会去尝试右侧的 parser。try 只有在 <|> 左侧时才会有效。不过,许多函数会在内部使用 <|>。让我们来用 try 扩展对换行符的支持:

-- file: ch16/csv6.hs
import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = many (noneOf ",\n\r")

eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

这里,我们把两个包含两个字符的换行符放在开头,并且用 try 去检查它们。这两个换行符的 parser 都出现在 <|> 的左侧,因此不会有什么问题。我们也可以把 string "\n" 放到 try 中,不过这其实没什么必要,因为它只用检验一个字符,因此当解析失败时不会消耗输入,我们把代码加载进 ghci 去看下运行结果:

ghci> :l csv6.hs
[1 of 1] Compiling Main             ( csv6.hs, interpreted )
Ok, modules loaded: Main.
ghci> parse (eol >> eof) "" "\n\r"
Loading package parsec-2.1.0.0 ... linking ... done.
Right ()
ghci> parse (eol >> eof) "" "\n"
Right ()
ghci> parse (eol >> eof) "" "\r\n"
Right ()
ghci> parse (eol >> eof) "" "\r"
Right ()

四种换行符都能正确的处理,你也可以用不同的换行符来测试完整的 CSV parser,就像这样:

ghci> parseCSV "line1\r\nline2\nline3\n\rline4\rline5\n"
Right [["line1"],["line2"],["line3"],["line4"],["line5"]]

如你所见,现在我们的 parser 支持在单个文件中使用多种换行符啦。

错误处理

本章开头,我们已经看到 Parsec 的报错信息能够列出错误的具体位置以及它期望的输入。可是,当 parser 变得更加复杂的时候,Parsec 的期望输入列表会变得很复杂。不过 Parsec 也提供了一套机制让你来在解析失败时自定义出错信息。

我们来看下现在的 CSV parser 在遇到错误时给出的错误信息:

ghci> parseCSV "line1"
Left "(unknown)" (line 1, column 6):
unexpected end of input
expecting ",", "\n\r", "\r\n", "\n" or "\r

这个报错信息有点长,并且包含了太多的技术细节。我们可以试着用 Monad 中的 fail 函数来改善以下:

-- file: ch16/csv7.hs
eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <|> fail "Couldn't find EOL"

ghci 中测试,结果如下:

ghci> :l csv7.hs
[1 of 1] Compiling Main             ( csv7.hs, interpreted )
Ok, modules loaded: Main.
ghci> parseCSV "line1"
Loading package parsec-2.1.0.0 ... linking ... done.
Left "(unknown)" (line 1, column 6):
unexpected end of input
expecting ",", "\n\r", "\r\n", "\n" or "\r"
Couldn't find EOL

fail 函数把 “Couldn’t find EOL” 追加到了原有的错误信息后面,而不是替换掉了原有的错误信息。Parsec 有一个内置的 <?> 操作符专门针对后一种需求。它跟 <|> 操作符很像,首先尝试操作符左边的 parser, 不过,左边解析失败时并不是去尝试另一个 parser,而是呈现一段错误信息。下面是它的使用方法:

-- file: ch16/csv8.hs
eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"

现在,当你 parse 失败时,你会得到更有用的错误信息:

ghci> :l csv8.hs
[1 of 1] Compiling Main             ( csv8.hs, interpreted )
Ok, modules loaded: Main.
ghci> parseCSV "line1"
Loading package parsec-2.1.0.0 ... linking ... done.
Left "(unknown)" (line 1, column 6):
unexpected end of input
expecting "," or end of line

现在报错信息很有用!通常来说,你需要在 <?> 右侧放上可读性较好的报错信息。

完整的 CSV parser

上面的 CSV parser 的例子有一个很严重的问题:它无法处理单元格中包含逗号的情况。CSV 生成程序通常会把包含逗号的单元格用引号引起。但这又产生了新问题:如果单元格中同时包含引号和逗号怎么办?在这种情况下,用两个引号来表示单元格中的一个引号。

下面是一个完整的 CSV parser,你可以在 ghci 中使用它,或者把它编译成独立的程序,它会解析从标准输入读取的 CSV 文件内容, 并把它转化成另一格式的输出。

-- file: ch16/csv9.hs
import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = quotedCell <|> many (noneOf ",\n\r")

quotedCell =
    do char '"'
       content <- many quotedChar
       char '"' <?> "quote at end of cell"
       return content

quotedChar =
        noneOf "\""
    <|> try (string "\"\"" >> return '"')

eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

main =
    do c <- getContents
       case parse csvFile "(stdin)" c of
            Left e -> do putStrLn "Error parsing input:"
                         print e
            Right r -> mapM_ print r

这是一个完整的 CSV parser,parser 部分只有21行代码,外加10行代码用来写 parseCSVmain 这两个函数。

我们来分析以下这个程序跟上一版本的区别。首先,一个单元格可能是一个普通的单元格或者是一个“引用”的单元格。在这两个选项中,我们首先用 quotedCell 来检查单元格是否是引用单元格,因为这可以通过检查单元格第一个字符是否是引号来实现。(译注:这样可以通过第一个字符判定单元格类型,从而避免使用 try)。

quotedCell 由引用标志双引号开始和结束,其中包含零到多个字符。不过我们不能直接获取这些字符,因为其中可能包含嵌在单元格内容之中的双引号,此时是用两个双引号表示一个嵌入双引号。所以我们定义函数 quotedChar 来处理 quotedCell 中的内容。

当我们处理一个引用单元格内的字符时,我们先考虑 noneOf "\"",这将会匹配并返回所有的非引号字符。而如果我们遇到了引号,我们就检查它是不是两个连续的引号,如果是,就返回一个双引号,否则报错。

注意到在 quotedChar 中,try 是出现在 <|> 的右侧的。而我们之前提过,try 只有当它出现再 <|> 的左侧时才会有效。事实上,这个 try 确实是出现在 <|> 的左侧的,不过是出现在 many 的实现中包含的 <|>的左侧。(译注:虽然在 quotedChar 中,try 出现在 <|> 的右侧,但是当使用 many quotedChar 时,many 的实现使得 try 会出现在其内部的 <|> 的左侧。)

try 的使用在这里是很重要的。假如我们在解析一个引用单元格,并且这个单元格快要解析完了,在这个单元格后面还有下一个单元格。那么,在当前单元格的结尾,我们会看到一个引号,接着是一个逗号。当 parse 到单元格结尾时,调用 quotedChar 时,首先,noneOf 的测试会失败,接着会进行寻找两个连续引号的测试,这个测试也会失败,因为我们看到的是一个引号和一个逗号。如果我们不使用 try,parser 会在看到一个引号之后,期望下一个引号,而且此时第一个引号已经被 parser 给消耗掉了。如果我们使用了 try,那么这种情况就会被正确的识别为不是单元格的内容,所以 many quotedChar 就会终止。于是, 超前查看又一次被证明是十分有用的,并且因为它用起来十分简单,它已经成为 Parsec 中十分引人注目的工具。

我们可以在 ghci 中用引用单元格来测试这个程序:

ghci> :l csv9.hs
[1 of 1] Compiling Main             ( csv9.hs, interpreted )
Ok, modules loaded: Main.
ghci> parseCSV "\"This, is, one, big, cell\"\n"
Loading package parsec-2.1.0.0 ... linking ... done.
Right [["This, is, one, big, cell"]]
ghci> parseCSV "\"Cell without an end\n"
Left "(unknown)" (line 2, column 1):
unexpected end of input
expecting "\"\"" or quote at end of cell

我们来试一下真正的 CSV 文件,下面是一个电子表格程序生成的文件内容:

"Product","Price"
"O'Reilly Socks",10
"Shirt with ""Haskell"" text",20
"Shirt, ""O'Reilly"" version",20
"Haskell Caps",15

现在,我们用这个文件来测试下我们的程序:

$ runhaskell csv9.hs < test.csv
["Product","Price"]
["O'Reilly Socks","10"]
["Shirt with \"Haskell\" text","20"]
["Shirt, \"O'Reilly\" version","20"]
["Haskell Caps","15"]

Parsec 与 MonadPlus

我们在 “Looking for alternatives” 一节介绍过 MonadPlus,Parsec 的 Genparser moand 是 MonadPlus 类型类的一个实例。mzero 代表 parse 失败,而 mplus 则使用 (<|>) 把两个 parser 组合成一个。

-- file: ch16/ParsecPlus.hs
instance MonadPlus (GenParser tok st) where
    mzero = fail "mzero"
    mplus = (<|>)

解析 URL 编码查询字符串

当我们在 “Golfing practice: association lists” 一节提到 application/x-www-form-urlencoded 文本时,我们曾说过之后会为它写一个 parser,现在,我们可以用 Parsec 轻易的实现。

每个键-值对由 & 字符分隔。

-- file: ch16/FormParse.hs
p_query :: CharParser () [(String, Maybe String)]
p_query = p_pair `sepBy` char '&'

注意上面函数的类型签名,我们使用 Maybe 来表示一个值:因为 HTTP 标准中并没有规定一个键必定有一个与之对应的值。我们希望能够区分“没有值”和“空值”。

-- file: ch16/FormParse.hs
p_pair :: CharParser () (String, Maybe String)
p_pair = do
  name <- many1 p_char
  value <- optionMaybe (char '=' >> many p_char)
  return (name, value)

many1 的功能类似与 many:它反复应用一个 parser,返回 parse 的结果列表。不过,当 parser 从未成功时,many 会返回空列表,而 many1 则会失败,也就是说, many1 会返回至少包含一个元素的列表。

optionMaybe 函数接受一个 parser 作为参数,并修改它的行为,当该 parser 解析失败时, optionMaybe 返回 Nothing,成功时,则把 parser 的返回结果用 Just 封装。这就让我们能够区分“没有值”和“空值”。

译注:,对于 optionMaybe,parser 失败时并不一定是返回 Nothing,跟 (<|>) 类似,只有当 optionMaybe 的 parser parse 失败,并且没有消耗任何输入时,才会返回 Nothing,否则,仍然是失败,如下列代码所示:

Prelude Text.ParserCombinators.Parsec> let p = string "html" :: Parser String
Prelude Text.ParserCombinators.Parsec> parseTest p "html"
"html"
Prelude Text.ParserCombinators.Parsec> parseTest p "http"
parse error at (line 1, column 1):
unexpected "t"
expecting "html"
Prelude Text.ParserCombinators.Parsec> let f = optionMaybe p
Prelude Text.ParserCombinators.Parsec> parseTest f "http"
parse error at (line 1, column 1):
unexpected "t"
expecting "html"
Prelude Text.ParserCombinators.Parsec> parseTest f "php"
Nothing
Prelude Text.ParserCombinators.Parsec>

单独的字符可以以如下集中方式编码

-- file: ch16/FormParse.hs
import Numeric
p_char :: CharParser () Char
p_char = oneOf urlBaseChars
     <|> (char '+' >> return ' ')
     <|> p_hex

urlBaseChars = ['a'..'z']++['A'..'Z']++['0'..'9']++"$-_.!*'(),"

p_hex :: CharParser () Char
p_hex = do
  char '%'
  a <- hexDigit
  b <- hexDigit
  let ((d, _):_) = readHex [a,b]
  return . toEnum $ d

有些字符可以直接表示。空格需要单独表示,空格用字符 + 来表示,其他字符则用一个 % 外加两个16进制数字来表示,Numeric 模块中的 readHex 函数可以把一个16进制字符串解析为一个数字。

ghci> parseTest p_query "foo=bar&a%21=b+c"
Loading package parsec-2.1.0.0 ... linking ... done.
[("foo",Just "bar"),("a!",Just "b c")]

As appealing and readable as this parser is, we can profit from stepping back and taking another look at some of our building blocks.

用 Parsec 代替正则表达式来进行临时的 parse

在很多流行的语言中,程序员喜欢用正则表达式来进行“临时的”解析工作,不过,正则表达式既难写,又难调试,如果代码写完后几个月不管,就几乎无法理解,并且失败时没有报错信息。

如果我们用 Parsec 编写紧凑的 parser,我们的代码将拥有可读性、表现力以及有用的报错信息。虽然用 Parsec 编写的代码可能会比正则表达式更长,不过也不会长太多,大抵能够抵消正则表达式的许多诱惑了。

解析时不用变量

上面的一些 parser 使用了 do 标记语法,把一些中间的解析结果绑定到变量,以便过后使用,比如说, p_pair

-- file: ch16/FormParse.hs
p_pair :: CharParser () (String, Maybe String)
p_pair = do
  name <- many1 p_char
  value <- optionMaybe (char '=' >> many p_char)
  return (name, value)

我们可以使用 Control.Monad 模块中的 liftM2 函数,不使用变量来完成上面的工作:

-- file: ch16/FormParse.hs
p_pair_app1 =
    liftM2 (,) (many1 p_char) (optionMaybe (char '=' >> many p_char))

这个函数跟 p_pair 有相同的类型与行为,不过它只有一行。在这里,我们不使用“过程式”的风格来写 parser,而是更加强调应用 parser 以及 parser 的组合。

这种(无变量的)风格称为 applicative 风格,我们可以在编写 applicative 风格 parser 的路上走的更远一些。大多数情况下,除了刚开始要理解这种风格需要一点最初的努力之外,applicative 风格带来的代码紧凑型并不会牺牲代码的可读性。

使用 Applicative Functor 进行 parse

Haskell 标准库中包含一个叫做 Control.Applicative 的模块,我们已经在 “Infix use of fmap” 一节见识过了。这个模块定义了一个叫做 Applicative 的类型类,它表示一个 Applicative Functor,Applicative Functor 在结构化方面比 Functor 更强,不过比 Monad 稍弱。Control.Applicative 模块也定义了 Alternative 类型类,它跟 MonadPlus 很相似。

像往常一样,我们认为理解 Applicative Functor 的最好的方式通过使用它们来讲解。从理论上讲,每个 Monad 都是一个 Applicative functor,但不是每一个 Applicative Functor 都是一个 Monad。由于 Applicative Functor 是在 Monad 之后很久才加入标准库,我们常常不能免费获得一个 Applicative 实例,我们常常需要自己把正在使用的 Monad 声明为 Applicative

译注: 至少在我用的 GHC 7.8.1/GHC 7.10 里,Parser 已经是 Applicative了。不需要自己实现。而且,在 GHC 7.10 中,每一个 Monad 都会强制要求声明为 Applicative,不过又据说 GHC 7.12 可能会取消这一限制。

要在 Parsec 中做到这一点,我们将写一个小模块来将 Parsec 实现为 Applicative,然后我们导入这个模块,而不是通常的 Parsec 模块。

-- file: ch16/ApplicativeParsec.hs
module ApplicativeParsec
    (
      module Control.Applicative
    , module Text.ParserCombinators.Parsec
    ) where

import Control.Applicative
import Control.Monad (MonadPlus(..), ap)
-- Hide a few names that are provided by Applicative.
import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))

-- The Applicative instance for every Monad looks like this.
instance Applicative (GenParser s a) where
    pure  = return
    (<*>) = ap

-- The Alternative instance for every MonadPlus looks like this.
instance Alternative (GenParser s a) where
    empty = mzero
    (<|>) = mplus

为了方便起见,我们自己的模块导出了我们从 ApplicativeParsec 模块中导入的所有变量与函数名。因为我们隐藏了 Parsec 的 (<|>),我们导入这个自己定义的模块后,使用的 (<|>) 将会是从 Control.Applicative 模块中导入的。

举例:使用 Applicative 进行 parse

我们将自底向上的改写上面的表单 parser,首先从 p_hex 开始,p_hex 解析一个16进制转义字符序列。下面是使用 do-notation 风格的代码:

-- file: ch16/FormApp.hs
p_hex :: CharParser () Char
p_hex = do
  char '%'
  a <- hexDigit
  b <- hexDigit
  let ((d, _):_) = readHex [a,b]
  return . toEnum $ d

而下面是 applicative 风格的代码:

-- file: ch16/FormApp.hs
a_hex = hexify <$> (char '%' *> hexDigit) <*> hexDigit
    where hexify a b = toEnum . fst . head . readHex $ [a,b]

虽然单独的 parser 并没有改变,仍然是 char '%' 与两个 hexDigit,把它们组合在一起的组合子却发生了变化。其中,目前我们唯一熟悉的一个就是 (<$>),我们已经知道,它不过是 fmap 的同义词。

从我们对 GenParserApplicative 实例的实现中,我们知道 (<*>) 就是 ap

剩下的我们不熟悉的组合子是 (*>),它接受两个 parser 作为参数,首先应用第一个 parser,但是忽略其返回结果,而只用作消耗输入,然后应用第二个 parser,并返回其结果。换句话说,它很像 (>>)

关于尖括号的一个小提示(此处应该是 Real World Haskell 中的 Notes)

我们继续之前,记住这些从 Control.Applicative 中导入的尖括号表示的组合子是在干什么是很有用的:如果一个尖括号指向某个方向,那么它就是返回这个方向的参数的结果。

例如,(*>) 返回其右侧参数的结果; (<*>) 返回两侧参数的结果,(<*),这个组合子我们目前还没过用到,它返回其左侧参数的结果。

虽然这里涉及的多数概念在之前 Functor 和 Monad 的章节中我们已经了解过了,我们还是过一遍这下函数来解释下发生了什么。首先,为了解函数的类型,我们把 hexify 函数提升为全局函数,并且手动写类型签名。

-- file: ch16/FormApp.hs
hexify :: Char -> Char -> Char
hexify a b = toEnum . fst . head . readHex $ [a,b]

Parsec 的 hexDigit parser 会解析一个十六进制数字(译注:是0-F的数字,而不是十六进制数)

ghci> :type hexDigit
hexDigit :: CharParser st Char

因此, char '%' *> hexDigit 的类型跟 hexDigit 相同, 而 (*>) 返回它右侧的结果。(CharParser 类型不过是 GenParser Char 的同义词)。

ghci> :type char '%' *> hexDigit
char '%' *> hexDigit :: GenParser Char st Char

hexify <$> (char '%' *> hexDigit) 这个表达式是这样一个 parser,它匹配一个 “%” 字符,紧接着匹配一个十六进制数字字符,而其结果是一个函数。(译注:, hexify这个函数在这里被部分应用了)

ghci> :type hexify <$> (char '%' *> hexDigit)
hexify <$> (char '%' *> hexDigit) :: GenParser Char st (Char -> Char)

最后, (<*>) 首先应用左边的 parser,再应用右边的 parser,然后应用把右边 parser 产生的值应用到左边 parser 产生的函数上。

如果你已经能够理解下面这句话,那么你就能理解 (<*>)ap 这两个组合子:(<*>) 就是原来的 ($) 被提升到 Applicative Functor,而 ap 则是 ($) 被提升到 Monad。

ghci> :type ($)
($) :: (a -> b) -> a -> b
ghci> :type (<*>)
(<*>) :: (Applicative f) => f (a -> b) -> f a -> f b
ghci> :type ap
ap :: (Monad m) => m (a -> b) -> m a -> m b

接下来,我们考虑 p_char 这个 parser,原来的代码是这样子的:

-- file: ch16/FormApp.hs
p_char :: CharParser () Char
p_char = oneOf urlBaseChars
     <|> (char '+' >> return ' ')
     <|> p_hex

urlBaseChars = ['a'..'z']++['A'..'Z']++['0'..'9']++"$-_.!*'(),"

使用 Applicative 风格的代码跟上面的代码几乎一样,不过使用了更方便的记号。

-- file: ch16/FormApp.hs
a_char = oneOf urlBaseChars
     <|> (' ' <$ char '+')
     <|> a_hex

这里,(<$) 组合子会在右边的 parser 成功时,返回左边参数的值。

最后,等价的 p_pair_app1 也几乎跟原来的版本相同,下面是原来的版本:

-- file: ch16/FormParse.hs
p_pair_app1 =
    liftM2 (,) (many1 p_char) (optionMaybe (char '=' >> many p_char))

我们改变的只有用来做提升的组合子: liftA 函数在这里的效果同 liftM 是一样的。

-- file: ch16/FormApp.hs
a_pair :: CharParser () (String, Maybe String)
a_pair = liftA2 (,) (many1 a_char) (optionMaybe (char '=' *> many a_char))

Parse JSON 数据

为了更好的理解 Applicative Functor,并且进一步探索 Parsec,让我们来写一个满足 RFC 4627 定义的 JSON parser

在顶层,一个 JSON 值要么是一个对象,要么是一个数组。

-- file: ch16/JSONParsec.hs
p_text :: CharParser () JValue
p_text = spaces *> text
     <?> "JSON text"
    where text = JObject <$> p_object
             <|> JArray <$> p_array

译注:这一节作者并没有给出 JSON 类型的定义,可以参考第六章。而且第六章的 JSON 定义也跟这里的 parser 不太一致,可以参考 Real World Haskell 网站这一节中 Alexey 的 comment:

-- 译注:Real World Haskell 网站这一节中 Alexey 的 comment
data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject (JObj JValue)
            | JArray (JAry JValue)
            deriving (Eq, Ord, Show)
newtype JAry a = JAry {
    fromJAry :: [a]
    } deriving (Eq, Ord, Show)

newtype JObj a = JObj {
    fromJObj :: [(String, a)]
    } deriving (Eq, Ord, Show)

数组和对象在结构上很类似,一个字符(对数组是 “[”,对对象是“{”)用作做括号,内部是用逗号分隔的数据,由另一个字符(对数组是“]”,对对象是“}”)作为右括号终结。我们可以抓住这种相似性,写一个小的辅助函数。

-- file: ch16/JSONParsec.hs
p_series :: Char -> CharParser () a -> Char -> CharParser () [a]
p_series left parser right =
    between (char left <* spaces) (char right) $
            (parser <* spaces) `sepBy` (char ',' <* spaces)

在这里,我们终于用到了 (<*) 这个我们之前介绍过的组合子。我们用它来略过一些 token 之前的空格。使用 p_series 函数, 解析一个数组会很简单。

-- file: ch16/JSONParsec.hs
p_array :: CharParser () (JAry JValue)
p_array = JAry <$> p_series '[' p_value ']'

处理 JSON 的对象要复杂一点,需要一点额外的努力来为每个 object 的 field 产生一个 name-value 对。

-- file: ch16/JSONParsec.hs
p_object :: CharParser () (JObj JValue)
p_object = JObj <$> p_series '{' p_field '}'
    where p_field = (,) <$> (p_string <* char ':' <* spaces) <*> p_value

解析一个单独的值是就是调用一个现有的 Parser,然后把它的结果用相应的 JValue 构造器封装:

-- file: ch16/JSONParsec.hs
p_value :: CharParser () JValue
p_value = value <* spaces
  where value = JString <$> p_string
            <|> JNumber <$> p_number
            <|> JObject <$> p_object
            <|> JArray  <$> p_array
            <|> JBool   <$> p_bool
            <|> JNull   <$ string "null"
            <?> "JSON value"

p_bool :: CharParser () Bool
p_bool = True <$ string "true"
     <|> False <$ string "false"

choice 组合子允许我们把这种很有很多选项的情况用一个列表来表示,它返回 parser 列表中第一个 parse 成功的 parser 的结果。

-- file: ch16/JSONParsec.hs
p_value_choice = value <* spaces
  where value = choice [ JString <$> p_string
                       , JNumber <$> p_number
                       , JObject <$> p_object
                       , JArray  <$> p_array
                       , JBool   <$> p_bool
                       , JNull   <$ string "null"
                       ]
                <?> "JSON value"

下面是最有意思的两个 parser:数字、字符串

-- file: ch16/JSONParsec.hs
p_number :: CharParser () Double
p_number = do s <- getInput
              case readSigned readFloat s of
                [(n, s')] -> n <$ setInput s'
                _         -> empty

我们的诀窍是利用 Haskell 标准库中的数字 parser 库函数,它们定义在 Numeric 库中,readFloat 函数解析一个无符号浮点数,而 readSigned 函数接受一个无符号数的 parser 作为参数,并将其转换为有符号数的 parser。

上面的那些函数都不是 Parsec 中的库函数,所以需要一点特殊处理。Parsec 的 getInput 函数可以让我们直接访问 Parsec 还不曾消耗的输入流,对这些输入流,如果 readSigned readFloat解析成功,那么就返回解析成功的数字以及剩下的输入。这些还没有处理的输入,我们用 setInput 将他们还给 Parsec 作为新的未消耗的输入流。

Parse 一个字符串也不困难,不过需要处理一些细节。

-- file: ch16/JSONParsec.hs
p_string :: CharParser () String
p_string = between (char '\"') (char '\"') (many jchar)
    where jchar = char '\\' *> (p_escape <|> p_unicode)
              <|> satisfy (`notElem` "\"\\")

我们可以使用刚刚介绍过的 choice 组合子来解析转义字符序列。

-- file: ch16/JSONParsec.hs
p_escape :: CharParser () Char
p_escape = choice (zipWith decode "bnfrt\\\"/" "\b\n\f\r\t\\\"/")
    where decode :: Char -> Char -> CharParser () Char
          decode c r = r <$ char c

最后,JSON 允许我们在字符串中使用 Unicode 字符:”\u”后面跟着四个十六进制数字:

-- file: ch16/JSONParsec.hs
p_unicode :: CharParser () Char
p_unicode = char 'u' *> (decode <$> count 4 hexDigit)
    where decode x = toEnum code
              where ((code,_):_) = readHex x

相比 Monad,Applicative Functor唯一缺少的能力,就是把一个值绑定到一个变量,而当我们需要验证我们解析的结果时,我们就需要这种能力。

基本上只有当我们需要把值绑定到变量时,我们才会需要写 Monadic 的函数,对于更复杂的 parser 也是这样的:我们不太会用到 Monad 提供的额外的力量。

我们写这本书的时候, Applicative Functor 对于 Haskell 社区还是很新的概念,人们仍然在探索它在 parser 领域之外应用的可能。

Parse HTTP 请求

这一节我们来写一个基本的 HTTP 请求的 parser, 来作为 Applicative Parsing 的例子。

module HttpRequestParser
    (
      HttpRequest(..)
    , Method(..)
    , p_request
    , p_query
    ) where

import ApplicativeParsec
import Numeric (readHex)
import Control.Monad (liftM4)
import System.IO (Handle)

一个 HTTP 请求包含一个 method,一个 identifier,一些 header,以及一个可选的 body。为了简单起见,我们只关注 HTTP 1.1 标准的六种 method 中的两种,POST method 包含一个 body,GET method 没有 body.

-- file: ch16/HttpRequestParser.hs
data Method = Get | Post
          deriving (Eq, Ord, Show)

data HttpRequest = HttpRequest {
      reqMethod :: Method
    , reqURL :: String
    , reqHeaders :: [(String, String)]
    , reqBody :: Maybe String
    } deriving (Eq, Show)

因为我们采用 application style, 我们的 parser 简洁而易读。当然,可读性好,是说你得习惯 applicative style。

-- file: ch16/HttpRequestParser.hs
p_request :: CharParser () HttpRequest
p_request = q "GET" Get (pure Nothing)
        <|> q "POST" Post (Just <$> many anyChar)
  where q name ctor body = liftM4 HttpRequest req url p_headers body
            where req = ctor <$ string name <* char ' '
        url = optional (char '/') *>
              manyTill notEOL (try $ string " HTTP/1." <* oneOf "01")
              <* crlf

简单地说,q 辅助函数接受一个 method 名,一个值构造器,一个对请求的可选 body 的 parser。而 url 辅助函数并不试图去验证一个 URL,因为 HTTP 规范没有规定 URL 能够包含哪些字符,这个函数只是消耗遇到的输入直到行尾或者遇到 HTTP 版本 identifier。

避免使用回溯

try 组合子必须记住它遇到的输入,因为要在 parse 失败时恢复消耗的输入,以便下一个 parser 使用。这被称为回溯。因为 try 必须保存输入,它的开销很昂贵。滥用 try 会拖慢 parser 的速度,甚至使性能慢到不可接受。

为了避免使用回溯,标准的做法是重构我们的 parser,手动提取 (<|>) 两侧 parser 的公共左因子,使我们只用一个 token 就能判断 parse 成功还是失败。在这种情况下,两个 parser 消耗相同的初始输入,最终组合为一个 parser

ghci> let parser = (++) <$> string "HT" <*> (string "TP" <|> string "ML")
ghci> parseTest parser "HTTP"
"HTTP"
ghci> parseTest parser "HTML"
"HTML"

更妙的是,使用这种写法,当输入无法匹配时,Parsec 给出的错误信息更好:

ghci> parseTest parser "HTXY"
parse error at (line 1, column 3):
unexpected "X"
expecting "TP" or "ML"

Parse HTTP Header

HTTP 请求的第一行之后,是零到多个 header,一个 header 以一个字段名开头,跟着是一个冒号,然后是内容。如果一行以空格开头,它被认为是上一行的延续。

-- file: ch16/HttpRequestParser.hs
p_headers :: CharParser st [(String, String)]
p_headers = header `manyTill` crlf
  where header = liftA2 (,) fieldName (char ':' *> spaces *> contents)
        contents = liftA2 (++) (many1 notEOL <* crlf)
                               (continuation <|> pure [])
        continuation = liftA2 (:) (' ' <$ many1 (oneOf " \t")) contents
        fieldName = (:) <$> letter <*> many fieldChar
        fieldChar = letter <|> digit <|> oneOf "-_"

crlf :: CharParser st ()
crlf = (() <$ string "\r\n") <|> (() <$ newline)

notEOL :: CharParser st Char
notEOL = noneOf "\r\n"

练习

  1. 我们的 HTTP 请求 parser 过于简化了,没法在部署在实际应用中。它缺少重要的功能,并且无法组织最基本的拒绝服务攻击(DOS, denial of service attack) 让我们的 parser 关注 Content-Length 这个 field,如果它存在的话
  2. 针对不设防的 web server 的 一个很流行的 DOS 攻击方式,是向它发送特别长的 header,一个 header 可能包含几百兆的垃圾信息,从而耗光服务器的内存。 重构 header 的 parser,当一行超过 4096 个字符时 parse 失败。它必须在超过长度时立刻失败,而不是等到处理完一行之后。
  3. 关注 Transfer-Encoding 这个 field,如果它存在的话,关于它的细节,可以查看 RFC 2616 的第 3.6.1 节
  4. 另一个流行的攻击方式是开启一个链接之后,放置不管或者以十分慢的速度发送数据。使用 IO monad 来封装 parser,如果没有在30秒内完成 parse,就使用 System.Timeout 这个模块关闭链接。

讨论

comments powered by Disqus

«  第 15 章:使用 Monad 编程   ::   Contents   ::   第 18 章: Monad变换器  »