Commit 43eb1dc5 authored by Moritz Kiefer's avatar Moritz Kiefer Committed by thomie

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
parent 8d89d80d
...@@ -53,13 +53,14 @@ import Module ...@@ -53,13 +53,14 @@ import Module
import SrcLoc import SrcLoc
import Fingerprint import Fingerprint
import Binary import Binary
import BooleanFormula ( BooleanFormula ) import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import HsBinds import HsBinds
import TyCon ( Role (..), Injectivity(..) ) import TyCon ( Role (..), Injectivity(..) )
import StaticFlags (opt_PprStyle_Debug) import StaticFlags (opt_PprStyle_Debug)
import Util( filterOut, filterByList ) import Util( filterOut, filterByList )
import InstEnv import InstEnv
import DataCon (SrcStrictness(..), SrcUnpackedness(..)) import DataCon (SrcStrictness(..), SrcUnpackedness(..))
import Lexeme (isLexSym)
import Control.Monad import Control.Monad
import System.IO.Unsafe import System.IO.Unsafe
...@@ -529,6 +530,15 @@ instance HasOccName IfaceDecl where ...@@ -529,6 +530,15 @@ instance HasOccName IfaceDecl where
instance Outputable IfaceDecl where instance Outputable IfaceDecl where
ppr = pprIfaceDecl showAll 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 data ShowSub
= ShowSub = ShowSub
{ ss_ppr_bndr :: OccName -> SDoc -- Pretty-printer for binders in IfaceDecl { ss_ppr_bndr :: OccName -> SDoc -- Pretty-printer for binders in IfaceDecl
...@@ -550,6 +560,12 @@ ppShowIface :: ShowSub -> SDoc -> SDoc ...@@ -550,6 +560,12 @@ ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
ppShowIface _ _ = Outputable.empty 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 -> SDoc -> SDoc
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = Outputable.empty ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = Outputable.empty
ppShowRhs _ doc = doc ppShowRhs _ doc = doc
...@@ -662,11 +678,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, ...@@ -662,11 +678,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
, ifCtxt = context, ifName = clas , ifCtxt = context, ifName = clas
, ifTyVars = tyvars, ifRoles = roles , ifTyVars = tyvars, ifRoles = roles
, ifFDs = fds }) , ifFDs = fds, ifMinDef = minDef })
= vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
, ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
<+> pprFundeps fds <+> pp_where <+> 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 where
pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "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 ...@@ -684,6 +701,13 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
| showSub ss sg = Just $ pprIfaceClassOp ss sg | showSub ss sg = Just $ pprIfaceClassOp ss sg
| otherwise = Nothing | 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 pprIfaceDecl ss (IfaceSynonym { ifName = tc
, ifTyVars = tv , ifTyVars = tv
, ifSynRhs = mono_ty }) , ifSynRhs = mono_ty })
......
class Foo a where class Foo a where
foo :: a -> a foo :: a -> a
{-# MINIMAL foo #-}
data T = A.T data T = A.T
mkT :: T mkT :: T
x :: Bool x :: Bool
......
...@@ -2,7 +2,9 @@ class C a b where ...@@ -2,7 +2,9 @@ class C a b where
c1 :: Num b => a -> b c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b c2 :: (Num b, Show b) => a -> b
c3 :: a1 -> b c3 :: a1 -> b
{-# MINIMAL c1, c2, c3 #-}
class C a b where class C a b where
c1 :: Num b => a -> b c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b c2 :: (Num b, Show b) => a -> b
c3 :: forall a1. a1 -> b c3 :: forall a1. a1 -> b
{-# MINIMAL c1, c2, c3 #-}
\ No newline at end of file
...@@ -7,8 +7,10 @@ type family CmpNat (a :: Nat) (b :: Nat) :: Ordering ...@@ -7,8 +7,10 @@ type family CmpNat (a :: Nat) (b :: Nat) :: Ordering
type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering
class KnownNat (n :: Nat) where class KnownNat (n :: Nat) where
natSing :: SNat n natSing :: SNat n
{-# MINIMAL natSing #-}
class KnownSymbol (n :: Symbol) where class KnownSymbol (n :: Symbol) where
symbolSing :: SSymbol n symbolSing :: SSymbol n
{-# MINIMAL symbolSing #-}
data SomeNat where data SomeNat where
SomeNat :: KnownNat n => (Proxy n) -> SomeNat SomeNat :: KnownNat n => (Proxy n) -> SomeNat
data SomeSymbol where data SomeSymbol where
......
...@@ -27,6 +27,9 @@ class (RealFrac a, Floating a) => RealFloat a where ...@@ -27,6 +27,9 @@ class (RealFrac a, Floating a) => RealFloat a where
isNegativeZero :: a -> Bool isNegativeZero :: a -> Bool
isIEEE :: a -> Bool isIEEE :: a -> Bool
atan2 :: a -> a -> a atan2 :: a -> a -> a
{-# MINIMAL floatRadix, floatDigits, floatRange, decodeFloat,
encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero,
isIEEE #-}
-- Defined in ‘GHC.Float’ -- Defined in ‘GHC.Float’
instance RealFloat Float -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’
instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’
......
...@@ -9,6 +9,7 @@ class C a b where ...@@ -9,6 +9,7 @@ class C a b where
c2 :: (N b, S b) => a -> b c2 :: (N b, S b) => a -> b
c3 :: a1 -> b c3 :: a1 -> b
c4 :: a1 -> b c4 :: a1 -> b
{-# MINIMAL c1, c2, c3, c4 #-}
c1 :: (C a b, N b) => a -> b c1 :: (C a b, N b) => a -> b
c2 :: (C a b, N b, S b) => a -> b c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => forall a. a -> b c3 :: C a b => forall a. a -> b
...@@ -30,6 +31,7 @@ class Applicative m => Monad (m :: * -> *) where ...@@ -30,6 +31,7 @@ class Applicative m => Monad (m :: * -> *) where
(>>) :: m a -> m b -> m b (>>) :: m a -> m b -> m b
return :: a -> m a return :: a -> m a
fail :: String -> m a fail :: String -> m a
{-# MINIMAL (>>=) #-}
-- imported via Data.Maybe -- imported via Data.Maybe
catMaybes :: [Maybe a] -> [a] catMaybes :: [Maybe a] -> [a]
fromJust :: Maybe a -> a fromJust :: Maybe a -> a
...@@ -50,6 +52,7 @@ Nothing :: Maybe a ...@@ -50,6 +52,7 @@ Nothing :: Maybe a
class Eq a where class Eq a where
(==) :: a -> a -> Bool (==) :: a -> a -> Bool
(/=) :: a -> a -> Bool (/=) :: a -> a -> Bool
{-# MINIMAL (==) | (/=) #-}
-- imported via Prelude, T -- imported via Prelude, T
Prelude.length :: Foldable t => forall a. t a -> Int Prelude.length :: Foldable t => forall a. t a -> Int
-- imported via T -- imported via T
...@@ -68,6 +71,7 @@ class C a b where ...@@ -68,6 +71,7 @@ class C a b where
c2 :: (N b, S b) => a -> b c2 :: (N b, S b) => a -> b
c3 :: a1 -> b c3 :: a1 -> b
c4 :: a1 -> b c4 :: a1 -> b
{-# MINIMAL c1, c2, c3, c4 #-}
c1 :: (C a b, N b) => a -> b c1 :: (C a b, N b) => a -> b
c2 :: (C a b, N b, S b) => a -> b c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => forall a. a -> b c3 :: C a b => forall a. a -> b
...@@ -82,6 +86,7 @@ class C a b where ...@@ -82,6 +86,7 @@ class C a b where
c2 :: (N b, S b) => a -> b c2 :: (N b, S b) => a -> b
c3 :: forall a1. a1 -> b c3 :: forall a1. a1 -> b
c4 :: 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 c1 :: forall a b. (C a b, N b) => a -> b
c2 :: forall a b. (C a b, N b, S 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 c3 :: forall a b. C a b => forall a. a -> b
......
...@@ -7,6 +7,7 @@ TYPE CONSTRUCTORS ...@@ -7,6 +7,7 @@ TYPE CONSTRUCTORS
type family Elem c :: * open type family Elem c :: * open
empty :: c empty :: c
insert :: Elem c -> c -> c insert :: Elem c -> c -> c
{-# MINIMAL empty, insert #-}
data ListColl a = L [a] data ListColl a = L [a]
Promotable Promotable
COERCION AXIOMS COERCION AXIOMS
......
...@@ -87,8 +87,10 @@ RnFail055.hs-boot:28:1: error: ...@@ -87,8 +87,10 @@ RnFail055.hs-boot:28:1: error:
Main module: class C2 a b where Main module: class C2 a b where
m2 :: a -> b m2 :: a -> b
m2' :: a -> b m2' :: a -> b
{-# MINIMAL m2, m2' #-}
Boot file: class C2 a b where Boot file: class C2 a b where
m2 :: a -> b m2 :: a -> b
{-# MINIMAL m2 #-}
The methods do not match: There are different numbers of methods The methods do not match: There are different numbers of methods
RnFail055.hs-boot:29:1: error: RnFail055.hs-boot:29:1: error:
......
...@@ -3,6 +3,7 @@ TYPE CONSTRUCTORS ...@@ -3,6 +3,7 @@ TYPE CONSTRUCTORS
type role C2 representational type role C2 representational
class C2 a where class C2 a where
meth2 :: a -> a meth2 :: a -> a
{-# MINIMAL meth2 #-}
COERCION AXIOMS COERCION AXIOMS
axiom Roles12.NTCo:C2 :: C2 a = a -> a axiom Roles12.NTCo:C2 :: C2 a = a -> a
Dependent modules: [] Dependent modules: []
......
...@@ -2,13 +2,17 @@ TYPE SIGNATURES ...@@ -2,13 +2,17 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS TYPE CONSTRUCTORS
class C1 a where class C1 a where
meth1 :: a -> a meth1 :: a -> a
{-# MINIMAL meth1 #-}
class C2 a b where class C2 a b where
meth2 :: a ~ b => a -> b meth2 :: a ~ b => a -> b
{-# MINIMAL meth2 #-}
class C3 a b where class C3 a b where
type family F3 b :: * open type family F3 b :: * open
meth3 :: a -> F3 b -> F3 b meth3 :: a -> F3 b -> F3 b
{-# MINIMAL meth3 #-}
class C4 a b where class C4 a b where
meth4 :: a -> F4 b -> F4 b meth4 :: a -> F4 b -> F4 b
{-# MINIMAL meth4 #-}
type family F4 a :: * open type family F4 a :: * open
type Syn1 a = F4 a type Syn1 a = F4 a
type Syn2 a = [a] type Syn2 a = [a]
......
...@@ -2,8 +2,10 @@ TYPE SIGNATURES ...@@ -2,8 +2,10 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS TYPE CONSTRUCTORS
class C1 a where class C1 a where
meth1 :: a -> a meth1 :: a -> a
{-# MINIMAL meth1 #-}
class C3 a where class C3 a where
meth3 :: a -> Syn1 a meth3 :: a -> Syn1 a
{-# MINIMAL meth3 #-}
type Syn1 a = [a] type Syn1 a = [a]
COERCION AXIOMS COERCION AXIOMS
axiom Roles4.NTCo:C1 :: C1 a = a -> a axiom Roles4.NTCo:C1 :: C1 a = a -> a
......
...@@ -11,6 +11,7 @@ TYPE CONSTRUCTORS ...@@ -11,6 +11,7 @@ TYPE CONSTRUCTORS
Promotable Promotable
class Zork s a b | a -> b where class Zork s a b | a -> b where
huh :: Q s a chain -> ST s () huh :: Q s a chain -> ST s ()
{-# MINIMAL huh #-}
COERCION AXIOMS COERCION AXIOMS
axiom NTCo:Zork :: axiom NTCo:Zork ::
Zork s a b = forall chain. Q s a chain -> ST s () Zork s a b = forall chain. Q s a chain -> ST s ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment