RJson 0.2 → 0.3

raw patch · 2 files changed

+71/−92 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• RJson.cabal +1/−1
• Text/RJson.hs +70/−91

@@ -1,5 +1,5 @@ Name:          RJson-Version:       0.2+Version:       0.3 Cabal-Version: >= 1.2 License:       BSD3 License-File:  LICENSE

@@ -1,4 +1,11 @@-{-# OPTIONS_GHC -XFlexibleInstances -XOverlappingInstances -XMultiParamTypeClasses -XFlexibleContexts -XUndecidableInstances -XTemplateHaskell #-}+{-# OPTIONS_GHC+    -XFlexibleInstances+    -XOverlappingInstances+    -XMultiParamTypeClasses+    -XFlexibleContexts+    -XUndecidableInstances+    -XTemplateHaskell+    -cpp #-}  module Text.RJson (TranslateField,                    TranslateFieldD,@@ -134,7 +141,7 @@ stripInitialUnderscores ('_':s) = stripInitialUnderscores s stripInitialUnderscores s       = s -instance (Data TranslateFieldD a) => TranslateField a where+instance Typeable a => TranslateField a where     translateField _ x = stripInitialUnderscores x  @@ -143,7 +150,7 @@ -- -- | New instances can be added to this class to customize --   JSON serialization.-class ToJson a where+class TranslateField a => ToJson a where     toJson :: a -> JsonData      -- For lists (same trick used by the Prelude to allow special@@ -186,7 +193,7 @@ -- Again, note inclusion of translateField from TranslateField, -- and TranslateField qualification on variable 't' (in addition -- to the expected ToJson qualification).-instance (TranslateField t, ToJson t) => Sat (ToJsonD t) where+instance ToJson t => Sat (ToJsonD t) where     dict = ToJsonD { toJsonD          = toJson,                      excludeD         = exclude,                      arrayPrependD    = arrayPrepend,@@ -209,26 +216,31 @@ --    toJson i = JDNumber (floatToDouble i) instance ToJson Double where     toJson i = JDNumber i-instance Integral a => ToJson (Ratio a) where+instance (Integral a, TranslateField a, Typeable a) => ToJson (Ratio a) where     toJson i = JDNumber $ (fromIntegral (numerator i)) / (fromIntegral (denominator i))                          instance ToJson Char where     lToJson s = JDString s     toJson c = JDString [c] -instance ToJson a => ToJson (M.Map String a) where+instance (ToJson a, TranslateField a, Data TranslateFieldD (M.Map String a))+         => ToJson (M.Map String a) where     toJson x = JDObject (M.map toJson x) -instance (Typeable a, ToJson a) => ToJson [a] where+instance (ToJson a, TranslateField a, Typeable a) => ToJson [a] where     toJson = lToJson  -- TODO: Add instances for the other array types supported by GHC.-instance (Typeable a, ToJson a, Ix i) => ToJson (Array i a) where+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. 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+                   -- of Data that this creates (if we didn't, we could always+                   -- instantiate Typeable manually for Union). -- | Nested Unions are left-branching by convention (since this is what you get --   by using the constructor as an infix operator). type Union3 a b c = (Union (Union a b) c)@@ -245,7 +257,7 @@ isJDObject _            = False jdObjectMap (JDObject m) = m -instance (ToJson a, ToJson b) => ToJson (Union a b) where+instance (ToJson a, ToJson b, TranslateField a, TranslateField b, Typeable a, Typeable b, Typeable2 Union) => ToJson (Union a b) where     toJson (Union x y) =         let jx = toJson x             jy = toJson y@@ -273,45 +285,39 @@         | True =             error ("Unable to serialize the primitive type '" ++ typename x ++ "'") +enumToJson :: (Data ToJsonD a, ToJson a, TranslateField a) => a -> JsonData+enumToJson x+    | isAlgType (dataTypeOf toJsonProxy x) = JDString (show (toConstr toJsonProxy x))+    | True = error "Passed non-algebraic type to enumToJson"+ instance (Data ToJsonD t, TranslateField t) => ToJson t where     toJson = genericToJson --- Instances for tuples up to n=10.+-- Instances for tuples up to n=7 (this limit it is set by the non-existence of Typeable8). -- Tuples are converted to (hetrogenous) JSON lists.-instance (ToJson a, ToJson b) => ToJson (a, b) where+#define I(x) ToJson x, Typeable x+instance (I(a), I(b)) => ToJson (a, b) where     toJson (a,b) = JDArray [toJson a, toJson b]-instance (ToJson a, ToJson b, ToJson c) => ToJson (a,b,c) where+instance (I(a), I(b), I(c)) => ToJson (a,b,c) where     toJson (a,b,c) = JDArray [toJson a, toJson b, toJson c]-instance (ToJson a, ToJson b, ToJson c, ToJson d) => ToJson (a,b,c,d) where+instance (I(a), I(b), I(c), I(d)) => ToJson (a,b,c,d) where     toJson (a,b,c,d) = JDArray [toJson a, toJson b, toJson c, toJson d]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e) => ToJson (a,b,c,d,e) where+instance (I(a), I(b), I(c), I(d), I(e)) => ToJson (a,b,c,d,e) where     toJson (a,b,c,d,e) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e, ToJson f) =>+instance (I(a), I(b), I(c), I(d), I(e), I(f)) =>          ToJson (a,b,c,d,e,f) where     toJson (a,b,c,d,e,f) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e,                                    toJson f]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e, ToJson f, ToJson g) =>+instance (I(a), I(b), I(c), I(d), I(e), I(f), I(g)) =>          ToJson (a,b,c,d,e,f,g) where     toJson (a,b,c,d,e,f,g) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e,                                      toJson f, toJson g]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e, ToJson f, ToJson g, ToJson h) =>-         ToJson (a,b,c,d,e,f,g,h) where-    toJson (a,b,c,d,e,f,g,h) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e,-                                       toJson f, toJson g, toJson h]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e, ToJson f, ToJson g, ToJson h, ToJson i) =>-         ToJson (a,b,c,d,e,f,g,h,i) where-    toJson (a,b,c,d,e,f,g,h,i) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e,-                                         toJson f, toJson g, toJson h, toJson i]-instance (ToJson a, ToJson b, ToJson c, ToJson d, ToJson e, ToJson f, ToJson g, ToJson h, ToJson i, ToJson j) =>-         ToJson (a,b,c,d,e,f,g,h,i,j) where-    toJson (a,b,c,d,e,f,g,h,i,j) = JDArray [toJson a, toJson b, toJson c, toJson d, toJson e,-                                           toJson f, toJson g, toJson h, toJson i, toJson j]-+#undef I  -- -- FromJson ---class FromJson a where+class TranslateField a => FromJson a where     fromJson :: a -> JsonData -> Either String a      -- For lists (same trick used by the Prelude to allow special@@ -332,7 +338,7 @@ fromJsonProxy :: Proxy FromJsonD fromJsonProxy = error "'fromJsonProxy' should never be evaluated!" -instance (FromJson t, TranslateField t) => Sat (FromJsonD t) where+instance FromJson t => Sat (FromJsonD t) where     dict = FromJsonD { fromJsonD = fromJson,                        objectDefaultsD = objectDefaults,                        translateFieldD'' = translateField }@@ -344,7 +350,7 @@     lFromJson _ (JDString s) = Right s     lFromJson _ _            = Left "Bad fromJson conversion: Non-string to 'String'" -instance FromJson a => FromJson [a] where+instance (FromJson a, TranslateField a, Typeable a) => FromJson [a] where     fromJson _ x = lFromJson undefined x  instance FromJson Int where@@ -365,7 +371,7 @@     fromJson _ (JDNumber d) = Right d     fromJson _ _            = Left "Bad fromJson conversion: Non-numeric to 'Double'" -instance Integral a => FromJson (Ratio a) where+instance (Typeable a, Integral a) => FromJson (Ratio a) where     fromJson _ (JDNumber i) = Right (fromRational (toRational i))     fromJson _ _            = Left "Bad fromJson conversion: Non-numeric to instance of 'Ratio'" @@ -379,7 +385,7 @@ -- 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?).-instance (FromJson a, FromJson b) => FromJson (Union a b) where+instance (FromJson a, FromJson b, Typeable a, Typeable b, TranslateField a, TranslateField b) => FromJson (Union a b) where     fromJson _ o@(JDObject _) =         let r1 = fromJson undefined o             r2 = fromJson undefined o@@ -392,20 +398,21 @@ tuperror :: Int -> Either String a tuperror n = Left $ Printf.printf "Bad fromJson conversion: attempt to convert something that was not a list of length %i to a %i-tuple" n n -instance (FromJson a, FromJson b) => FromJson (a,b) where+#define I(x) FromJson x, Typeable x, TranslateField x+instance (I(a), I(b)) => FromJson (a,b) where     fromJson _ (JDArray [x1,x2]) = do       r1 <- fromJson undefined x1       r2 <- fromJson undefined x2       return (r1,r2)     fromJson _ _ = tuperror 2-instance (FromJson a, FromJson b, FromJson c) => FromJson (a,b,c) where+instance (I(a), I(b), I(c)) => FromJson (a,b,c) where     fromJson _ (JDArray [x1,x2,x3]) = do       r1 <- fromJson undefined x1       r2 <- fromJson undefined x2       r3 <- fromJson undefined x3       return (r1,r2,r3)     fromJson _ _ = tuperror 3-instance (FromJson a, FromJson b, FromJson c, FromJson d) => FromJson(a,b,c,d) where+instance (I(a), I(b), I(c), I(d)) => FromJson(a,b,c,d) where     fromJson _ (JDArray [x1,x2,x3,x4]) = do       r1 <- fromJson undefined x1       r2 <- fromJson undefined x2@@ -413,7 +420,7 @@       r4 <- fromJson undefined x4       return (r1,r2,r3,r4)     fromJson _ _ = tuperror 4-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e) => FromJson (a,b,c,d,e) where+instance (I(a), I(b), I(c), I(d), I(e)) => FromJson (a,b,c,d,e) where     fromJson _ (JDArray [x1,x2,x3,x4,x5]) = do       r1 <- fromJson undefined x1       r2 <- fromJson undefined x2@@ -422,7 +429,7 @@       r5 <- fromJson undefined x5       return (r1,r2,r3,r4,r5)     fromJson _ _ = tuperror 5-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e, FromJson f) =>+instance (I(a), I(b), I(c), I(d), I(e), I(f)) =>          FromJson (a,b,c,d,e,f) where     fromJson _ (JDArray [x1,x2,x3,x4,x5,x6]) = do       r1 <- fromJson undefined x1@@ -433,7 +440,7 @@       r6 <- fromJson undefined x6       return (r1,r2,r3,r4,r5,r6)     fromJson _ _ = tuperror 6-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e, FromJson f, FromJson g) =>+instance (I(a), I(b), I(c), I(d), I(e), I(f), I(g)) =>          FromJson (a,b,c,d,e,f,g) where     fromJson _ (JDArray [x1,x2,x3,x4,x5,x6,x7]) = do       r1 <- fromJson undefined x1@@ -445,48 +452,7 @@       r7 <- fromJson undefined x7       return (r1,r2,r3,r4,r5,r6,r7)     fromJson _ _ = tuperror 7-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e, FromJson f, FromJson g, FromJson h) =>-         FromJson (a,b,c,d,e,f,g,h) where-    fromJson _ (JDArray [x1,x2,x3,x4,x5,x6,x7,x8]) = do-      r1 <- fromJson undefined x1-      r2 <- fromJson undefined x2-      r3 <- fromJson undefined x3-      r4 <- fromJson undefined x4-      r5 <- fromJson undefined x5-      r6 <- fromJson undefined x6-      r7 <- fromJson undefined x7-      r8 <- fromJson undefined x8-      return (r1,r2,r3,r4,r5,r6,r7,r8)-    fromJson _ _ = tuperror 8-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e, FromJson f, FromJson g, FromJson h, FromJson i) =>-         FromJson (a,b,c,d,e,f,g,h,i) where-    fromJson _ (JDArray [x1,x2,x3,x4,x5,x6,x7,x8,x9]) = do-      r1 <- fromJson undefined x1-      r2 <- fromJson undefined x2-      r3 <- fromJson undefined x3-      r4 <- fromJson undefined x4-      r5 <- fromJson undefined x5-      r6 <- fromJson undefined x6-      r7 <- fromJson undefined x7-      r8 <- fromJson undefined x8-      r9 <- fromJson undefined x9-      return (r1,r2,r3,r4,r5,r6,r7,r8,r9)-    fromJson _ _ = tuperror 9-instance (FromJson a, FromJson b, FromJson c, FromJson d, FromJson e, FromJson f, FromJson g, FromJson h, FromJson i, FromJson j) =>-         FromJson (a,b,c,d,e,f,g,h,i,j) where-    fromJson _ (JDArray [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10]) = do-      r1 <- fromJson undefined x1-      r2 <- fromJson undefined x2-      r3 <- fromJson undefined x3-      r4 <- fromJson undefined x4-      r5 <- fromJson undefined x5-      r6 <- fromJson undefined x6-      r7 <- fromJson undefined x7-      r8 <- fromJson undefined x8-      r9 <- fromJson undefined x9-      r10 <- fromJson undefined x10-      return (r1,r2,r3,r4,r5,r6,r7,r8,r9,r10)-    fromJson _ _ = tuperror 10+#undef I  elemsOfMap :: Ord k => M.Map k v -> [k] -> Maybe [v] elemsOfMap _ [] = Just []@@ -498,14 +464,14 @@ type ErrorWithState e s a = ErrorT e (State s) a  -- TODO: Not a very descriptive name. Oh well...-m1 :: (Data FromJsonD a) => a -> ErrorWithState String [JsonData] a-m1 dummy = do+m1 :: (Data FromJsonD a) => ErrorWithState String [JsonData] a+m1 = do   jvl <- lift get   (case jvl of      []       -> throwError "Bad fromJson conversion: Not enough elements in JSON array to satisfy constructor"      (jv:jvs) -> do        lift $ put jvs-       (case fromJsonD dict dummy jv of+       (case fromJsonD dict (undefined :: a) jv of           Left e  -> throwError e           Right x -> return x)) @@ -522,7 +488,7 @@        (case M.lookup stripped m of           Nothing ->             case M.lookup stripped defaults of-              Nothing -> throwError $  "Bad fromJson conversion: Required field not present in JSON object" ++ stripped+              Nothing -> throwError $  "Bad fromJson conversion: Required field not present in JSON object: "               Just v  ->                 case fromJsonD dict dummy v of                   Left e  -> throwError e@@ -536,18 +502,28 @@ genericFromJson dummy (JDArray l) =     case datarep (dataTypeOf fromJsonProxy dummy) of       AlgRep (c:_) ->-          evalState (runErrorT (gmapM fromJsonProxy m1 (fromConstr fromJsonProxy c))) (tail l)+          evalState (runErrorT (fromConstrM fromJsonProxy m1 c)) (tail l)       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"+            [] -> Left $ "Bad fromJson conversion: Attempt to convert JDObect to a non-record algebraic type"+            -- 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.             fs -> evalState (runErrorT (gmapM fromJsonProxy (m2 (objectDefaultsD 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 _ _ = Left "Bad fromJson conversion: Expecting JSON object or array"++enumFromJson :: (Data FromJsonD a, Data TranslateFieldD a) => a -> JsonData -> Either String a+enumFromJson dummy (JDString s) =+    case fromConstrM fromJsonProxy Nothing (mkConstr (dataTypeOf fromJsonProxy dummy) s [] Prefix ) of+      Nothing -> Left "Error in enumFromJson"+      Just x -> Right x+enumFromJson _ _ = Left "Non-string given to enumFromJson"            instance (Data FromJsonD t, Data TranslateFieldD t) => FromJson t where     fromJson = genericFromJson@@ -748,10 +724,13 @@ toJsonString :: ToJson a => a -> String toJsonString = show . toJson +{- data Test = Foo | Bar deriving Show $(derive[''Test]) data Test2 = Test2 Int Int deriving Show $(derive[''Test2])--trans :: (Data FromJsonD a) => a -> Int-trans _ = 7+data Test4 = Test4 { z :: String } deriving Show+$(derive[''Test4])+data Test3 = Test3 { x :: Int, y :: Test4} deriving Show+$(derive[''Test3])+-}