Question

我从头开始构建这个小JSON解析器，但由于某种原因我无法解析对象。代码：

import Data.Char
import Control.Monad
import Control.Applicative
import Control.Monad (liftM, ap)

newtype Parser a = Parser (String -> [(String, a)])

parse :: Parser a -> (String -> [(String, a)])
parse (Parser p) = p

item :: Parser Char
item = Parser (\s ->
    case s of
        []     -> []
        (x:xs) -> [(xs,x)])

failure :: Parser a
failure = Parser (\ts -> [])

produce :: a -> Parser a                                  --parse (item >>= produce) "hello"
produce x = Parser (\ts -> [(ts, x)])

instance Applicative Parser where
    pure x = produce x
    Parser pf <*> Parser px = Parser (\ts -> [ (ts'', f x )| (ts', f) <- pf ts,
                                                            (ts'', x) <- px ts'] )

instance Functor Parser where
    fmap f (Parser px) = Parser (\ts -> [ (ts', f x)  | (ts', x) <- px ts])

instance Monad Parser where
    --return :: a -> Parser a
    return = produce
    --(>>=) :: Parser a -> (a -> Parser b) -> Parser b
    (Parser px) >>= f = Parser (\ts ->
        concat [parse (f x) ts' | (ts', x) <- px ts])

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = item >>= (\c ->
    if p c then
    produce c
    else failure)

char :: Char -> Parser Char
char c = satisfy (c == )

string :: String -> Parser String                       --parse (string "hello") "hello"
string [] = produce []
string (c:cs) = char c >>= (\c' ->
                string cs >>= (\cs' ->
                produce (c:cs)))

instance Alternative Parser where
    empty = failure
    (<|>) = orElse
    many p = some p <|> produce []
    some p = (:) <$> p <*> many p

orElse :: Parser a -> Parser a -> Parser a
orElse (Parser px) (Parser py) = Parser (\ts ->
    case px ts of
        [] -> py ts
        xs -> xs)


---------------Parsec bits---------------------------

oneOf :: [Char] -> Parser Char
oneOf s = satisfy (flip elem s)

noneOf :: [Char] -> Parser Char
noneOf cs = satisfy (\c -> not (elem c cs))

sepBy ::  Parser a -> Parser String -> Parser [a]
sepBy p sep         = sepBy1 p sep <|> return []

sepBy1 :: Parser a -> Parser String -> Parser [a]
sepBy1 p sep        = do{ x <- p
                        ; xs <- many (sep >> p)
                        ; return (x:xs)
                        }

-------------------------------------------------------

data Value = StrJson String
            | IntJson Int
            | BoolJson Bool
            | ObjectJson [Pair]
            | ArrayJson [Value]
            | NullJson
              deriving (Eq, Ord, Show)

type Pair = (String, Value)

type NullJson = String

tok :: String -> Parser String
tok t = string t <* whitespace

whitespace :: Parser ()
whitespace = many (oneOf " \t") *> pure ()

var :: Parser Char
var = oneOf ['A' .. 'Z'] <* whitespace


val :: Parser Value
val = IntJson <$> jIntParser
    <|> NullJson <$ tok "null"
    <|> BoolJson <$> jBoolParser
    <|> StrJson <$> jStrParser
    <|> ArrayJson <$> jArrParser
    <|> ObjectJson <$> jObjParser


jStrParser :: Parser String
jStrParser = some (noneOf ("\n\r\"=[]{},")) <* whitespace

jIntParser :: Parser Int
jIntParser = (some (oneOf ['0' .. '9']) >>= produce . read) <* whitespace

jBoolParser :: Parser Bool
jBoolParser = ((string "False" *> produce False) <|> (string "True" *> produce True))

jObjParser :: Parser [Pair]
jObjParser = do
    char '{'
    jp <- jPairParser `sepBy1` (tok ",")
    char '}'
    produce jp

jPairParser :: Parser (String, Value)
jPairParser = do
        jStr <- jStrParser
        tok ":"
        jVal <- val
        produce (jStr, jVal)


jArrParser :: Parser [Value]
jArrParser = do
    char '['
    jArr <- val `sepBy1` (tok ",")
    char ']'
    produce jArr

当我使用“parse jObjParser”运行我的解析器时，{asd：asd}“”它将失败，当我进一步运行“parse jPairParser”asd：asd“”它也会失败。所以我假设对解析器是问题，但我无法解决原因。我可能只是愚蠢所以任何帮助都会非常感激，提前谢谢。

Answer 1

首先让我指出，您的示例代码中的许多函数已经在许多解析器组合包中可用，例如parsec，attoparsec或trifecta - 这取决于您的特定需求。更不用说Aeson等了。但这不是一个很好的答案，所以我假设你正在做一种编码练习，并没有故意使用它们。

通过浏览代码，我最好的猜测是问题在于：

jStrParser :: Parser String
jStrParser = some (noneOf ("\n\r\"=[]{},")) <* whitespace

在这里：

jPairParser :: Parser (String, Value)
jPairParser = do
        jStr <- jStrParser
        tok ":"
        jVal <- val
        produce (jStr, jVal)

jStrParser贪婪，它会通过":"吃掉。 jPairParser tok ":"会因":"因domain1消失而失败。

Answer 2

基本上，您的问题出在jStrParser。它接受"asd:asd"。但是错了。其次，您的jStrParser不正确，因为它必须只接受以'"'开头并以'"'结尾的字符串。

所以，你可以这样解决：

readS_to_Parser :: ReadS a -> Parser a
readS_to_Parser r = Parser (map swap . r)

jStrParser = readS_to_Parser reads <* whitespace

Haskell JSON解析器无法解析对象

2 个答案: