Show minimal complete definitions in ghci (#10847)
authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org>
Thu, 17 Sep 2015 14:02:06 +0000 (16:02 +0200)
committerThomas Miedema <thomasmiedema@gmail.com>
Thu, 17 Sep 2015 14:02:18 +0000 (16:02 +0200)
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:
compiler/iface/IfaceSyn.hs
testsuite/tests/driver/sigof01/sigof01i2.stdout
testsuite/tests/ghci/prog008/ghci.prog008.stdout
testsuite/tests/ghci/scripts/T9181.stdout
testsuite/tests/ghci/scripts/ghci008.stdout
testsuite/tests/ghci/scripts/ghci025.stdout
testsuite/tests/indexed-types/should_compile/T3017.stderr
testsuite/tests/rename/should_fail/rnfail055.stderr
testsuite/tests/roles/should_compile/Roles14.stderr
testsuite/tests/roles/should_compile/Roles3.stderr
testsuite/tests/roles/should_compile/Roles4.stderr
testsuite/tests/typecheck/should_compile/tc231.stderr

index 6371c43..61ec33e 100644 (file)
@@ -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 })
index ac15dcf..1ee81c1 100644 (file)
@@ -1,5 +1,6 @@
 class Foo a where
   foo :: a -> a
+  {-# MINIMAL foo #-}
 data T = A.T
 mkT :: T
 x :: Bool
index 99e63a1..df6767b 100644 (file)
@@ -2,7 +2,9 @@ class C a b where
   c1 :: Num b => a -> b\r
   c2 :: (Num b, Show b) => a -> b\r
   c3 :: a1 -> b\r
+  {-# MINIMAL c1, c2, c3 #-}\r
 class C a b where\r
   c1 :: Num b => a -> b\r
   c2 :: (Num b, Show b) => a -> b\r
   c3 :: forall a1. a1 -> b\r
+  {-# MINIMAL c1, c2, c3 #-}
\ No newline at end of file
index 7e8b95a..3ea130d 100644 (file)
@@ -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
index 9a1bcf7..eb057ca 100644 (file)
@@ -27,6 +27,9 @@ class (RealFrac a, Floating a) => RealFloat a where
   isNegativeZero :: a -> Bool\r
   isIEEE :: a -> Bool\r
   atan2 :: a -> a -> a\r
+  {-# MINIMAL floatRadix, floatDigits, floatRange, decodeFloat,\r
+              encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero,\r
+              isIEEE #-}\r
        -- Defined in ‘GHC.Float’\r
 instance RealFloat Float -- Defined in ‘GHC.Float’\r
 instance RealFloat Double -- Defined in ‘GHC.Float’\r
index e5b5bc3..fc9bd6e 100644 (file)
@@ -9,6 +9,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b\r
   c3 :: a1 -> b\r
   c4 :: a1 -> b\r
+  {-# MINIMAL c1, c2, c3, c4 #-}\r
 c1 :: (C a b, N b) => a -> b\r
 c2 :: (C a b, N b, S b) => a -> b\r
 c3 :: C a b => forall a. a -> b\r
@@ -30,6 +31,7 @@ class Applicative m => Monad (m :: * -> *) where
   (>>) :: m a -> m b -> m b\r
   return :: a -> m a\r
   fail :: String -> m a\r
+  {-# MINIMAL (>>=) #-}\r
 -- imported via Data.Maybe\r
 catMaybes :: [Maybe a] -> [a]\r
 fromJust :: Maybe a -> a\r
@@ -50,6 +52,7 @@ Nothing :: Maybe a
 class Eq a where\r
   (==) :: a -> a -> Bool\r
   (/=) :: a -> a -> Bool\r
+  {-# MINIMAL (==) | (/=) #-}\r
 -- imported via Prelude, T\r
 Prelude.length :: Foldable t => forall a. t a -> Int\r
 -- imported via T\r
@@ -68,6 +71,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b\r
   c3 :: a1 -> b\r
   c4 :: a1 -> b\r
+  {-# MINIMAL c1, c2, c3, c4 #-}\r
 c1 :: (C a b, N b) => a -> b\r
 c2 :: (C a b, N b, S b) => a -> b\r
 c3 :: C a b => forall a. a -> b\r
@@ -82,6 +86,7 @@ class C a b where
   c2 :: (N b, S b) => a -> b\r
   c3 :: forall a1. a1 -> b\r
   c4 :: forall a1. a1 -> b\r
+  {-# MINIMAL c1, c2, c3, c4 #-}\r
 c1 :: forall a b. (C a b, N b) => a -> b\r
 c2 :: forall a b. (C a b, N b, S b) => a -> b\r
 c3 :: forall a b. C a b => forall a. a -> b\r
index cffbf70..2d2187c 100644 (file)
@@ -7,6 +7,7 @@ TYPE CONSTRUCTORS
     type family Elem c :: * open\r
     empty :: c\r
     insert :: Elem c -> c -> c\r
+    {-# MINIMAL empty, insert #-}\r
   data ListColl a = L [a]\r
     Promotable\r
 COERCION AXIOMS\r
index 4611e86..d87054e 100644 (file)
@@ -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:
index 230603c..bb61133 100644 (file)
@@ -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: []
index 93cafc0..6f25b63 100644 (file)
@@ -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]
index 109a2bb..0113869 100644 (file)
@@ -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
index fb011c6..5503eaf 100644 (file)
@@ -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 ()