diff --git a/README b/README --- a/README +++ b/README @@ -1,8 +1,9 @@ ************************************************************************ -* RJSon 0.3.5 * +* RJSon 0.3.6 * * Author: Alex Drummond * * * -* Thanks to Dustin DeWeese for a patch fixing a bug in the parser. * +* Thanks to Dustin DeWeese and Audrey Tang for patches fixing bugs in * +* the parser. * * Thanks to Adam Langley for a patch fixing the lack of support for * * null JSON values. * ************************************************************************ diff --git a/RJson.cabal b/RJson.cabal --- a/RJson.cabal +++ b/RJson.cabal @@ -1,5 +1,5 @@ Name: RJson -Version: 0.3.5 +Version: 0.3.6 Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE diff --git a/Text/RJson.hs b/Text/RJson.hs --- a/Text/RJson.hs +++ b/Text/RJson.hs @@ -60,11 +60,11 @@ -- | A Haskell representation of a JSON -- data structure. -data JsonData = JDString String | - JDNumber Double | - JDArray [JsonData] | - JDBool Bool | - JDNull | +data JsonData = JDString String | + JDNumber Double | + JDArray [JsonData] | + JDBool Bool | + JDNull | JDObject (M.Map String JsonData) listJoin :: a -> [a] -> [a] @@ -129,9 +129,9 @@ -- TranslateField class. -- class TranslateField a where - -- | By default, Haskell record field names are converted into - -- JSON object field names by stripping any initial underscores. - -- Specialize this method to define a different behavior. + -- | This method defines the mapping from Haskell record field names + -- to JSON object field names. The default is to strip any initial + -- underscores. Specialize this method to define a different behavior. translateField :: a -> String -> String data TranslateFieldD a = TranslateFieldD { translateFieldD :: a -> String -> String } @@ -154,8 +154,8 @@ -- -- ToJson class plus SYB boilerplate. -- --- | New instances can be added to this class to customize --- JSON serialization. +-- | New instances can be added to this class to customize certain aspects +-- of the way in which Haskell types are serialized to JSON. class TranslateField a => ToJson a where toJson :: a -> JsonData @@ -164,9 +164,10 @@ lToJson :: [a] -> JsonData lToJson l = JDArray (map toJson l) - -- | You can specialize this method to prevent fields from being serialized. - -- The method should return a list of the Haskell names of the fields to - -- be excluded. + -- | Applies to record types only. You can specialize this method to + -- prevent certain fields from being serialized. + -- Given a Haskell field name, it should return True if that field is + -- to be serialized, and False otherwise. exclude :: a -> String -> Bool exclude _ _ = False @@ -242,8 +243,11 @@ instance (ToJson a, TranslateField a, Typeable a, Typeable i, Ix i) => ToJson (Array i a) where toJson a = toJson (elems a) --- | Use this for merging two or more records together. --- Sensible instances of FromJson and ToJson are already defined for this type. +-- | This type can be used for merging two or more records together into a single +-- JSON object. By default, a structure such as (Union X Y) is serialized as follows. +-- First, X and Y are serialized, and a runtime error is signalled if the result of +-- serialization is not a JSON object in both cases. The key/value pairs of the +-- two JSON objects are then merged to form a single object. data Union a b = Union a b deriving Show $(derive[''Union]) -- In order to derive (Typeable2 Union). -- It seems that we get away with overwriting the instance @@ -279,22 +283,30 @@ typename x = dataTypeName (dataTypeOf toJsonProxy x) --- | This is the implementation of 'toJson' for the generic instance declaration, --- but it's useful to be able to use the same implentation for --- other instance declarations which override the default implementation --- of 'exclude'. +-- | This function is used as the the implementation of 'toJson' for the +-- generic instance declaration. +-- It's useful to be able to use the same implentation for +-- other instance declarations which override the default implementations +-- of other methods of the ToJson class. genericToJson :: (Data ToJsonD a, ToJson a, TranslateField a) => a -> JsonData genericToJson x - | isAlgType (dataTypeOf toJsonProxy x) = - case (map (translateFieldD' dict x) (filter (not . (excludeD dict x)) (getFields x))) of - [] -> case gmapQ toJsonProxy (toJsonD dict) x of - l -> JDArray $ (arrayPrependD dict x) ++ l ++ (arrayAppendD dict x) - fs -> JDObject (M.fromList (objectExtrasD dict x ++ (zip fs (gmapQ toJsonProxy (toJsonD dict) x)))) - | True = - error ("Unable to serialize the primitive type '" ++ typename x ++ "'") + | isAlgType (dataTypeOf toJsonProxy x) = + case getFields x of + [] -> + case gmapQ toJsonProxy (toJsonD dict) x of + [v] -> v -- Special default behavior for algebraic constructors with one field. + vs -> JDArray $ (arrayPrependD dict x) ++ vs ++ (arrayAppendD dict x) + fs -> + let + translatedFsToInclude = + map (translateFieldD' dict x) (filter (not . (excludeD dict x)) (getFields x)) + in + JDObject $ M.fromList (objectExtrasD dict x ++ (zip translatedFsToInclude (gmapQ toJsonProxy (toJsonD dict) x))) + | True = + error $ "Unable to serialize the primitive type '" ++ typename x ++ "'" -- | This function can be used as an implementation of 'toJson' for simple enums. --- It just converts an enum value to a string determined by the name of the constructor, +-- It converts an enum value to a string determined by the name of the constructor, -- after being fed through the (String -> String) function given as the first argument. enumToJson :: (Data ToJsonD a, ToJson a, TranslateField a) => (String -> String) -> a -> JsonData enumToJson transform x @@ -336,7 +348,7 @@ lFromJson :: a -> JsonData -> Either String [a] lFromJson dummy (JDArray l) = mapM (fromJson dummy) l - -- | In order to specify default values for required fields of a JSON object, + -- | To specify default values for the required fields of a JSON object, -- specialize this method in the instance definition for the relevant -- datatype. objectDefaults :: a -> M.Map String JsonData @@ -517,6 +529,18 @@ Left e -> throwError e Right x -> return x)) +-- TODO: Another uninformative name. +m3 :: (Data FromJsonD a, TranslateField a) => JsonData -> a -> ErrorWithState String Int a +m3 jsondata dummy = do + s <- get + if s > 0 + then throwError "Bad fromJson conversion: Expecting JSON object or array; did not attempt automatic boxing because constructor takes more than one argument." + else do + put (s + 1) + case fromJsonD dict dummy jsondata of + Left e -> throwError e + Right x -> return x + genericFromJson :: (Data FromJsonD a, FromJson a, TranslateField a) => a -> JsonData -> Either String a genericFromJson dummy (JDArray l) = case datarep (dataTypeOf fromJsonProxy dummy) of @@ -529,12 +553,17 @@ AlgRep (c:_) -> case constrFields c of [] -> Left $ "Bad fromJson conversion: Attempt to convert JDObect to a non-record algebraic type" + -- TODO: -- Can't use fromConstrM because we need to get dummy values of the -- appropriate type for each argument of the constructor. This is unfortunate, - -- since it means that we get runtime errors for records with strict fields. + -- becuase it means that we get runtime errors for records with strict fields. fs -> evalState (runErrorT (gmapM fromJsonProxy (m2 (objectDefaultsD dict dummy) (translateFieldD'' dict dummy)) (fromConstr fromJsonProxy c))) (m, fs) AlgRep _ -> Left "Bad fromJson conversion: Type with no constructors!" _ -> Left "Bad fromJson conversion: Non-algebraic datatype given to 'genericFromJson'" +genericFromJson dummy jsondata = + case datarep (dataTypeOf fromJsonProxy dummy) of + AlgRep [c] -> evalState (runErrorT (gmapM fromJsonProxy (m3 jsondata) (fromConstr fromJsonProxy c))) 0 + AlgRep _ -> Left "Bad fromJson conversion: Expecting JSON object or array; did not attempt automatic boxing because type has more than one constructor." genericFromJson _ _ = Left "Bad fromJson conversion: Expecting JSON object or array" constrNames :: (Data FromJsonD a, Data TranslateFieldD a) => a -> [String] @@ -695,11 +724,17 @@ v <- jsonValue return (s, v) +lexeme :: P.Parser a -> P.Parser a +lexeme p = do + r <- p + ws + return r + jsonArray :: P.Parser JsonData jsonArray = do P.char '[' ws - vs <- P.sepBy jsonValue (ws >> P.char ',' >> ws) + vs <- P.sepBy (lexeme jsonValue) (P.char ',' >> ws) ws P.char ']' return $ JDArray vs @@ -708,7 +743,7 @@ object = do P.char '{' ws - kvps <- P.sepBy kvp (ws >> P.char ',' >> ws) + kvps <- P.sepBy (lexeme kvp) (P.char ',' >> ws) ws P.char '}' return $ JDObject $ M.fromList kvps @@ -756,11 +791,12 @@ -- -- A couple of utility functions. -- +-- | Converts the first character of a string to upper case. firstCharToUpper :: String -> String firstCharToUpper "" = "" firstCharToUpper (c:cs) = (toUpper c) : cs +-- | Converts the first character of a string to lower case. firstCharToLower :: String -> String firstCharToLower "" = "" firstCharToLower (c:cs) = (toLower c) : cs -