import Control.Monad import Control.Applicative ((*>), (<*)) import Text.Parsec import Text.Parsec.String import Data.List (intercalate) data JSON = JString String | JNumber Double | JBool Bool | JObject [(String, JSON)] deriving (Show, Eq) pjson :: Parser JSON pjson = jstring <|> number <|> bool <|> object where -- TODO allow escape sequences jstring :: Parser JSON jstring = JString <$> (char '"' *> many (noneOf ['"']) <* char '"') -- TODO parse full JS doubles number :: Parser JSON number = JNumber . read <$> (many1 digit) bool :: Parser JSON bool = JBool <$> (true <|> false) where true :: Parser Bool true = string "true" *> pure True false :: Parser Bool false = string "false" *> pure False object :: Parser JSON object = do spaces *> char '{' ps <- option [] pairs spaces *> char '}' return (JObject ps) where pairs :: Parser [(String, JSON)] pairs = do p <- spaces *> pair <* spaces c <- optionMaybe (char ',') case c of Nothing -> return [p] otherwise -> do ps <- pairs return (p : ps) pair :: Parser (String, JSON) pair = do JString k <- jstring spaces *> char ':' *> spaces v <- pjson return (k, v) stringify :: JSON -> String -- TODO escape string stringify (JString s) = "\"" ++ s ++ "\"" stringify (JNumber n) = show n stringify (JBool b) = if b then "true" else "false" stringify (JObject ps) = "{" ++ intercalate "," (map spair ps) ++ "}" where spair (s, j) = stringify (JString s) ++ ":" ++ stringify j