AttoJson 0.5.2 → 0.5.3

raw patch · 2 files changed

+72/−41 lines, 2 filesdep +sybPVP ok

version bump matches the API change (PVP)

Dependencies added: syb

API changes (from Hackage documentation)

Files

• AttoJson.cabal +3/−3
• Text/JSON/AttoJSON.hs +69/−38

@@ -1,6 +1,6 @@ Name:                AttoJson-Version:             0.5.2-Synopsis:            Simple lightweight JSON parser & generator based on ByteString+Version:             0.5.3+Synopsis:            Simple lightweight JSON parser, generator & manipulator based on ByteString  Description: Simple Lightweight JSON parser & generator based on ByteString. @@ -19,7 +19,7 @@  Library   Exposed-modules:     Text.JSON.AttoJSON-  Build-depends: containers >=0.1, base >= 4 && < 5, bytestring-show >= 0.1, utf8-string >= 0.1, attoparsec >= 0.8, bytestring >= 0.9, mtl >= 1.0+  Build-depends: containers >=0.1, base >= 4 && < 5, bytestring-show >= 0.1, utf8-string >= 0.1, attoparsec >= 0.8, bytestring >= 0.9, mtl >= 1.0, syb >= 0.1      -- Modules not exported by this package.   -- Other-modules:       

