packages feed

JSONParser (empty) → 0.1.0.1

raw patch · 6 files changed

+173/−0 lines, 6 filesdep +basedep +parsecsetup-changed

Dependencies added: base, parsec

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for JSONParser++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ JSONParser.cabal view
@@ -0,0 +1,28 @@+name: JSONParser+version: 0.1.0.1+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: hawk.alan@gmail.com+synopsis: Parse JSON+category: Text+author: Alan Hawkins+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+    type: git+    location: http://github.com/xpika/JSONParser.git++library+    exposed-modules:+        Text.JSONParser+    build-depends:+        base >=4.9 && <4.10,+        parsec >=3.1 && <3.2+    default-language: Haskell2010+    other-extensions: NoMonomorphismRestriction++
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Alan Hawkins++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alan Hawkins nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# JSONParser
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/JSONParser.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+++module Text.JSONParser where++import Text.ParserCombinators.Parsec+import Data.Maybe+import Control.Monad+import Data.Char++data JValue = JObject [(JKey,JValue)]+          | JList [JValue]+          | JSingle JKey+    deriving (Read,Show)++data JKey = JKeyString String +  | JKeyNum JNum+  | JKeyBool Bool+  | JKeyNull+  deriving (Read,Show)+  +data JNum = JNumInt Int | JNumFraction Double+ deriving (Read,Show)+     +spaceOut p = between (many space) (many space) p   ++parseNull = string "null" >> return JKeyNull++parseKey = choice (map try [parseBool,parseString,parseNum,parseNull])+    +parseSingle = fmap JSingle parseKey++parseBool =  do +    b <- (string "true" <|> string "false")+    return (JKeyBool (b == "true"))+                           +parseString = do +    char '"'+    str <- manyTill (parseEscapeChar <|> anyChar) (char '"') +    return (JKeyString str)                              ++parseEscapeChar = do +    char '\\'+    eitherEscapeChar <- (fmap Left (char 'u' >> parseUnicodePointCode)) <|> (fmap Right (parseAsciiEscapeKey))+    let escapeSequence = case eitherEscapeChar of +          Left hexCode -> "\\x"++hexCode+          Right charKey -> "\\"++[charKey]+    return (read ("'"++escapeSequence++"'") :: Char)  +    +parseAsciiEscapeKey = oneOf "\\/bfnrt"+parseUnicodePointCode = replicateM 4 (satisfy isHexDigit)+    +parseKeyValuePair = do+  k <- spaceOut parseKey +  char ':'+  o <- parseValue +  return (k,o)     ++parseObject = do+ char '{'+ pairs <- sepBy parseKeyValuePair (char ',')+ char '}'+ return (JObject pairs)++parseList = do+ char '['+ values <- sepBy parseValue (char ',')+ char ']'+ return (JList values)+  +parseValue = choice (map (try . spaceOut) [parseObject,parseList,parseSingle])+    +parser = do+  b <- parseValue+  eof+  return b++parseSign = char '-'+parseNatChars = many1 (oneOf "0123456789")+parseFractionalPart = char '.' >> parseNatChars+parseExponentPart = do +  oneOf "eE" +  sign <- many parseSign+  str <- parseNatChars +  return (read (sign ++ str) :: Double)++caseMaybe m f a = case m of + (Just b) -> f a b+ _ -> a+ +raise n e = n * (10**e) +raiseInt n e = n * (10^(round e)) ++parseNum = do+  sign <- fmap maybeToList $ optionMaybe parseSign+  natpart <- parseNatChars+  fracpart <- optionMaybe parseFractionalPart+  expo <- optionMaybe parseExponentPart+  let isFractional = maybe False (<0) expo || isJust fracpart+  let fracpart' = fromMaybe "0" fracpart+  return $ JKeyNum $ case isFractional of +    True -> JNumFraction +        $ caseMaybe expo raise+        $ (read (sign++natpart++"."++fracpart'):: Double)+    False -> JNumInt +        $ caseMaybe expo raiseInt+        $ (read (sign++natpart):: Int)