【译】用 parsec 库解析 json - Haskell( ⁼̴̀ .̫ ⁼̴ )✧ 用 haskell parse

简单的 JSON 解析器注释版

{
  "rsvp_limit": 15,
  "status": "upcoming",
  "visibility": "public",
  "venue": {
    "name": "Hyperconnect, Inc",
    "address": "14F, 5 Seocho-daero 78-gil, Seoc..",
    "city": "Seoul",
    "country": "kr",
    "lat": 37.49721,
    "lon": 127.027374
  },
  "id": "140930019688259",
  "time": 1474326000,
  "event_url": "https://www.facebook.com/events/14..",
  "name": "Simple JSON Parser",
  "group": {
    "id": 1065398240148353,
    "name": "Haskell School",
    "join_mode": "open",
    "group_url": "https://www.facebook.com/group.."
  }
}

解析 Boolean

true 或者 false

步骤：

import parsec 库
使用 string 函数，返回解析后的 string string :: String -> Parser String
使用 parse 函数，它接收解析器、名称、输入，返回 Either 包裹的结果 parse :: Parser a -> name -> s -> Either ParseError a

实现：

import Text.ParserCombinators.Parsec

matchTrue :: Parser String
matchTrue = string "true"

使用：

ghci> :set -package parsec
package flags have changed, resetting and loading new packages...
ghci> import Text.ParserCombinators.Parsec
ghci> matchTrue = string "true"
ghci> parse matchTrue "a json parser" "true"
Right "true"
ghci> parse matchTrue "a json parser" "false"
Left "a json parser" (line 1, column 1):
unexpected "f"
expecting "true"

解析 "false"：

matchFalse :: Parser String
matchFalse = string "false"

使用：

ghci> parse matchFalse "a json parser" "false"
Right "false"

Parsec 库

Daan Leijen 写的一个 Monadic 的 Parser 组合子库

解析器组合子是用对应编程语言写的解析器，不像 yacc 那样有单独的语法。
Parsers 在 haskell 中是一类值(first-class value, 指在编程语言中，某个类型的值可以像任何其他值一样被操作、传递和存储。)

Parsec 模块

-- Parsec v2 的兼容层
import Text.ParserCombinators.Parsec

-- Parsec v3
import Text.Parsec
import Text.Parsec.String

Parser 类型构造器

Parser a = ParsecT String () Identity a

type Parser = Parsec String ()
type Parsec s u = ParsecT s u Identity
data ParsecT s u m a

ParserT 是一个 Monad Transformer，各参数含义：

流类型 s
用户状态类型 u
底层 Monad 类型 m
返回类型 a

辅助函数

parse :: Stream s Indetity t => (Parser s () a) -> SourceName -> s -> Either ParseError a

parse p filePath input 在没有用户状态的情况下，对 Identity 进行解析器 p 的解析。filePath 仅在错误消息中使用，可以是空字符串。返回值要么是一个 ParseError（Left），要么是一个类型为 a 的值（Right）。

parseTest :: (Stream s Identity t, Show a) => (Parsec s () a) -> s -> IO ()

表达式 parseTest p input 对输入 input 应用解析器 p，并将结果打印到标准输出 stdout。这通常用于测试解析器。

真正的 Boolean

注意到用 matchTrue 解析后的返回值是字符串 "true"

ghci> parse matchTrue "a json parser" "true"
Right "true" -- string

而我们真正想要的是布尔值 True，怎样实现这样的解析器 realTrue?

realTrue :: Parser Bool

处理带上下文的值

import Control.Applicative (pure)
pure :: a -> f a  -- Bool -> Parser Bool

import Control.Monad (return)
return :: a -> m a -- Bool -> Parser Bool

realTrue :: Parser Bool
realTrue = pure True

组合解析器

`>>` (bind) 操作符

按顺序组合两个操作，丢弃第一个操作产生的任何值。

(>>)  :: m a -> (_ -> m b) -> m b
(>>=) :: m a -> (a -> m b) -> m b

boolTrue :: Parser Bool
boolTrue = matchTrue >> pure True

do-natation 风格

boolTrue :: Parser Bool
boolTrue = do
  matchTrue
  return True

Applicative 风格

按顺序组合两个操作，丢弃第一个操作产生的任何值。

(*>)  :: Parser a -> Parser b -> Parser b

丢弃第二个操作产生的任何值。

(>*)  :: Parser a -> Parser b -> Parser b

boolTrue  = matchTrue *> realTrue
boolFalse = realFalse <* matchFalse

解析真正的布尔值

