This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

json-parser.hs

By: a guest on Jan 2nd, 2012  |  syntax: Haskell  |  size: 3.56 KB  |  views: 80  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. -- Released to the public domain January 2, 2012.
  2. module Main(main) where
  3.  
  4. import Control.Monad
  5. import Data.Char
  6. import Data.Maybe
  7. import Data.List
  8. import Text.Parsec
  9. import Text.Parsec.String
  10.  
  11. data JValue = JObject [(String, JValue)]
  12.             | JArray [JValue]
  13.             | JString String
  14.             | JNumber Double
  15.             | JTrue | JFalse
  16.             | JNull
  17.     deriving Show
  18.  
  19. whitespaceChar = oneOf " \n\r\f" >> return ()
  20.               <?> "whitespace character"
  21.  
  22. ws = skipMany whitespaceChar <?> "whitespace"
  23.  
  24. tok = between ws ws . char
  25.  
  26. beginArray     = tok '['
  27. beginObject    = tok '{'
  28. endArray       = tok ']'
  29. endObject      = tok '}'
  30. nameSeparator  = tok ':'
  31. valueSeparator = tok ',' <?> "comma"
  32.  
  33. true = string "true" >> return JTrue
  34. false = string "false" >> return JFalse
  35. jnull = string "null" >> return JNull
  36.  
  37. object :: Parser JValue
  38. object = (liftM JObject . between beginObject endObject $ member `sepBy` valueSeparator)
  39.       <?> "object"
  40.     where
  41.         member = do (JString name) <- jstring
  42.                     _ <- nameSeparator
  43.                     v <- jvalue
  44.                     return (name, v)
  45.                  <?> "member"
  46.  
  47. array :: Parser JValue
  48. array = (liftM JArray . between beginArray endArray $ jvalue `sepBy` valueSeparator)
  49.      <?> "array"
  50.  
  51. jstring :: Parser JValue
  52. jstring = (liftM JString . between quote quote $ many character)
  53.        <?> "string"
  54.     where
  55.         quote = char '"'
  56.        character = unescaped <|> escaped
  57.        escaped = do _ <- char '\\'
  58.                     c <- oneOf $ 'u' : map fst escapables
  59.                     if c == 'u' then readHex else readNormal c
  60.  
  61.        readHex = do ds <- count 4 hexDigit -- contains 4 hex digits, as characters.
  62.                     let ds' = zip (reverse [0..3]) $ map digitToInt ds
  63.                      in return . toEnum $ foldl' (\n (e, d) -> n+d*0x10^e) 0 ds'
  64.  
  65.        readNormal c = return . fromJust $ lookup c escapables
  66.  
  67.        unescaped :: Parser Char
  68.        unescaped = satisfy (valid . ord)
  69.            where
  70.                valid c = 0x20 <= c && c <= 0x21
  71.                       || 0x23 <= c && c <= 0x5B
  72.                       || 0x5D <= c && c <= 0x10FFFF
  73.                    
  74.        escapables = [ ('"', '"')
  75.                     , ('\\', '\\')
  76.                     , ('b', '\b')
  77.                     , ('f', '\f')
  78.                     , ('n', '\n')
  79.                     , ('r', '\r')
  80.                     , ('t', '\t')
  81.                     ]
  82.  
  83. number :: Parser JValue
  84. number = do s1 <- readSign
  85.            n <- rawNum
  86.            f <- option "0" $ char '.' >> rawNum
  87.            (expon, s2) <- option ("0", '+') expo
  88.            let s = [s1] ++ n ++ "." ++ f ++ "e" ++ [s2] ++ expon
  89.            return . JNumber $ read s
  90.          <?> "number"
  91.    where
  92.        readSign = liftM (\c -> if c == '+' then ' ' else c) $ option '+' sign
  93.        expo = do _ <- oneOf "eE"
  94.                  s <- readSign
  95.                  ex <- rawNum
  96.                  return (ex, s)
  97.        rawNum = many1 digit
  98.        sign = oneOf "+-" <?> "sign"
  99.  
  100. jvalue :: Parser JValue
  101. jvalue = object
  102.      <|> true <|> false
  103.      <|> jnull
  104.      <|> array
  105.      <|> number
  106.      <|> jstring
  107.  
  108. parseJSON :: Parser JValue
  109. parseJSON = object <|> array
  110.  
  111. --simpleTest = readFile "simple.json"
  112. --arrayTest = readFile "array.json"
  113. --objectTest = readFile "object.json"
  114.  
  115. main :: IO ()
  116. main = parseTest parseJSON "{\"x\":1 }"
  117. -- OUTPUT:
  118. -- parse error at (line 1, column 8):
  119. -- unexpected "}"
  120. -- expecting whitespace character or ","
clone this paste RAW Paste Data