はわわーっ

はわわわわっ

Parsec で JSON をパースする

Parsec の練習に JSON パーサを作ってみた。

import Numeric (readSigned, readFloat, readHex)
import Text.ParserCombinators.Parsec

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

parseJSON :: String -> IO ()
parseJSON s = case parse jvalue "" s of
                Left  e -> print e
                Right x -> print x


jvalue :: Parser JValue
jvalue = do spaces
            jnull <|> jbool <|> jstring <|> jnumber <|> jarray <|> jobject

jnull :: Parser JValue
jnull = do string "null"
           spaces
           return JNull

jbool :: Parser JValue
jbool =   do string "true"
             spaces
             return $ JBool True
      <|> do string "false"
             spaces
             return $ JBool False

jstring :: Parser JValue
jstring = do char '"'
             x <- many jchar
             char '"'
             spaces
             return $ JString x
  where
    jchar =   try (noneOf "\"\\")
          <|> try (do string "\\\""
                      return $ '"')
          <|> try (do string "\\\\"
                      return $ '\\')
          <|> try (do string "\\/"
                      return $ '/')
          <|> try (do string "\\b"
                      return $ '\b')
          <|> try (do string "\\f"
                      return $ '\f')
          <|> try (do string "\\n"
                      return $ '\n')
          <|> try (do string "\\r"
                      return $ '\r')
          <|> try (do string "\\t"
                      return $ '\t')
          <|> try (do string "\\u"
                      x <- count 4 hexDigit
                      case readHex x of
                        [(x', "")] -> return $ toEnum x'
                        _          -> pzero)

jnumber :: Parser JValue
jnumber = do s <- getInput
             case readSigned readFloat s of
               [(n, s')] -> do setInput s'
                               spaces
                               return $ JNumber n
               _         -> pzero

jarray :: Parser JValue
jarray = do char '['
            spaces
            es <- jvalue `sepBy` (char ',' >> spaces)
            char ']'
            spaces
            return $ JArray es

jobject :: Parser JValue
jobject = do char '{'
             spaces
             es <- toObj `sepBy` (char ',' >> spaces)
             char '}'
             spaces
             return $ JObject es
  where
    toObj = do JString k <- jstring
               spaces
               char ':'
               spaces
               v <- jvalue
               spaces
               return $ (k, v)

よくわからないけど、ttp://api.twitter.com/1/statuses/user_timeline/yomi322.json とかもちゃんと読めてるような気がする。

もう少しきれいに書けるようにしたいなぁ。特に jstring のあたりとか。