json.hs

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