Haskell JSON parser not parsing objects - json

Question

I have been building this small JSON parser from scratch and I can't get an object to parse for some reason.
Code:
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
When I run my parser with "parse jObjParser "{asd:asd}"" it will fail and when I go further and run with "parse jPairParser "asd:asd"" it will also fail. So I assume the pair parser is the problem but I can't work out why. I'm probably just being dumb so any help would be very much appreciated, Thanks in advance.

Answer 1

First of all let me point out that a lot of the functions in your sample code are already available in many parser combinator packages such as parsec, attoparsec or trifecta - depending on your particular needs. Not to mention Aeson and such. But that is not much of an answer so I will assume you are doing a sort of coding excercise and are not using those on purpose.
My best guess by glancing at your code is that the problem is here:
jStrParser :: Parser String
jStrParser = some (noneOf ("\n\r\"=[]{},")) <* whitespace
And here:
jPairParser :: Parser (String, Value)
jPairParser = do
jStr <- jStrParser
tok ":"
jVal <- val
produce (jStr, jVal)
jStrParser is greedy and it will eat through ":". jPairParser will then fail at tok ":" because ":" it has already been consumed.

Answer 2

Basically, your problem is in jStrParser. It accepts "asd:asd". But is wrong. Secondly, your jStrParser isn't correct, because, it must accept only strings that begin on '"' and end on '"'.
So, you can fix like this:
readS_to_Parser :: ReadS a -> Parser a
readS_to_Parser r = Parser (map swap . r)
jStrParser = readS_to_Parser reads <* whitespace