base: Add missing instances for Data.Ord.Down

Specifically:

 * MonadFix
 * MonadZip
 * Data
 * Foldable
 * Traversable
 * Eq1
 * Ord1
 * Read1
 * Show1
 * Generic
 * Generic1

Fixes #15098.

Reviewers: RyanGlScott, hvr

Reviewed By: RyanGlScott

Subscribers: sjakobi, rwbarton, thomie, ekmett, carter

GHC Trac Issues: #15098

Differential Revision: https://phabricator.haskell.org/D4870

libraries/base/Control/Monad/Fix.hs

@@ -29,6 +29,7 @@ import Data.Function ( fix )
 import Data.Maybe
 import Data.Monoid ( Dual(..), Sum(..), Product(..)
                    , First(..), Last(..), Alt(..), Ap(..) )
+import Data.Ord ( Down(..) )
 import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) )
 import GHC.Generics
 import GHC.List ( head, tail )
@@ -149,3 +150,10 @@ instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where
       where
         fstP (a :*: _) = a
         sndP (_ :*: b) = b
+
+-- Instances for Data.Ord
+
+-- | @since 4.12.0.0
+instance MonadFix Down where
+    mfix f = Down (fix (getDown . f))
+      where getDown (Down x) = x

libraries/base/Control/Monad/Zip.hs

@@ -21,6 +21,7 @@ module Control.Monad.Zip where
 import Control.Monad (liftM, liftM2)
 import Data.Functor.Identity
 import Data.Monoid
+import Data.Ord ( Down(..) )
 import Data.Proxy
 import qualified Data.List.NonEmpty as NE
 import GHC.Generics
@@ -124,3 +125,9 @@ instance MonadZip f => MonadZip (M1 i c f) where
 -- | @since 4.9.0.0
 instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where
     mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2
+
+-- instances for Data.Ord
+
+-- | @since 4.12.0.0
+instance MonadZip Down where
+    mzipWith = liftM2

libraries/base/Data/Data.hs

@@ -1334,3 +1334,9 @@ deriving instance Data SourceStrictness
 
 -- | @since 4.9.0.0
 deriving instance Data DecidedStrictness
+
+----------------------------------------------------------------------------
+-- Data instances for Data.Ord
+
+-- | @since 4.12.0.0
+deriving instance Data a => Data (Down a)

libraries/base/Data/Foldable.hs

@@ -505,6 +505,10 @@ deriving instance Foldable UInt
 -- | @since 4.9.0.0
 deriving instance Foldable UWord
 
+-- Instances for Data.Ord
+-- | @since 4.12.0.0
+deriving instance Foldable Down
+
 -- | Monadic fold over the elements of a structure,
 -- associating to the right, i.e. from right to left.
 foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b

libraries/base/Data/Functor/Classes.hs

@@ -70,6 +70,7 @@ import Data.Functor.Identity (Identity(Identity))
 import Data.Proxy (Proxy(Proxy))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Monoid (mappend)
+import Data.Ord (Down(Down))
 
 import GHC.Read (expectP, list, paren)
 
@@ -644,6 +645,24 @@ instance Read1 Proxy where
   liftReadListPrec = liftReadListPrecDefault
   liftReadList     = liftReadListDefault
 
+-- | @since 4.12.0.0
+instance Eq1 Down where
+    liftEq eq (Down x) (Down y) = eq x y
+
+-- | @since 4.12.0.0
+instance Ord1 Down where
+    liftCompare comp (Down x) (Down y) = comp x y
+
+-- | @since 4.12.0.0
+instance Read1 Down where
+    liftReadsPrec rp _ = readsData $
+         readsUnaryWith rp "Down" Down
+
+-- | @since 4.12.0.0
+instance Show1 Down where
+    liftShowsPrec sp _ d (Down x) = showsUnaryWith sp "Down" d x
+
+
 -- Building blocks
 
 -- | @'readsData' p d@ is a parser for datatypes where each alternative

libraries/base/Data/Traversable.hs

@@ -62,6 +62,7 @@ import Data.Functor.Identity ( Identity(..) )
 import Data.Functor.Utils ( StateL(..), StateR(..) )
 import Data.Monoid ( Dual(..), Sum(..), Product(..),
                      First(..), Last(..), Alt(..), Ap(..) )
+import Data.Ord ( Down(..) )
 import Data.Proxy ( Proxy(..) )
 
 import GHC.Arr
@@ -360,6 +361,10 @@ deriving instance Traversable UInt
 -- | @since 4.9.0.0
 deriving instance Traversable UWord
 
+-- Instance for Data.Ord
+-- | @since 4.12.0.0
+deriving instance Traversable Down
+
 -- general functions
 
 -- | 'for' is 'traverse' with its arguments flipped. For a version

libraries/base/GHC/Generics.hs

