Merge pull request #1044 from haskell/issue-983-down

Resolve #983. Add instances for Data.Ord.Down

Author: phadej

changelog.md

@@ -33,6 +33,7 @@ For the latest version of this document, please see [https://github.com/haskell/
 * Drop instances for `Number` from `attoparsec` package.
 * Improve `Arbitrary Value` instance.
 * Add instances for `URI` from `network-uri`.
+* add instances for `Down` from `Data.Ord`.
 
 ### 2.1.2.1
 

src/Data/Aeson/Types/FromJSON.hs

@@ -101,6 +101,7 @@ import Data.Functor.Sum (Sum(..))
 import Data.Functor.These (These1 (..))
 import Data.Hashable (Hashable(..))
 import Data.List.NonEmpty (NonEmpty(..))
+import Data.Ord (Down (..))
 import Data.Ratio ((%), Ratio)
 import Data.Scientific (base10Exponent)
 import Data.Tagged (Tagged(..))
@@ -2307,6 +2308,20 @@ instance FromJSON Month where
 instance FromJSONKey Month where
     fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseMonth)
 
+-------------------------------------------------------------------------------
+-- base Down
+-------------------------------------------------------------------------------
+
+-- | @since 2.2.0.0
+instance FromJSON1 Down where
+    liftParseJSON _ p _ = coerce p
+
+    liftOmittedField = coerce
+
+-- | @since 2.2.0.0
+instance FromJSON a => FromJSON (Down a) where
+    parseJSON = parseJSON1
+
 -------------------------------------------------------------------------------
 -- base Monoid/Semigroup
 -------------------------------------------------------------------------------

src/Data/Aeson/Types/ToJSON.hs

@@ -79,6 +79,7 @@ import Data.Functor.These (These1 (..))
 import Data.List (intersperse)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (isNothing)
+import Data.Ord (Down (..))
 import Data.Ratio (Ratio, denominator, numerator)
 import Data.Tagged (Tagged(..))
 import Data.These (These (..))
@@ -2069,6 +2070,20 @@ toEncodingQuarterOfYear Q4 = E.unsafeToEncoding "\"q4\""
 instance ToJSONKey QuarterOfYear where
     toJSONKey = toJSONKeyTextEnc toEncodingQuarterOfYear
 
+-------------------------------------------------------------------------------
+-- base Down
+-------------------------------------------------------------------------------
+
+instance ToJSON1 Down where
+    liftToJSON _ t _ = coerce t
+    liftToEncoding _ t _ = coerce t
+    liftOmitField = coerce
+
+instance ToJSON a => ToJSON (Down a) where
+    toJSON = toJSON1
+    toEncoding = toEncoding1
+    omitField = omitField1
+
 -------------------------------------------------------------------------------
 -- base Monoid/Semigroup
 -------------------------------------------------------------------------------