@@ -1,6 +1,15 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, OverlappingInstances #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, OverlappingInstances #-} {-# OPTIONS_GHC -fwarn-unused-imports #-}-module Text.JSON.AttoJSON (JSValue (..), getField, getFields, JSON(..), parseJSON, readJSON, showJSON) where+module Text.JSON.AttoJSON (+    -- * Class and Data-Types for JSON Value+    JSValue (..), JSON(..),+    -- * Parsing & Printing+    parseJSON, readJSON, showJSON,+    -- * Manipulating Objects+    getField, getFields, updateField+  ) where+ import Control.Applicative hiding (many) import qualified Data.ByteString.Lazy as L (unpack) import Control.Monad.Identity (runIdentity)@@ -22,27 +31,45 @@ import Text.Show.ByteString (show) import Data.Ratio (denominator, numerator) import Numeric (readHex)-import Data.Map (Map, fromList, elems, mapWithKey, toList, mapKeys)+import Data.Map (Map, fromList, elems, mapWithKey, toList, mapKeys, insert) import qualified Data.Map as M (lookup)+import Data.Generics (Data(..), Typeable(..)) + fromLazy = pack . L.unpack -data JSValue = JSString {fromJSString :: !ByteString}-             | JSNumber Rational-             | JSObject (Map ByteString JSValue)-             | JSArray [JSValue]-             | JSBool !Bool-             | JSNull deriving (P.Show, Eq)+-- |Data types for JSON value.+data JSValue = JSString {fromJSString :: !ByteString} -- ^ JSON String+             | JSNumber Rational                      -- ^ JSON Number+             | JSObject (Map ByteString JSValue)      -- ^ JSON Object+             | JSArray [JSValue]                      -- ^ JSON Array+             | JSBool !Bool                           -- ^ JSON Bool+             | JSNull                                 -- ^ JSON Null+               deriving (P.Show, Eq, Data, Typeable) +-- |Get the value for field in Object and decode it. getField :: JSON a => ByteString -> JSValue -> Maybe a getField key (JSObject dic) = M.lookup key dic >>= fromJSON getField _ _                = Nothing +-- |Same as 'getField' but it can process nested Object. ex:+-- +-- @+--   getFeilds [\"user\", \"name\"] (JSObject [(\"user\", JSObject [(\"name\", JSString \"hoge\")])]) == Just \"hoge\"+-- @ getFields :: JSON a => [ByteString] -> JSValue -> Maybe a getFields keys jso = fromJSON =<< foldrM getField jso (P.reverse keys) +-- | Update or Insert the value for field in Object.+updateField :: JSON a => ByteString -> a -> JSValue -> JSValue+updateField key v (JSObject jso) = JSObject $ insert key (toJSON v) jso+updateField _ _ j                = j++-- |Type Class for the value that can be converted from/into 'JSValue'. class JSON a where+    -- |Decode from JSValue     fromJSON :: JSValue -> Maybe a+    -- |Encode into JSValue     toJSON   :: a -> JSValue  instance JSON JSValue where@@ -118,11 +145,44 @@ value :: Parser JSValue value = jsString <|> number <|> object <|> array <|> try bool <|> try jsNull +-- |Parse JSON source. Returns 'JSValue' ('Right') if succeed, Returns 'Left' if faild. parseJSON :: ByteString -> Either String JSValue parseJSON = eitherResult . runIdentity . parseWith (return "") (value <* skipSpace <* endOfInput)++-- |Maybe version of 'parseJSON'. readJSON :: ByteString -> Maybe JSValue readJSON = maybeResult . runIdentity . parseWith (return "") (value <* skipSpace <* endOfInput) +-- |Print 'JSValue' as JSON source (not pretty).+showJSON :: JSValue -> ByteString+showJSON (JSObject dic) = "{" `append` intercalate "," mems `append` "}"+  where+    mems = elems $ mapWithKey (\k v -> showJSString k `append` ":" `append` showJSON v) dic+showJSON (JSString jss)     = showJSString jss+showJSON (JSNumber jsn) | denominator jsn == 1 = fromLazy $ show $ numerator jsn+                        | otherwise            = fromLazy $ show (fromRational jsn :: Double)+showJSON (JSArray jss)      = "[" `append` intercalate ", " (P.map showJSON jss) `append` "]"+showJSON (JSNull)           = "null"+showJSON (JSBool True)      = "true"+showJSON (JSBool False)     = "false"++showJSString :: ByteString -> ByteString+showJSString js = "\"" `append` escape js `append` "\""+  where+    escape :: ByteString -> ByteString+    escapeCh :: Char -> ByteString+    escape = concat . P.map escapeCh . decode . unpack+    escapeCh '\\' = "\\\\"+    escapeCh '"'  = "\\\""+    escapeCh '\b' = "\\b"+    escapeCh '\f' = "\\f"+    escapeCh '/'  = "\\/"+    escapeCh '\n' = "\\n"+    escapeCh '\r' = "\\r"+    escapeCh '\t' = "\\t"+    escapeCh ch | mustEscape ch    = escapeHex $ fromEnum ch+                | otherwise        = singleton $ chToW8 ch+ jsNull = lexeme (JSNull <$ symbol "null") bool   = lexeme $            JSBool True  <$ symbol "true"@@ -187,35 +247,6 @@  objMember :: Parser (ByteString, JSValue) objMember = lexeme ((,) <$> (fromJSString <$> jsString) <*> (symbol ":" *> value))--showJSON :: JSValue -> ByteString-showJSON (JSObject dic) = "{" `append` intercalate "," mems `append` "}"-  where-    mems = elems $ mapWithKey (\k v -> showJSString k `append` ":" `append` showJSON v) dic-showJSON (JSString jss)     = showJSString jss-showJSON (JSNumber jsn) | denominator jsn == 1 = fromLazy $ show $ numerator jsn-                        | otherwise            = fromLazy $ show (fromRational jsn :: Double)-showJSON (JSArray jss)      = "[" `append` intercalate ", " (P.map showJSON jss) `append` "]"-showJSON (JSNull)           = "null"-showJSON (JSBool True)      = "true"-showJSON (JSBool False)     = "false"--showJSString :: ByteString -> ByteString-showJSString js = "\"" `append` escape js `append` "\""-  where-    escape :: ByteString -> ByteString-    escapeCh :: Char -> ByteString-    escape = concat . P.map escapeCh . decode . unpack-    escapeCh '\\' = "\\\\"-    escapeCh '"'  = "\\\""-    escapeCh '\b' = "\\b"-    escapeCh '\f' = "\\f"-    escapeCh '/'  = "\\/"-    escapeCh '\n' = "\\n"-    escapeCh '\r' = "\\r"-    escapeCh '\t' = "\\t"-    escapeCh ch | mustEscape ch    = escapeHex $ fromEnum ch-                | otherwise        = singleton $ chToW8 ch  unfoldrStep :: (a -> Bool) -> (a -> Word8) -> (a -> a) -> a -> Maybe (Word8, a) unfoldrStep p f g a | p a       = Nothing