@@ -731,6 +731,7 @@ module GHC.Generics  (
 -- We use some base types
 import Data.Either ( Either (..) )
 import Data.Maybe  ( Maybe(..), fromMaybe )
+import Data.Ord    ( Down(..) )
 import GHC.Integer ( Integer, integerToInt )
 import GHC.Prim    ( Addr#, Char#, Double#, Float#, Int#, Word# )
 import GHC.Ptr     ( Ptr )
@@ -1435,6 +1436,9 @@ deriving instance Generic ((,,,,,) a b c d e f)
 -- | @since 4.6.0.0
 deriving instance Generic ((,,,,,,) a b c d e f g)
 
+-- | @since 4.12.0.0
+deriving instance Generic (Down a)
+
 
 -- | @since 4.6.0.0
 deriving instance Generic1 []
@@ -1469,6 +1473,9 @@ deriving instance Generic1 ((,,,,,) a b c d e)
 -- | @since 4.6.0.0
 deriving instance Generic1 ((,,,,,,) a b c d e f)
 
+-- | @since 4.12.0.0
+deriving instance Generic1 Down
+
 --------------------------------------------------------------------------------
 -- Copied from the singletons package
 --------------------------------------------------------------------------------

libraries/base/changelog.md

@@ -37,6 +37,11 @@
 
   * `Control.Exception.throw` is now levity polymorphic. (#15180)
 
+  * `Data.Ord.Down` now has a number of new instances. These include:
+    `MonadFix`, `MonadZip`, `Data`, `Foldable`, `Traversable`, `Eq1`, `Ord1`,
+    `Read1`, `Show1`, `Generic`, `Generic1`. (#15098)
+
+
 ## 4.11.1.0 *TBA*
   * Bundled with GHC 8.4.2
 

testsuite/tests/annotations/should_fail/annfail10.stderr

@@ -10,7 +10,7 @@ annfail10.hs:9:1: error:
         instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
         instance Data.Data.Data Integer -- Defined in ‘Data.Data’
         ...plus 15 others
-        ...plus 46 instances involving out-of-scope types
+        ...plus 47 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the annotation: {-# ANN f 1 #-}
 
@@ -23,6 +23,6 @@ annfail10.hs:9:11: error:
         instance Num Double -- Defined in ‘GHC.Float’
         instance Num Float -- Defined in ‘GHC.Float’
         ...plus two others
-        ...plus 18 instances involving out-of-scope types
+        ...plus 19 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the annotation: {-# ANN f 1 #-}

testsuite/tests/ghci/scripts/T10963.stderr

@@ -8,5 +8,5 @@
       instance Num Double -- Defined in ‘GHC.Float’
       instance Num Float -- Defined in ‘GHC.Float’
       ...plus two others
-      ...plus 7 instances involving out-of-scope types
+      ...plus 8 instances involving out-of-scope types
       (use -fprint-potential-instances to see them all)

testsuite/tests/polykinds/T13393.stderr

@@ -8,7 +8,7 @@ T13393.hs:61:3: error:
         instance Traversable Identity -- Defined in ‘Data.Traversable’
         instance Traversable Maybe -- Defined in ‘Data.Traversable’
         ...plus two others
-        ...plus 27 instances involving out-of-scope types
+        ...plus 28 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In a stmt of a 'do' block:
         mapM putBackLeftOverInputAndReturnOutput undefined

testsuite/tests/typecheck/should_compile/T14273.stderr

@@ -12,7 +12,7 @@ T14273.hs:7:27: warning: [-Wdeferred-type-errors (in -Wdefault)]
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 69 instances involving out-of-scope types
+        ...plus 70 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the first argument of ‘Just’, namely ‘(show _a)’
       In the expression: Just (show _a)
@@ -65,7 +65,7 @@ T14273.hs:13:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 69 instances involving out-of-scope types
+        ...plus 70 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: show (_h ++ [])
       In an equation for ‘foo’: foo xs = show (_h ++ [])

testsuite/tests/typecheck/should_compile/holes2.stderr

@@ -9,7 +9,7 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 69 instances involving out-of-scope types
+        ...plus 70 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: show _
       In an equation for ‘f’: f = show _

testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr

@@ -98,7 +98,7 @@ valid_hole_fits.hs:30:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 69 instances involving out-of-scope types
+        ...plus 70 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: show _
       In an equation for ‘f’: f = show _
@@ -148,7 +148,7 @@ valid_hole_fits.hs:34:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 69 instances involving out-of-scope types
+        ...plus 70 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: show (_ (_ :: Bool))
       In an equation for ‘h’: h = show (_ (_ :: Bool))

testsuite/tests/typecheck/should_fail/T10971b.stderr

@@ -11,7 +11,7 @@ T10971b.hs:4:11: error:
         instance Foldable Maybe -- Defined in ‘Data.Foldable’
         instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
         ...plus one other
-        ...plus 28 instances involving out-of-scope types
+        ...plus 29 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: length x
       In the expression: \ x -> length x
@@ -29,7 +29,7 @@ T10971b.hs:5:13: error:
         instance Traversable Maybe -- Defined in ‘Data.Traversable’
         instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
         ...plus one other
-        ...plus 28 instances involving out-of-scope types
+        ...plus 29 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: fmapDefault f x
       In the expression: \ f x -> fmapDefault f x
@@ -47,7 +47,7 @@ T10971b.hs:6:14: error:
         instance Traversable Maybe -- Defined in ‘Data.Traversable’
         instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
         ...plus one other
-        ...plus 28 instances involving out-of-scope types
+        ...plus 29 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: fmapDefault f x
       In the expression: (fmapDefault f x, length x)
@@ -65,7 +65,7 @@ T10971b.hs:6:31: error:
         instance Foldable Maybe -- Defined in ‘Data.Foldable’
         instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
         ...plus one other
-        ...plus 28 instances involving out-of-scope types
+        ...plus 29 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: length x
       In the expression: (fmapDefault f x, length x)

testsuite/tests/typecheck/should_fail/T12921.stderr

@@ -10,7 +10,7 @@ T12921.hs:4:1: error:
         instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
         instance Data.Data.Data Integer -- Defined in ‘Data.Data’
         ...plus 15 others
-        ...plus 46 instances involving out-of-scope types
+        ...plus 47 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the annotation:
         {-# ANN module "HLint: ignore Reduce duplication" #-}

testsuite/tests/typecheck/should_fail/T14884.stderr

@@ -42,7 +42,7 @@ T14884.hs:4:7: error:
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         ...plus 23 others
-        ...plus 66 instances involving out-of-scope types
+        ...plus 67 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the first argument of ‘_’, namely ‘print’
       In the expression: _ print "abc"