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 +5/−0
- JSONParser.cabal +28/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- Text/JSONParser.hs +107/−0
+ 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)