Add some changes to support GHC-9.2 / base-4.16 (removal of Option)

haskell · May 20, 2021 · ae04b00 · ae04b00
1 parent 725153e
commit ae04b00
Show file tree

Hide file tree

Showing 3 changed files with 24 additions and 2 deletions.
diff --git a/src/Data/Aeson/TH.hs b/src/Data/Aeson/TH.hs
@@ -150,7 +150,9 @@ import qualified Data.Foldable as F (all)
 import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)
 import qualified Data.List.NonEmpty as NE (length, reverse)
 import qualified Data.Map as M (fromList, keys, lookup , singleton, size)
+#if !MIN_VERSION_base(4,16,0)
 import qualified Data.Semigroup as Semigroup (Option(..))
+#endif
 import qualified Data.Set as Set (empty, insert, member)
 import qualified Data.Text as T (Text, pack, unpack)
 import qualified Data.Vector as V (unsafeIndex, null, length, create, empty)
@@ -475,8 +477,13 @@ argsToValue target jc tvMap opts multiCons
             restFields = mconcatE (map pureToPair rest)
 
             (maybes0, rest0) = partition isMaybe argCons
+#if MIN_VERSION_base(4,16,0)
+            maybes = maybes0
+            rest   = rest0
+#else
             (options, rest) = partition isOption rest0
             maybes = maybes0 ++ map optionToMaybe options
+#endif
 
             maybeToPair = toPairLifted True
             pureToPair = toPairLifted False
@@ -518,12 +525,14 @@ isMaybe :: (a, Type, b) -> Bool
 isMaybe (_, AppT (ConT t) _, _) = t == ''Maybe
 isMaybe _                       = False
 
+#if !MIN_VERSION_base(4,16,0)
 isOption :: (a, Type, b) -> Bool
 isOption (_, AppT (ConT t) _, _) = t == ''Semigroup.Option
 isOption _                       = False
 
 optionToMaybe :: (ExpQ, b, c) -> (ExpQ, b, c)
 optionToMaybe (a, b, c) = ([|Semigroup.getOption|] `appE` a, b, c)
+#endif
 
 (<^>) :: ExpQ -> ExpQ -> ExpQ
 (<^>) a b = infixApp a [|(E.><)|] b
@@ -1129,11 +1138,13 @@ instance OVERLAPPABLE_ LookupField a where
 
 instance INCOHERENT_ LookupField (Maybe a) where
     lookupField pj _ _ = parseOptionalFieldWith pj
-
+
+#if !MIN_VERSION_base(4,16,0)
 instance INCOHERENT_ LookupField (Semigroup.Option a) where
     lookupField pj tName rec obj key =
         fmap Semigroup.Option
              (lookupField (fmap Semigroup.getOption . pj) tName rec obj key)
+#endif
 
 lookupFieldWith :: (Value -> Parser a) -> String -> String
                 -> Object -> T.Text -> Parser a

diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs
@@ -1324,13 +1324,16 @@ instance INCOHERENT_ (Selector s, FromJSON a) =>
         label = fieldLabelModifier opts sname
         sname = selName (undefined :: M1 _i s _f _p)
 
+#if !MIN_VERSION_base(4,16,0)
 -- Parse an Option like a Maybe.
 instance INCOHERENT_ (Selector s, FromJSON a) =>
          RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where
     recordParseJSON' p obj = wrap <$> recordParseJSON' p obj
       where
         wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
         wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
+    {-# INLINE recordParseJSON' #-}
+#endif
 
 --------------------------------------------------------------------------------
 
@@ -2256,14 +2259,18 @@ instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where
     parseJSONList = liftParseJSONList parseJSON parseJSONList
     {-# INLINE parseJSONList #-}
 
-
+#if !MIN_VERSION_base(4,16,0)
 instance FromJSON1 Semigroup.Option where
     liftParseJSON p p' = fmap Semigroup.Option . liftParseJSON p p'
     {-# INLINE liftParseJSON #-}
 
 instance FromJSON a => FromJSON (Semigroup.Option a) where
     parseJSON = parseJSON1
+<<<<<<< HEAD
     {-# INLINE parseJSON #-}
+=======
+#endif
+>>>>>>> 996aa15 (Add some changes to support GHC-9.2 / base-4.16 (removal of Option))
 
 -------------------------------------------------------------------------------
 -- data-fix

diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs
@@ -1102,6 +1102,7 @@ instance INCOHERENT_
     recordToPairs opts targs m1 = fieldToPair opts targs m1
     {-# INLINE recordToPairs #-}
 
+#if !MIN_VERSION_base(4,16,0)
 instance INCOHERENT_
     ( Selector s
     , GToJSON' enc arity (K1 i (Maybe a))
@@ -1114,6 +1115,7 @@ instance INCOHERENT_
         unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
         unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
     {-# INLINE recordToPairs #-}
+#endif
 
 fieldToPair :: (Selector s
                , GToJSON' enc arity a
@@ -2272,6 +2274,7 @@ instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
     {-# INLINE toEncoding #-}
 
 
+#if !MIN_VERSION_base(4,16,0)
 instance ToJSON1 Semigroup.Option where
     liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
     {-# INLINE liftToJSON #-}
@@ -2285,6 +2288,7 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
 
     toEncoding = toEncoding1
     {-# INLINE toEncoding #-}
+#endif
 
 -------------------------------------------------------------------------------
 -- data-fix