ghci> parse boolTrue "a json parser" "true"
Right True
ghci> parse boolTrue "a json parser" "false"
Left "a json parser" (line 1, column 1):
unexpected "f"
expecting "true"
ghci> boolFalse = realFalse <* matchFalse
ghci> parse boolFalse "a json parser" "false"
Right False
ghci> parse boolFalse "a json parser" "true"
Left "a json parser" (line 1, column 1):
unexpected "t"
expecting "false"

匹配多个解析器之一

伪代码如下:

bool = boolTrue || boolFalse

-- choice 组合器
(<|>) :: Parser a -> Parser a -> Parser a

这个组合器实现了 choice，p <!> q 这个解析器先应用 p，如果成功了就返回，否则匹配 q。

bool :: Parser Bool
bool = boolTrue <|> boolFalse

使用：

ghci> parse bool "a json parser" "true"
Right True
ghci> parse bool "a json parser" "false"
Right False

解析字符串

"rsvp_limit"

使用以下函数：

char    :: Parser Char
noneOf  :: [Char] -> Parser Char
many    :: Parser p -> Parser [p]

实现：

stringLiteral :: Praser String
stringLiteral = char '"' *> many (noneOf "\"") <* char '"'

使用：

ghci> parse stringLiteral "a json parser" "\"rsvp_limit\""
Right "rsvp_limit"

ghci> parse stringLiteral "a json parser" "rsvp_limit"
Left "a json parser" (line 1, column 1):
unexpected "r"
expecting "\""

返回值

无法用 <|> 组合两个不同类型的解析器

ghci> value = bool <|> stringLiteral

<interactive>:28:18: error:
    ? Couldn't match type ‘[Char]’ with ‘Bool’
      Expected: Text.Parsec.Prim.ParsecT s u m Bool
        Actual: Text.Parsec.Prim.ParsecT s u m [Char]
    ? In the second argument of ‘(<|>)’, namely ‘stringLiteral’
      In the expression: bool <|> stringLiteral
      In an equation for ‘value’: value = bool <|> stringLiteral

需要先定义一个新类型处理这种情况：

data JSONVal = Bool Bool
             | String String
             deriving (Show)

parseJSON :: Parser JSONVal
parseJSON = bool <|> stringLiteral

没想到还是报错了：

<interactive>:32:22: error:
    ? Couldn't match type ‘[Char]’ with ‘Bool’
      Expected: Text.Parsec.Prim.ParsecT s u m Bool
        Actual: Text.Parsec.Prim.ParsecT s u m [Char]
    ? In the second argument of ‘(<|>)’, namely ‘stringLiteral’
      In the expression: bool <|> stringLiteral
      In an equation for ‘parseJSON’: parseJSON = bool <|> stringLiteral

这是因为 bool 是解析布尔值的，而非 Bool Bool，所以需要构造新的解析器

解析器 Boolean

data JSONVal = Bool Bool deriving (Show)

parseBool :: Parser JSONVal
parseBool = Bool bool

处理带上下文的值 - 续

以下的函子可以用来处理能 map 的类型

fmap  :: (a -> b) -> f a -> f b
(<$>) :: (a -> b) -> Parser a -> Parser b

所以可以这样用：

parseBool = Bool <$> bool   -- fmap Bool bool

让我们试一下：

ghci> parse parseBool "a json parser" "true"
Right (Bool True)
ghci> parse parseBool "a json parser" "false"
Right (Bool False)

解析字符串

data JSONVal = Bool Bool 
             | String String
             deriving (Show)

parseString :: Parser JSONVal
parseString = String <$> stringLiteral

parseJson :: Parser JSONVal
parseJson = parseBool <|> parseString

使用：

ghci> parse parseJson "a json parser" "\"rsvp_limit\""
Right (String "rsvp_limit")
ghci> parse parseJson "a json parser" "true"
Right (Bool True)

优化错误提示

ghci> parse parseJson "a json parser" "apple"
Left "a json parser" (line 1, column 1):
unexpected "a"
expecting "true", "false" or "\""

可以看到，错误提示非常不友好，让我们用 <?> 优化下，其定义为：

<?> :: Parser p ‐> String ‐> Parser p

解析器 p <?> msg 的行为与解析器 p 相同，但是每当解析器 p 在不消耗任何输入的情况下失败时，它将期望错误消息替换为指定的期望错误消息 msg。

parseJson = (parseBool <?> "boolean")
        <|> (parseString <?> "string literal")
ghci> parse parseJson "a json parser" "apple"  
Left "a json parser" (line 1, column 1):
unexpected "a"
expecting boolean or string literal  -- 可以看到，错误提示已经替换了

