Show minimal complete definitions in ghci (#10847)

Show the minimal complete definition on :info in ghci. They
are shown like MINIMAL pragmas in code. If the minimal complete
definition is empty or only a specific method from a class is
requested, nothing is shown.

Reviewed By: simonpj, austin, thomie

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

12 files changed, 51 insertions, 3 deletions

diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 6371c43b0e..61ec33e56c 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -53,13 +53,14 @@ import Module
 import SrcLoc
 import Fingerprint
 import Binary
-import BooleanFormula ( BooleanFormula )
+import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
 import HsBinds
 import TyCon ( Role (..), Injectivity(..) )
 import StaticFlags (opt_PprStyle_Debug)
 import Util( filterOut, filterByList )
 import InstEnv
 import DataCon (SrcStrictness(..), SrcUnpackedness(..))
+import Lexeme (isLexSym)
 
 import Control.Monad
 import System.IO.Unsafe
@@ -529,6 +530,15 @@ instance HasOccName IfaceDecl where
 instance Outputable IfaceDecl where
   ppr = pprIfaceDecl showAll
 
+{-
+Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The minimal complete definition should only be included if a complete
+class definition is shown. Since the minimal complete definition is
+anonymous we can't reuse the same mechanism that is used for the
+filtering of method signatures. Instead we just check if anything at all is
+filtered and hide it in that case.
+-}
+
 data ShowSub
   = ShowSub
       { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
@@ -550,6 +560,12 @@ ppShowIface :: ShowSub -> SDoc -> SDoc
 ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
 ppShowIface _                                     _   = Outputable.empty
 
+-- show if all sub-components or the complete interface is shown
+ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
+ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] }) doc = doc
+ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
+ppShowAllSubs _                                      _   = Outputable.empty
+
 ppShowRhs :: ShowSub -> SDoc -> SDoc
 ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
 ppShowRhs _                                      doc = doc
@@ -662,11 +678,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
 pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                             , ifCtxt   = context, ifName  = clas
                             , ifTyVars = tyvars,  ifRoles = roles
-                            , ifFDs    = fds })
+                            , ifFDs    = fds, ifMinDef = minDef })
   = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
          , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
                                 <+> pprFundeps fds <+> pp_where
-         , nest 2 (vcat [vcat asocs, vcat dsigs, pprec])]
+         , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
+                        , ppShowAllSubs ss (pprMinDef minDef)])]
     where
       pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
 
@@ -684,6 +701,13 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
         | showSub ss sg = Just $  pprIfaceClassOp ss sg
         | otherwise     = Nothing
 
+      pprMinDef :: BooleanFormula IfLclName -> SDoc
+      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
+        ptext (sLit "{-# MINIMAL") <+>
+        pprBooleanFormula
+          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
+        ptext (sLit "#-}")
+
 pprIfaceDecl ss (IfaceSynonym { ifName   = tc
                               , ifTyVars = tv
                               , ifSynRhs = mono_ty })
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout
index ac15dcfa1e..1ee81c10d2 100644
--- a/testsuite/tests/driver/sigof01/sigof01i2.stdout
+++ b/testsuite/tests/driver/sigof01/sigof01i2.stdout
@@ -1,5 +1,6 @@
 class Foo a where
   foo :: a -> a
