basvandijk avatar basvandijk committed 9646c6b

Grouped the GToJSON instances and grouped the GFromJSON instances
This makes the code easier to follow.

Comments (0)

Files changed (1)

Data/Aeson/Types/Internal.hs

 
 #ifdef GENERICS
 --------------------------------------------------------------------------------
--- Generic toJSON and fromJSON
+-- Generic toJSON
 
 class GToJSON f where
     gToJSON :: f a -> Value
 
-class GFromJSON f where
-    gParseJSON :: Value -> Parser (f a)
-
---------------------------------------------------------------------------------
-
 instance (GToJSON a) => GToJSON (M1 i c a) where
     gToJSON = gToJSON . unM1
 
-instance (GFromJSON a) => GFromJSON (M1 i c a) where
-    gParseJSON = fmap M1 . gParseJSON
-
---------------------------------------------------------------------------------
-
 instance (ToJSON a) => GToJSON (K1 i a) where
     gToJSON = toJSON . unK1
 
-instance (FromJSON a) => GFromJSON (K1 i a) where
-    gParseJSON = fmap K1 . parseJSON
-
---------------------------------------------------------------------------------
-
 instance GToJSON U1 where
     gToJSON _ = emptyArray
 
-instance GFromJSON U1 where
-    gParseJSON v
-        | isEmptyArray v = pure U1
-        | otherwise      = typeMismatch "unary constructor (U1)" v
-
---------------------------------------------------------------------------------
-
 instance (ConsToJSON a) => GToJSON (C1 c a) where
     gToJSON = consToJSON . unM1
 
-instance (ConsFromJSON a) => GFromJSON (C1 c a) where
-    gParseJSON = fmap M1 . consParseJSON
-
---------------------------------------------------------------------------------
-
 instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
     gToJSON = toJSON . toList . gProductToValues
 
-instance (GFromProduct a, GFromProduct b) => GFromJSON (a :*: b) where
-    gParseJSON (Array arr) = gParseProduct arr
-    gParseJSON v = typeMismatch "product (:*:)" v
-
---------------------------------------------------------------------------------
-
 instance (GObject a, GObject b) => GToJSON (a :+: b) where
     gToJSON (L1 x) = Object $ gObject x
     gToJSON (R1 x) = Object $ gObject x
 
-instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
-    gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
-    gParseJSON v = typeMismatch "sum (:+:)" v
-
 --------------------------------------------------------------------------------
 
 class ConsToJSON    f where consToJSON  ::           f a -> Value
 
 --------------------------------------------------------------------------------
 
-class ConsFromJSON    f where consParseJSON  ::           Value -> Parser (f a)
-class ConsFromJSON' b f where consParseJSON' :: Tagged b (Value -> Parser (f a))
-
-instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
-    consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
-
-instance (GFromRecord f) => ConsFromJSON' True f where
-    consParseJSON' = Tagged parseRecord
-        where
-          parseRecord (Object obj) = gParseRecord obj
-          parseRecord v = typeMismatch "record (:*:)" v
-
-instance (GFromJSON f) => ConsFromJSON' False f where
-    consParseJSON' = Tagged gParseJSON
-
---------------------------------------------------------------------------------
-
-newtype Tagged s b = Tagged {unTagged :: b}
-
-data True
-data False
-
-class IsRecord (f :: * -> *) b | f -> b
-
-instance (IsRecord f b) => IsRecord (f :*: g) b
-instance IsRecord (M1 S NoSelector f) False
-instance (IsRecord f b) => IsRecord (M1 S c f) b
-instance IsRecord (K1 i c) True
-instance IsRecord U1 False
-
---------------------------------------------------------------------------------
-
-class GFromRecord f where
-    gParseRecord :: Object -> Parser (f a)
-
-instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
-    gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
-
-instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
-    gParseRecord obj = case M.lookup (T.pack key) obj of
-                         Nothing -> notFound key
-                         Just v  -> gParseJSON v
-        where
-          key = selName (undefined :: t s a p)
-
---------------------------------------------------------------------------------
-
 class GRecordToObject f where
     gRecordToObject :: f a -> Object
 
 
 --------------------------------------------------------------------------------
 