解析数字

15

使用一些新的辅助函数：

many1 :: Parser p ‐> Parser [p]
digit :: Parser Char
read :: String ‐> a

使用下：

ghci> parse (many letter) "many vs many1" "20th"
Right ""
ghci> parse (many1 letter) "many vs many1" "20th"
Left "many vs many1" (line 1, column 1):
unexpected "2"
expecting letter

愉快的解析数字吧：

data JSONVal = Bool Bool 
             | String String
             | Number Integer
             deriving (Show)

parseNumber :: Parser JSONVal
parseNumber = do
  n <- many1 digit
  return (Number (read n))

使用：

ghci> parse parseNumber "a json parser" "15"
Right (Number 15)

处理带上下文的值 - 再续

-- 将一个函数提升为一个 Monad
liftM :: Monad m => (a1 ‐> r) ‐> m a1 ‐> m r
liftA :: Applicative f => (a ‐> b) ‐> f a ‐> f b
fmap :: (a ‐> b) ‐> f a ‐> f b

应用到 parseNumber 上：

import Control.Monad (liftM)

parseNumber :: Parser JSONVal
parseNumber = liftM (Number . read)   -- String -> JSONVal
                    (many1 digit)     -- Parser String

使用：

ghci> parse parseNumber "a json parser" "15"
Right (Number 15)

解析浮点型

37.4972

parseNumber 在解析浮点数时会报错

ghci> parse parseNumber "a json parser" "37.4972"
Right (Number 37)

先实现一个 parseFloat：

data JSONVal = Bool Bool 
             | String String
             | Number Integer
             | Float Double
             deriving (Show)

parseFloat :: Parser JSONVal
parseFloat = do
  whole <- many1 digit
  char '.'
  fraction <- many1 digit
  return (Float (read (whole ++ "." ++ fraction)))

使用：

ghci> parse parseFloat "a json parser" "37.4972"
Right (Float 37.4972)

解析数字和浮点型

应该怎么写呢？

parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal") 
        <|> parseNumber
        <|> parseFloat

试一试：

ghci> parse parseJson "a json parser" "15"
Right (Number 15)
ghci> parse parseJson "a json parser" "37.4972"
Right (Number 37)

结果不符合预期，没有正确解析浮点数，而是解析了它的整数部分。
那我们交换两个 parser 的顺序试试：

parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal")
        <|> parseFloat
        <|> parseNumber

ghci> parse parseJson "a json parser" "37.4972"
Right (Float 37.4972)
ghci> parse parseJson "a json parser" "15"
Left "a json parser" (line 1, column 3):
unexpected end of input
expecting digit or "."

这次正确解析了浮点型，但是解析 15 的时候却报错了。

predictive 解析器

(<|>) :: Parser a -> Parser a -> Parser a

p <|> q，这种 parser 称为 predictive，因为 q 只会在 parser p 不消费任何输入时才会执行。这种非回溯行为既可以实现高效的解析器组合子，又可以生成良好的错误消息。像下面例子这样：

testOr = string "(a)"
     <|> string "(b)"

ghci> parse testOr "test" "(b)"
Left "test" (line 1, column 1):
unexpected "b"
expecting "(a)"

try 组合子

try :: Parser a -> Parser a

解析器 try p 的行为类似于解析器 p，唯一的区别是当出现错误时，它会假装自己没有消耗任何输入。

parseJson :: Parser JSONVal
parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal") 
        <|> try parseFloat
        <|> parseNumber

试一试：

ghci> parse parseJson "a json parser" "37.4972"
Right (Float 37.4972)
ghci> parse parseJson "a json parser" "15"
Right (Number 15)

解析数组

["Hello", "Goodbye", true, false, true]

新辅助函数

sepBy :: Parser a -> Parser sep -> Parser [a]

添加定义：

data JSONVal = Bool Bool 
             | String String
             | Number Integer
             | Float Double
             | Array [JSONVal]
             deriving (Show)

array :: Parser [JSONVal]
array = char '[' *> sepBy parseJson (char ',') <* char ']' 

parseArray :: Parser JSONVal
parseArray = Array <$> array

parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal") 
        <|> try parseFloat
        <|> parseNumber
        <|> parseArray

使用：

ghci> parse parseJson "a json parser" "[\"Hello\",\"Goodbye\",true,false,true]"
Right (Array [String "Hello",String "Goodbye",Bool True,Bool False,Bool True])

解析对象

{"name": "Jun", "male": true}

先解析一个键值对：

