JSON Parser

jq.hs

module Main where

import Text.ParserCombinators.Parsec
import Control.Applicative ((*>), (<*), (<*>), (<$>), (<$), empty)
import Numeric (readHex, readSigned, readFloat)

run :: Show a => Parser a -> String -> IO ()
run p input = case (parse p "" input) of
                Left err -> do putStr "parse error at "
                               print err
                Right x -> print x

data JValue = JString String
            | JNumber Double
            | JObject [(String, JValue)]
            | JArray [JValue]
            | JBool Bool
            | JNull
            deriving Show

p_json :: CharParser () JValue
p_json = spaces *> json <?> "JSON text"
    where json = JObject <$> p_object <|> JArray <$> p_array

p_object :: CharParser () [(String, JValue)]
p_object = p_series '{' p_field '}'
    where p_field = (,) <$> (p_string <* spaces <* char ':' <* spaces) <*> p_value

p_array :: CharParser () [JValue]
p_array = p_series '[' p_value ']'

p_series :: Char -> CharParser () a -> Char -> CharParser () [a]
p_series left parser right = between (char left <* spaces) (char right) $
    (parser <* spaces) `sepBy` (char ',' <* spaces)

p_string :: CharParser () String
p_string = between (char '\"') (char '\"') (many jchar)
    where jchar = char '\\' *> (p_escape <|> p_unicode) <|> satisfy (`notElem` "\"\\")

p_escape :: CharParser () Char
p_escape = choice (zipWith decode "bnfrt\\\"/" "\b\n\f\r\t\\\"/")
    where decode c r = r <$ char c

p_unicode :: CharParser () Char
p_unicode  = char 'u' *> (decode <$> count 4 hexDigit)
    where decode x = toEnum code
            where ((code, _):_) = readHex x

p_number :: CharParser () Double
p_number = do s <- getInput
              case readSigned readFloat s of
                [(n, s')] -> n <$ setInput s'
                _         -> empty

p_bool :: CharParser () Bool
p_bool = True <$ string "true"
     <|> False <$ string "false"

p_value :: CharParser () JValue
p_value = spaces *> value <* spaces
    where value = JString <$> p_string
              <|> JNumber <$> p_number
              <|> JObject <$> p_object
              <|> JArray  <$> p_array
              <|> JBool   <$> p_bool
              <|> JNull   <$  string "null"
              <?> "JSON Value"

toJSON :: String -> Either ParseError JValue
toJSON s = parse p_json "" s

main :: IO ()
main = print $ toJSON "{ \"Name\" : \"Json Parser\", \"Object\":{\"number\": 123, \"bool\": true, \"\\u6c49\\u5b57\": [\"汉\", \"字\", false]} }"