diff --git a/README b/README --- a/README +++ b/README @@ -1,11 +1,13 @@ ************************************************************************ -* RJSon 0.3.6 * -* Author: Alex Drummond * -* * -* 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. * +| RJSon 0.3.7 | +| Author: Alex Drummond | +| | +| 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. | +| Thanks to Maarten for fixing an inconsistency in the behavior of | +| serialization/parsing. | ************************************************************************ This is some documentation on how to use the RJson library. I wrote a @@ -105,11 +107,12 @@ The JsonData type has the following definition: - data JsonData = JDString String | - JDNumber Double | - JDArray [JsonData] | - JDBool Bool | - JDObject (Data.Map.Map String JsonData) + data JsonData = JDString String | + JDNumber Double | + JDArray [JsonData] | + JDBool Bool | + JDNull | + JDObject (M.Map String JsonData) You can implement custom serialization and deserialization behavior by adding instances to the ToJson and FromJson classes respectively. diff --git a/RJson.cabal b/RJson.cabal --- a/RJson.cabal +++ b/RJson.cabal @@ -1,5 +1,5 @@ Name: RJson -Version: 0.3.6 +Version: 0.3.7 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 @@ -34,7 +34,8 @@ firstCharToUpper, firstCharToLower, Union(..), Union3, Union4, Union5, Union6, - Union7,Union8,Union9,Union10) + Union7,Union8,Union9,Union10, + cond) where import Data.Generics.SYB.WithClass.Basics @@ -410,9 +411,6 @@ fromJson _ (JDBool b) = Right b fromJson _ _ = Left "Bad fromJson conversion: Non-boolean to 'Bool'" -isRight (Right _) = True -isRight _ = False -fromRight (Right x) = x -- TODO: Use monads instead of 'ifs' if possible (funky type errors -- which I haven't figured out yet, something to do with monomorphism -- in let bindings vs. lambda abstraction?). @@ -541,31 +539,45 @@ 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 - AlgRep (c:_) -> - evalState (runErrorT (fromConstrM fromJsonProxy m1 c)) (tail l) + AlgRep ccs@(c:cs) -> evalArrayConstr ccs + where + evalArrayConstr = tryHead err . dropWhile isLeft . map es + es :: (Data FromJsonD a, FromJson a) => Constr -> Either String a + es c = evalState (runErrorT (fromConstrM fromJsonProxy m1 c)) (tryTail l) + tryTail = cond null (const []) tail + tryHead def = cond null (const def) head + err = Left "Bad fromJson conversion: Type with no constructors!" AlgRep _ -> Left "Bad fromJson conversion: Type with no constructors!" _ -> Left "Bad fromJson conversion: Non-algebraic datatype given to 'genericFromJson'" genericFromJson dummy (JDObject m) = case datarep (dataTypeOf fromJsonProxy dummy) of - 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, - -- 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'" + AlgRep cs@(_:_) -> evalConstrs dummy m cs + _ -> 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" +evalConstrs :: (Data FromJsonD a, FromJson a) => a -> M.Map String JsonData -> [Constr] -> Either [Char] a +evalConstrs dummy m = tryHead err . dropWhile isLeft . map (evalConstr dummy m) + where + tryHead def = cond null (const def) head + err = Left "Bad fromJson conversion: Type with no constructors!" + +evalConstr :: (Data FromJsonD a, FromJson a) => a -> M.Map String JsonData -> Constr -> Either [Char] a +evalConstr dummy m 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, + -- 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) + constrNames :: (Data FromJsonD a, Data TranslateFieldD a) => a -> [String] constrNames x = map showConstr (dataTypeConstrs (dataTypeOf fromJsonProxy x)) @@ -800,3 +812,20 @@ firstCharToLower :: String -> String firstCharToLower "" = "" firstCharToLower (c:cs) = (toLower c) : cs + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft _ = False + +isRight :: Either a b -> Bool +isRight (Right _) = True +isRight _ = False + +fromLeft :: Either a b -> a +fromLeft (Left x) = x +fromRight :: Either a b -> b +fromRight (Right x) = x + +cond :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b +cond p th el a = if p a then th a else el a +