objectEntry :: Parser (String, JSONVal)
objectEntry = do
  key <- stringLiteral
  char ':'
  value <- parseJson
  return (key, value)

测试：

ghci> parse objectEntry "a json parser" "\"male\":true"
Right ("male",Bool True)

在解析整个对象：

data JSONVal = Bool Bool 
             | String String
             | Number Integer
             | Float Double
             | Array [JSONVal]
             | Object [(String, JSONVal)]
             deriving (Show)

parseObject :: Parser JSONVal
parseObject = do
  char '{'
  obj <- sepBy objectEntry (char ',')
  char '}'
  return $ Object obj

parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal") 
        <|> try parseFloat
        <|> parseNumber
        <|> parseArray
        <|> parseObject

让我们试一试：

ghci> parse parseJson "a json parser" "{\"name\":\"Jun\",\"male\":true}"
Right (Object [("name",String "Jun"),("male",Bool True)])

空格

刚才的测试用例中都是没有空格的，如果有空格就会报错：

ghci> parse parseJson "a json parser" "[true, true, true]"
Left "a json parser" (line 1, column 7):
unexpected " "
expecting boolean, string literal, digit, "[" or "{"

辅助函数：

oneOf :: [Char] -> Parser Char

顾名思义，oneOf 接收一个字符列表，如果下个字符在这个列表中则成功，返回解析到的字符。

ws :: Parser String
ws = many (oneOf " \t\n\r")

lexme p = p <* ws

parseBool = lexme $ Bool <$> bool
parseString = lexme $ String <$> stringLiteral
parseNumber = lexme $ liftM (Number . read) (many1 digit)

array = (lexme $ char '[') *> 
        (sepBy parseJson (lexme $ (char ',')))
        <* (lexme $ char ']') 
parseArray = Array <$> array

objectEntry = do
  key <- (lexme stringLiteral)
  (lexme $ char ':')
  value <- (lexme parseJson)
  return (key, value)

parseObject = do
  (lexme $ char '{')
  obj <- sepBy objectEntry (lexme $ char ',')
  (lexme $ char '}')
  return $ Object obj

测试下效果

ghci> parse parseJson "a json parser" "[true, true, true]"
Right (Array [Bool True,Bool True,Bool True])

ghci> parse parseJson "aaa" "{ \"a\" : 1 , \"b\": [ \"2 \" ] }"
Right (Object [("a",Number 1),("b",Array [String "2 "])])

简单的 json 解析器

直接解析最初的 json 串：

parse parseJson "a json parser" "{\
\  \"rsvp_limit\": 15,                                      \
\  \"status\": \"upcoming\",                                \
\  \"visibility\": \"public\",                              \
\  \"venue\": {                                             \
\    \"name\": \"Hyperconnect, Inc\",                       \
\    \"address\": \"14F, 5 Seocho-daero 78-gil, Seoc..\",   \
\    \"city\": \"Seoul\",                                   \
\    \"country\": \"kr\",                                   \
\    \"lat\": 37.49721,                                     \
\    \"lon\": 127.027374                                    \
\  },                                                       \
\  \"id\": \"140930019688259\",                             \
\  \"time\": 1474326000,                                    \
\  \"event_url\": \"https://www.facebook.com/events/14..\", \
\  \"name\": \"Simple JSON Parser\",                        \
\  \"group\": {                                             \
\    \"id\": 1065398240148353,                              \
\    \"name\": \"Haskell School\",                          \
\    \"join_mode\": \"open\",                               \
\    \"group_url\": \"https://www.facebook.com/group..\"    \
\  }                                                        \
\}"

Right (Object [("rsvp_limit",Number 15),("status",String "upcoming"),("visibility",String "public"),("venue",Object [("name",String "Hyperconnect, Inc"),("address",String "14F, 5 Seocho-daero 78-gil, Seoc.."),("city",String "Seoul"),("country",String "kr"),("lat",Float 37.49721),("lon",Float 127.027374)]),("id",String "140930019688259"),("time",Number 1474326000),("event_url",String "https://www.facebook.com/events/14.."),("name",String "Simple JSON Parser"),("group",Object [("id",Number 1065398240148353),("name",String "Haskell School"),("join_mode",String "open"),("group_url",String "https://www.facebook.com/group..")])])

处理状态

使用 runParser：

runParser :: Parser s u a -> u -> SourceName -> a -> Either ParseError a

runParser p state filePath input 在输入列表 input 上运行解析器 p，该输入列表是从源文件 filePath 中获取的，初始用户状态为 state st(u)。