+class GObject f where
+    gObject :: f a -> Object
+
+instance (GObject a, GObject b) => GObject (a :+: b) where
+    gObject (L1 x) = gObject x
+    gObject (R1 x) = gObject x
+
+instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where
+    gObject m1 = M.singleton (pack (conName m1)) (gToJSON m1)
+
+--------------------------------------------------------------------------------
+-- Generic parseJSON
+
+class GFromJSON f where
+    gParseJSON :: Value -> Parser (f a)
+
+instance (GFromJSON a) => GFromJSON (M1 i c a) where
+    gParseJSON = fmap M1 . gParseJSON
+
+instance (FromJSON a) => GFromJSON (K1 i a) where
+    gParseJSON = fmap K1 . parseJSON
+
+instance GFromJSON U1 where
+    gParseJSON v
+        | isEmptyArray v = pure U1
+        | otherwise      = typeMismatch "unit constructor (U1)" v
+
+instance (ConsFromJSON a) => GFromJSON (C1 c a) where
+    gParseJSON = fmap M1 . consParseJSON
+
+instance (GFromProduct a, GFromProduct b) => GFromJSON (a :*: b) where
+    gParseJSON (Array arr) = gParseProduct arr
+    gParseJSON v = typeMismatch "product (:*:)" v
+
+instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
+    gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
+    gParseJSON v = typeMismatch "sum (:+:)" v
+
+--------------------------------------------------------------------------------
+
+class ConsFromJSON    f where consParseJSON  ::           Value -> Parser (f a)
+class ConsFromJSON' b f where consParseJSON' :: Tagged b (Value -> Parser (f a))
+
+instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
+    consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
+
+instance (GFromRecord f) => ConsFromJSON' True f where
+    consParseJSON' = Tagged parseRecord
+        where
+          parseRecord (Object obj) = gParseRecord obj
+          parseRecord v = typeMismatch "record (:*:)" v
+
+instance (GFromJSON f) => ConsFromJSON' False f where
+    consParseJSON' = Tagged gParseJSON
+
+--------------------------------------------------------------------------------
+
+class GFromRecord f where
+    gParseRecord :: Object -> Parser (f a)
+
+instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
+    gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
+
+instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
+    gParseRecord obj = case M.lookup (T.pack key) obj of
+                         Nothing -> notFound key
+                         Just v  -> gParseJSON v
+        where
+          key = selName (undefined :: t s a p)
+
+--------------------------------------------------------------------------------
+
 class GFromProduct f where
     gParseProduct :: Array -> Parser (f a)
 
 
 --------------------------------------------------------------------------------
 
-class GObject f where
-    gObject :: f a -> Object
-
-instance (GObject a, GObject b) => GObject (a :+: b) where
-    gObject (L1 x) = gObject x
-    gObject (R1 x) = gObject x
-
-instance (Constructor c, GToJSON a, ConsToJSON a)
-    => GObject (C1 c a) where
-    gObject m1 = M.singleton (pack (conName m1)) (gToJSON m1)
-
---------------------------------------------------------------------------------
-
 class GFromSum f where
     gParseSum :: Pair -> Parser (f a)
 
 
 --------------------------------------------------------------------------------
 
+newtype Tagged s b = Tagged {unTagged :: b}
+
+data True
+data False
+
+class IsRecord (f :: * -> *) b | f -> b
+
+instance (IsRecord f b) => IsRecord (f :*: g) b
+instance IsRecord (M1 S NoSelector f) False
+instance (IsRecord f b) => IsRecord (M1 S c f) b
+instance IsRecord (K1 i c) True
+instance IsRecord U1 False
+
+--------------------------------------------------------------------------------
+
 type DList a = [a] -> [a]
 
 toList :: DList a -> [a]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.