Haskell JSON解析器不解析對象

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 

當我跑我的「解析jObjParser‘解析器{ASD：ASD}’」它會失敗，當我進一步去和運行「的解析jPairParser‘ASD：房間隔缺損’」這也將失敗。所以我假設對解析器是問題，但我無法解決原因。我可能只是愚蠢的，所以任何幫助將非常感激，提前致謝。

Answer 1

首先，讓我指出示例代碼中的很多功能已經在許多分析程序組合包（例如parsec，attoparsec或trifecta）中提供，具體取決於您的特定需求。更何況艾森等。但這並不是一個很好的答案，所以我會假設你正在做一些編碼練習，而不是故意使用它們。

我最好在你的代碼一眼的猜測是，這個問題是在這裏：

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 ":"失敗，因爲":"它已被使用。

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