getState :: Monad m => ParsecT s u m u
putState :: Monad m => u ‐> ParsecT s u m ()

parseObject :: Parsec String Int JSONVal
parseObject = do ...                 
  c <‐ getState
  putState (c+1) ... ‐‐ modifyState (+1)
  
liftM (runParser (parseJson >> getState) 0 "")
      (readFile "meetup.json")
Right 3

另一件事

aeson 和 megaparsec ...

将 Parsec 切换到 Megaparsec
Haskellschool 项目：Scheme 解释器

总结

解析器（parsers）：string、char、noneOf、oneOf等。
类型构造器（type constructor）：parser、parsec、parsecT。
辅助函数（helper functions）：parse、parseTest、parseFromFile、runParser。
处理带有上下文的值（dealing with a value with a context）：pure、return、liftM、fmap。
合并解析器（combining parsers）：>>、op、do-notation、<、>、applicative。
匹配多个解析器中的一个（matching one of multiple parsers）：<|>。
数据（data）、类型（type）。
改进错误消息（improving error messages）：<?>。
预测分析器（predictive parser）：try。
处理状态（handling state）：getState、putState、modifyState。

引用

略

代码汇总

import Control.Monad (liftM)
import Text.Parsec

type Parser = Parsec String ()

data JSONVal = Bool Bool 
             | String String
             | Number Integer
             | Float Double
             | Array [JSONVal]
             | Object [(String, JSONVal)]
             deriving (Show)
ws = many (oneOf " \t\n\r")

lexme p = p <* ws

matchTrue = string "true"
matchFalse = string "false"
bool = (matchTrue *> pure True)
   <|> (matchFalse *> pure False)
parseBool = lexme $ Bool <$> bool

stringLiteral = char '"' *> many (noneOf "\"") <* char '"'
parseString = lexme $ String <$> stringLiteral

parseFloat :: Parser JSONVal
parseFloat = do
  whole <- many1 digit
  char '.'
  fraction <- many1 digit
  return (Float (read (whole ++ "." ++ fraction)))

parseNumber = lexme $ liftM (Number . read) (many1 digit)

array = (lexme $ char '[') *> 
        (sepBy parseJson (lexme $ (char ',')))
        <* (lexme $ char ']') 
parseArray = Array <$> array

objectEntry = do
  key <- (lexme stringLiteral)
  (lexme $ char ':')
  value <- (lexme parseJson)
  return (key, value)

parseObject = do
  (lexme $ char '{')
  obj <- sepBy objectEntry (lexme $ char ',')
  (lexme $ char '}')
  return $ Object obj

parseJson = (parseBool <?> "boolean") 
        <|> (parseString <?> "string literal") 
        <|> try parseFloat
        <|> parseNumber
        <|> parseArray
        <|> parseObject

main = do
    print $ parse parseJson "a json parser" "{\
\  \"rsvp_limit\": 15,                                      \
\  \"status\": \"upcoming\",                                \
\  \"visibility\": \"public\",                              \
\  \"venue\": {                                             \
\    \"name\": \"Hyperconnect, Inc\",                       \
\    \"address\": \"14F, 5 Seocho-daero 78-gil, Seoc..\",   \
\    \"city\": \"Seoul\",                                   \
\    \"country\": \"kr\",                                   \
\    \"lat\": 37.49721,                                     \
\    \"lon\": 127.027374                                    \
\  },                                                       \
\  \"id\": \"140930019688259\",                             \
\  \"time\": 1474326000,                                    \
\  \"event_url\": \"https://www.facebook.com/events/14..\", \
\  \"name\": \"Simple JSON Parser\",                        \
\  \"group\": {                                             \
\    \"id\": 1065398240148353,                              \
\    \"name\": \"Haskell School\",                          \
\    \"join_mode\": \"open\",                               \
\    \"group_url\": \"https://www.facebook.com/group..\"    \
\  }                                                        \
\}"

【译】用 parsec 库解析 json - Haskell

解析 Boolean

Parsec 库

Parsec 模块

Parser 类型构造器

辅助函数

真正的 Boolean

处理带上下文的值

组合解析器

>> (bind) 操作符

do-natation 风格

Applicative 风格

解析真正的布尔值

匹配多个解析器之一

解析字符串

返回值

解析器 Boolean

处理带上下文的值 - 续

解析字符串

优化错误提示

解析数字

处理带上下文的值 - 再续

解析浮点型

解析数字和浮点型

predictive 解析器

try 组合子

解析数组

解析对象

空格

简单的 json 解析器

处理状态

另一件事

总结

引用

代码汇总

`>>` (bind) 操作符