json 0.3.3 → 0.3.6
raw patch · 5 files changed
+100/−48 lines, 5 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.JSON: instance MonadPlus Result
+ Text.JSON: makeObj :: [(String, JSValue)] -> JSValue
+ Text.JSON: valFromObj :: (JSON a) => String -> JSObject JSValue -> Result a
+ Text.JSON.Types: get_field :: JSObject a -> String -> Maybe a
+ Text.JSON.Types: instance Typeable JSString
+ Text.JSON.Types: instance Typeable JSValue
+ Text.JSON.Types: instance Typeable1 JSObject
+ Text.JSON.Types: set_field :: JSObject a -> String -> a -> JSObject a
Files
- Text/JSON.hs +36/−6
- Text/JSON/Pretty.hs +1/−1
- Text/JSON/String.hs +44/−30
- Text/JSON/Types.hs +17/−9
- json.cabal +2/−2
Text/JSON.hs view
@@ -46,6 +46,8 @@ , showJSNull, showJSBool, showJSRational, showJSArray , showJSObject, showJSValue + -- ** Instance helpers+ , makeObj, valFromObj ) where @@ -57,7 +59,7 @@ import Data.Int import Data.Word import Data.Either-import Control.Monad(liftM,ap)+import Control.Monad(liftM,ap,MonadPlus(..)) import Control.Applicative import qualified Data.ByteString.Char8 as S@@ -133,11 +135,15 @@ pure = return instance Alternative Result where- Ok a <|> _ = Ok a- _ <|> Ok b = Ok b- err <|> _ = err+ Ok a <|> _ = Ok a+ Error _ <|> b = b empty = Error "empty" +instance MonadPlus Result where+ Ok a `mplus` _ = Ok a+ _ `mplus` x = x+ mzero = Error "Result: MonadPlus.empty"+ instance Monad Result where return x = Ok x fail x = Error x@@ -348,8 +354,20 @@ readJSON = readJSONs instance (Ord a, JSON a, JSON b) => JSON (M.Map a b) where- showJSON = showJSON . M.toList- readJSON a@(JSArray _) = M.fromList <$> readJSON a+-- the previous version: showJSON = showJSON . M.toList+ showJSON m = JSObject $ toJSObject $ + map (\ (x,y) -> (showJSValue (showJSON x) "", showJSON y)) (M.toList m)++ readJSON (JSObject o) = + mapM rd (fromJSObject o) >>= return . M.fromList+ where+ rd (a,b) = do+ f <- decode a+ g <- readJSON b+ return (f,g)++ -- backwards compatibility..+ readJSON a@(JSArray _) = M.fromList <$> readJSON a readJSON _ = mkError "Unable to read Map" instance JSON I.IntSet where@@ -369,3 +387,15 @@ showJSON = JSString . toJSString . L.unpack readJSON (JSString s) = return $ L.pack $ fromJSString s readJSON _ = mkError "Unable to read ByteString"++-- -----------------------------------------------------------------+-- Instance Helpers++makeObj :: [(String, JSValue)] -> JSValue+makeObj = JSObject . toJSObject++-- | Pull a value out of a JSON object.+valFromObj :: JSON a => String -> JSObject JSValue -> Result a+valFromObj k o = maybe (Error $ "valFromObj: Could not find key: " ++ show k)+ readJSON+ (lookup k (fromJSObject o))
Text/JSON/Pretty.hs view
@@ -48,7 +48,7 @@ pp_string x = doubleQuotes $ hcat $ map pp_char x where pp_char '\\' = text "\\\\" pp_char '"' = text "\\\""- pp_char c | isControl c = uni_esc c+ pp_char c | isControl c || fromEnum c >= 0x7f = uni_esc c pp_char c = char c uni_esc c = text "\\u" <> text (pad 4 (showHex (fromEnum c) ""))
Text/JSON/String.hs view
@@ -32,14 +32,15 @@ ) where -import Text.JSON.Types+import Text.JSON.Types (JSValue(..),+ JSString, toJSString, fromJSString,+ JSObject, toJSObject, fromJSObject) -import Data.Char-import Data.List-import Data.Ratio-import Data.Either-import Control.Monad(liftM)-import Numeric+import Control.Monad (liftM)+import Data.Char (isSpace, isDigit)+import Data.List (isPrefixOf)+import Data.Ratio (numerator, denominator, (%))+import Numeric (readHex, readDec, showHex) -- -----------------------------------------------------------------@@ -288,24 +289,9 @@ -- | Write the JSON String type showJSString :: JSString -> ShowS-showJSString x = quote . foldr (.) quote (map sh (fromJSString x))+showJSString x xs = quote (encJSString x (quote xs)) where quote = showChar '"'- sh c = case c of- '"' -> showString "\\\""- '\\' -> showString "\\\\"- '\n' -> showString "\\n"- '\r' -> showString "\\r"- '\t' -> showString "\\t"- '\f' -> showString "\\f"- '\b' -> showString "\\b"- _ | n < 32 -> showString "\\u"- . showHex d1 . showHex d2 . showHex d3 . showHex d4- _ -> showChar c- where n = fromEnum c- (d1,n1) = n `divMod` 0x1000- (d2,n2) = n1 `divMod` 0x0100- (d3,d4) = n2 `divMod` 0x0010 -- | Show a Rational in JSON format showJSRational :: Rational -> ShowS@@ -325,14 +311,42 @@ -- | Show a generic sequence of pairs in JSON format showAssocs :: Char -> Char -> Char -> [(String,JSValue)] -> ShowS-showAssocs start end sep xs rest = (start:[])- ++ concat (intersperse (sep:[]) $ map mkRecord xs)- ++ (end:[]) ++ rest- where mkRecord (k,v) = show k ++ ":" ++ showJSValue v []+showAssocs start end sep xs rest = start : go xs+ where+ go [(k,v)] = '"' : encJSString (toJSString k)+ ('"' : ':' : showJSValue v (go []))+ go ((k,v):kvs) = '"' : encJSString (toJSString k)+ ('"' : ':' : showJSValue v (sep : go kvs))+ go [] = end : rest -- | Show a generic sequence in JSON format showSequence :: Char -> Char -> Char -> [JSValue] -> ShowS-showSequence start end sep xs rest = (start:[])- ++ concat (intersperse (sep:[]) $ map (flip showJSValue []) xs)- ++ (end:[]) ++ rest+showSequence start end sep xs rest = start : go xs+ where+ go [y] = showJSValue y (go [])+ go (y:ys) = showJSValue y (sep : go ys)+ go [] = end : rest++encJSString :: JSString -> ShowS+encJSString jss ss = go (fromJSString jss)+ where+ go s1 =+ case s1 of+ (x :xs) | x < '\x20' -> '\\' : encControl x (go xs)+ ('"' :xs) -> '\\' : '"' : go xs+ ('\\':xs) -> '\\' : '\\' : go xs+ (x :xs) -> x : go xs+ "" -> ss++ encControl x xs = case x of+ '\b' -> 'b' : xs+ '\f' -> 'f' : xs+ '\n' -> 'n' : xs+ '\r' -> 'r' : xs+ '\t' -> 't' : xs+ _ | x < '\x10' -> 'u' : '0' : '0' : '0' : hexxs+ | x < '\x100' -> 'u' : '0' : '0' : hexxs+ | x < '\x1000' -> 'u' : '0' : hexxs+ | otherwise -> 'u' : hexxs+ where hexxs = showHex (fromEnum x) xs
Text/JSON/Types.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} -------------------------------------------------------------------- -- | -- Module : Text.JSON.Types@@ -19,18 +20,18 @@ JSValue(..) -- * Wrapper Types- , JSString(..)+ , JSString({-fromJSString-}..) , toJSString- , fromJSString - , JSObject(..)+ , JSObject({-fromJSObject-}..) , toJSObject- , fromJSObject + , get_field+ , set_field+ ) where -import Data.Char-import Data.Ratio+import Data.Typeable ( Typeable ) -- -- | JSON values@@ -60,22 +61,29 @@ | JSString JSString | JSArray [JSValue] | JSObject (JSObject JSValue)- deriving (Show, Read, Eq, Ord)+ deriving (Show, Read, Eq, Ord, Typeable) -- | Strings can be represented a little more efficiently in JSON newtype JSString = JSONString { fromJSString :: String }- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Typeable) -- | Turn a Haskell string into a JSON string. toJSString :: String -> JSString toJSString = JSONString+ -- Note: we don't encode the string yet, that's done when serializing. -- | As can association lists newtype JSObject e = JSONObject { fromJSObject :: [(String, e)] }- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Typeable) -- | Make JSON object out of an association list. toJSObject :: [(String,a)] -> JSObject a toJSObject = JSONObject +-- | Get the value of a field, if it exist.+get_field :: JSObject a -> String -> Maybe a+get_field (JSONObject xs) x = lookup x xs +-- | Set the value of a field. Previous values are overwritten.+set_field :: JSObject a -> String -> a -> JSObject a+set_field (JSONObject xs) k v = JSONObject ((k,v) : filter ((/= k).fst) xs)
json.cabal view
@@ -1,5 +1,5 @@ name: json-version: 0.3.3+version: 0.3.6 synopsis: Support for serialising Haskell to and from JSON description: JSON (JavaScript Object Notation) is a lightweight data-interchange@@ -14,7 +14,7 @@ license: BSD3 license-file: LICENSE author: Galois Inc.-maintainer: dons@galois.com+maintainer: Sigbjorn Finne <sof@galois.com> Copyright: (c) 2007-2008 Galois Inc. cabal-version: >= 1.2.0 build-type: Simple