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
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 })
......
class Foo a where
foo :: a -> a
{-# MINIMAL foo #-}
data T = A.T
mkT :: T
x :: Bool
......
......@@ -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
......@@ -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
......
......@@ -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’
......
......@@ -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
......
......@@ -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
......
......@@ -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:
......
......@@ -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: []
......
......@@ -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]
......
......@@ -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
......
......@@ -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 ()
......
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