+  {-# MINIMAL foo #-}
 data T = A.T
 mkT :: T
 x :: Bool
diff --git a/testsuite/tests/ghci/prog008/ghci.prog008.stdout b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
index 99e63a1b14..df6767bb84 100644
--- a/testsuite/tests/ghci/prog008/ghci.prog008.stdout
+++ b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
@@ -2,7 +2,9 @@ class C a b where
   c1 :: Num b => a -> b

   c2 :: (Num b, Show b) => a -> b

   c3 :: a1 -> b

+  {-# MINIMAL c1, c2, c3 #-}

 class C a b where

   c1 :: Num b => a -> b

   c2 :: (Num b, Show b) => a -> b

   c3 :: forall a1. a1 -> b

+  {-# MINIMAL c1, c2, c3 #-}
\ No newline at end of file
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
index 7e8b95af80..3ea130d177 100644
--- a/testsuite/tests/ghci/scripts/T9181.stdout
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -7,8 +7,10 @@ type family CmpNat (a :: Nat) (b :: Nat) :: Ordering
 type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering
 class KnownNat (n :: Nat) where
   natSing :: SNat n
+  {-# MINIMAL natSing #-}
 class KnownSymbol (n :: Symbol) where
   symbolSing :: SSymbol n
+  {-# MINIMAL symbolSing #-}
 data SomeNat where
   SomeNat :: KnownNat n => (Proxy n) -> SomeNat
 data SomeSymbol where
diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout
index 9a1bcf7551..eb057ca4bd 100644
--- a/testsuite/tests/ghci/scripts/ghci008.stdout
+++ b/testsuite/tests/ghci/scripts/ghci008.stdout
@@ -27,6 +27,9 @@ class (RealFrac a, Floating a) => RealFloat a where
   isNegativeZero :: a -> Bool

   isIEEE :: a -> Bool

   atan2 :: a -> a -> a

+  {-# MINIMAL floatRadix, floatDigits, floatRange, decodeFloat,

+              encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero,

+              isIEEE #-}

   	-- Defined in ‘GHC.Float’

 instance RealFloat Float -- Defined in ‘GHC.Float’

 instance RealFloat Double -- Defined in ‘GHC.Float’

diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index e5b5bc34b7..fc9bd6e2b1 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -9,6 +9,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b

   c3 :: a1 -> b

   c4 :: a1 -> b

+  {-# MINIMAL c1, c2, c3, c4 #-}

 c1 :: (C a b, N b) => a -> b

 c2 :: (C a b, N b, S b) => a -> b

 c3 :: C a b => forall a. a -> b

@@ -30,6 +31,7 @@ class Applicative m => Monad (m :: * -> *) where
   (>>) :: m a -> m b -> m b

   return :: a -> m a

   fail :: String -> m a

+  {-# MINIMAL (>>=) #-}

 -- imported via Data.Maybe

 catMaybes :: [Maybe a] -> [a]

 fromJust :: Maybe a -> a

@@ -50,6 +52,7 @@ Nothing :: Maybe a
 class Eq a where

   (==) :: a -> a -> Bool

   (/=) :: a -> a -> Bool

+  {-# MINIMAL (==) | (/=) #-}

 -- imported via Prelude, T

 Prelude.length :: Foldable t => forall a. t a -> Int

 -- imported via T

@@ -68,6 +71,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b

   c3 :: a1 -> b

   c4 :: a1 -> b

+  {-# MINIMAL c1, c2, c3, c4 #-}

 c1 :: (C a b, N b) => a -> b

 c2 :: (C a b, N b, S b) => a -> b

 c3 :: C a b => forall a. a -> b

@@ -82,6 +86,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b

   c3 :: forall a1. a1 -> b

   c4 :: forall a1. a1 -> b

+  {-# MINIMAL c1, c2, c3, c4 #-}

 c1 :: forall a b. (C a b, N b) => a -> b

 c2 :: forall a b. (C a b, N b, S b) => a -> b

 c3 :: forall a b. C a b => forall a. a -> b

diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index cffbf700a6..2d2187c5a7 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -7,6 +7,7 @@ TYPE CONSTRUCTORS
     type family Elem c :: * open

     empty :: c

     insert :: Elem c -> c -> c

+    {-# MINIMAL empty, insert #-}

   data ListColl a = L [a]

     Promotable

 COERCION AXIOMS

diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index 4611e867ec..d87054e926 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -87,8 +87,10 @@ RnFail055.hs-boot:28:1: error:
     Main module: class C2 a b where
                    m2 :: a -> b
                    m2' :: a -> b
+                   {-# MINIMAL m2, m2' #-}
     Boot file:   class C2 a b where
                    m2 :: a -> b
+                   {-# MINIMAL m2 #-}
     The methods do not match: There are different numbers of methods
 
 RnFail055.hs-boot:29:1: error:
diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr
index 230603cf09..bb61133ce0 100644
--- a/testsuite/tests/roles/should_compile/Roles14.stderr
+++ b/testsuite/tests/roles/should_compile/Roles14.stderr
@@ -3,6 +3,7 @@ TYPE CONSTRUCTORS
   type role C2 representational
   class C2 a where
     meth2 :: a -> a
+    {-# MINIMAL meth2 #-}
 COERCION AXIOMS
   axiom Roles12.NTCo:C2 :: C2 a = a -> a
 Dependent modules: []
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index 93cafc0c94..6f25b63691 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -2,13 +2,17 @@ TYPE SIGNATURES
 TYPE CONSTRUCTORS
   class C1 a where
     meth1 :: a -> a
+    {-# MINIMAL meth1 #-}
   class C2 a b where
     meth2 :: a ~ b => a -> b
+    {-# MINIMAL meth2 #-}
   class C3 a b where
     type family F3 b :: * open
     meth3 :: a -> F3 b -> F3 b
+    {-# MINIMAL meth3 #-}
   class C4 a b where
     meth4 :: a -> F4 b -> F4 b
+    {-# MINIMAL meth4 #-}
   type family F4 a :: * open
   type Syn1 a = F4 a
   type Syn2 a = [a]
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
index 109a2bb96f..0113869e42 100644
--- a/testsuite/tests/roles/should_compile/Roles4.stderr
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -2,8 +2,10 @@ TYPE SIGNATURES
 TYPE CONSTRUCTORS
   class C1 a where
     meth1 :: a -> a
+    {-# MINIMAL meth1 #-}
   class C3 a where
     meth3 :: a -> Syn1 a
+    {-# MINIMAL meth3 #-}
   type Syn1 a = [a]
 COERCION AXIOMS
   axiom Roles4.NTCo:C1 :: C1 a = a -> a
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index fb011c66c5..5503eaf295 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -11,6 +11,7 @@ TYPE CONSTRUCTORS
     Promotable
   class Zork s a b | a -> b where
     huh :: Q s a chain -> ST s ()
+    {-# MINIMAL huh #-}
 COERCION AXIOMS
   axiom NTCo:Zork ::
       Zork s a b = forall chain. Q s a chain -> ST s ()