{-# LANGUAGE ExistentialQuantification #-}
module GHC.Tc.Errors.Hole.FitTypes (
TypedHole (..), HoleFit (..), TcHoleFit(..), HoleFitCandidate (..),
hfIsLcl, pprHoleFitCand
) where
import GHC.Prelude
import GHC.Tc.Types.Constraint
import GHC.Tc.Utils.TcType
import GHC.Types.Name.Reader
import GHC.Hs.Doc
import GHC.Types.Id
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Data.Bag
import Data.Function ( on )
data TypedHole = TypedHole { TypedHole -> Bag CtEvidence
th_relevant_cts :: Bag CtEvidence
, TypedHole -> [Implication]
th_implics :: [Implication]
, TypedHole -> Maybe Hole
th_hole :: Maybe Hole
}
instance Outputable TypedHole where
ppr :: TypedHole -> SDoc
ppr (TypedHole { th_relevant_cts :: TypedHole -> Bag CtEvidence
th_relevant_cts = Bag CtEvidence
rels
, th_implics :: TypedHole -> [Implication]
th_implics = [Implication]
implics
, th_hole :: TypedHole -> Maybe Hole
th_hole = Maybe Hole
hole })
= SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TypedHole") Int
2
(Bag CtEvidence -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bag CtEvidence
rels SDoc -> SDoc -> SDoc
$+$ [Implication] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Implication]
implics SDoc -> SDoc -> SDoc
$+$ Maybe Hole -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Hole
hole)
data HoleFitCandidate = IdHFCand Id
| NameHFCand Name
| GreHFCand GlobalRdrElt
instance Eq HoleFitCandidate where
IdHFCand Id
i1 == :: HoleFitCandidate -> HoleFitCandidate -> Bool
== IdHFCand Id
i2 = Id
i1 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
i2
NameHFCand Name
n1 == NameHFCand Name
n2 = Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n2
GreHFCand GlobalRdrElt
gre1 == GreHFCand GlobalRdrElt
gre2 = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre2
HoleFitCandidate
_ == HoleFitCandidate
_ = Bool
False
instance Outputable HoleFitCandidate where
ppr :: HoleFitCandidate -> SDoc
ppr = HoleFitCandidate -> SDoc
pprHoleFitCand
pprHoleFitCand :: HoleFitCandidate -> SDoc
pprHoleFitCand :: HoleFitCandidate -> SDoc
pprHoleFitCand (IdHFCand Id
cid) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Id HFC: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
cid
pprHoleFitCand (NameHFCand Name
cname) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Name HFC: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cname
pprHoleFitCand (GreHFCand GlobalRdrElt
cgre) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Gre HFC: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
cgre
instance NamedThing HoleFitCandidate where
getName :: HoleFitCandidate -> Name
getName HoleFitCandidate
hfc = case HoleFitCandidate
hfc of
IdHFCand Id
cid -> Id -> Name
idName Id
cid
NameHFCand Name
cname -> Name
cname
GreHFCand GlobalRdrElt
cgre -> GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
cgre
getOccName :: HoleFitCandidate -> OccName
getOccName HoleFitCandidate
hfc = case HoleFitCandidate
hfc of
IdHFCand Id
cid -> Id -> OccName
forall name. HasOccName name => name -> OccName
occName Id
cid
NameHFCand Name
cname -> Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
cname
GreHFCand GlobalRdrElt
cgre -> Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName) -> Name -> OccName
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
cgre
instance HasOccName HoleFitCandidate where
occName :: HoleFitCandidate -> OccName
occName = HoleFitCandidate -> OccName
forall a. NamedThing a => a -> OccName
getOccName
instance Ord HoleFitCandidate where
compare :: HoleFitCandidate -> HoleFitCandidate -> Ordering
compare = Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Name -> Ordering)
-> (HoleFitCandidate -> Name)
-> HoleFitCandidate
-> HoleFitCandidate
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` HoleFitCandidate -> Name
forall a. NamedThing a => a -> Name
getName
data TcHoleFit =
HoleFit { TcHoleFit -> Id
hfId :: Id
, TcHoleFit -> HoleFitCandidate
hfCand :: HoleFitCandidate
, TcHoleFit -> TcType
hfType :: TcType
, TcHoleFit -> Int
hfRefLvl :: Int
, TcHoleFit -> [TcType]
hfWrap :: [TcType]
, TcHoleFit -> [TcType]
hfMatches :: [TcType]
, TcHoleFit -> Maybe [HsDocString]
hfDoc :: Maybe [HsDocString]
}
data HoleFit
= TcHoleFit TcHoleFit
| RawHoleFit SDoc
instance Eq TcHoleFit where
== :: TcHoleFit -> TcHoleFit -> Bool
(==) = Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Id -> Id -> Bool)
-> (TcHoleFit -> Id) -> TcHoleFit -> TcHoleFit -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TcHoleFit -> Id
hfId
instance Outputable HoleFit where
ppr :: HoleFit -> SDoc
ppr (TcHoleFit TcHoleFit
hf) = TcHoleFit -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcHoleFit
hf
ppr (RawHoleFit SDoc
sd) = SDoc
sd
instance Outputable TcHoleFit where
ppr :: TcHoleFit -> SDoc
ppr (HoleFit Id
_ HoleFitCandidate
cand TcType
ty Int
_ [TcType]
_ [TcType]
mtchs Maybe [HsDocString]
_) =
SDoc -> Int -> SDoc -> SDoc
hang (SDoc
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
holes) Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty))
where name :: SDoc
name = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ HoleFitCandidate -> Name
forall a. NamedThing a => a -> Name
getName HoleFitCandidate
cand
holes :: SDoc
holes = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (TcType -> SDoc) -> [TcType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> (TcType -> SDoc) -> TcType -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) (SDoc -> SDoc) -> (TcType -> SDoc) -> TcType -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [TcType]
mtchs
instance Ord TcHoleFit where
compare :: TcHoleFit -> TcHoleFit -> Ordering
compare a :: TcHoleFit
a@(HoleFit {}) b :: TcHoleFit
b@(HoleFit {}) = TcHoleFit -> TcHoleFit -> Ordering
cmp TcHoleFit
a TcHoleFit
b
where cmp :: TcHoleFit -> TcHoleFit -> Ordering
cmp = if TcHoleFit -> Int
hfRefLvl TcHoleFit
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== TcHoleFit -> Int
hfRefLvl TcHoleFit
b
then Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Name -> Ordering)
-> (TcHoleFit -> Name) -> TcHoleFit -> TcHoleFit -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HoleFitCandidate -> Name
forall a. NamedThing a => a -> Name
getName (HoleFitCandidate -> Name)
-> (TcHoleFit -> HoleFitCandidate) -> TcHoleFit -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcHoleFit -> HoleFitCandidate
hfCand)
else Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (TcHoleFit -> Int) -> TcHoleFit -> TcHoleFit -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TcHoleFit -> Int
hfRefLvl
hfIsLcl :: TcHoleFit -> Bool
hfIsLcl :: TcHoleFit -> Bool
hfIsLcl hf :: TcHoleFit
hf@(HoleFit {}) = case TcHoleFit -> HoleFitCandidate
hfCand TcHoleFit
hf of
IdHFCand Id
_ -> Bool
True
NameHFCand Name
_ -> Bool
False
GreHFCand GlobalRdrElt
gre -> GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
gre_lcl GlobalRdrElt
gre