module Hhp.Things (
GapThing(..)
, fromTyThing
, infoThing
) where
import ConLike (ConLike(..))
import FamInstEnv
import GHC
import HscTypes
import qualified InstEnv
import NameSet
import Outputable
import PatSyn
import PprTyThing
import Var (varType)
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import Hhp.Gap (getTyThing, fixInfo)
data GapThing = GtA Type
| GtT TyCon
| GtN
| GtPatSyn PatSyn
fromTyThing :: TyThing -> GapThing
fromTyThing :: TyThing -> GapThing
fromTyThing (AnId Id
i) = Type -> GapThing
GtA (Type -> GapThing) -> Type -> GapThing
forall a b. (a -> b) -> a -> b
$ Id -> Type
varType Id
i
fromTyThing (AConLike (RealDataCon DataCon
d)) = Type -> GapThing
GtA (Type -> GapThing) -> Type -> GapThing
forall a b. (a -> b) -> a -> b
$ DataCon -> Type
dataConUserType DataCon
d
fromTyThing (AConLike (PatSynCon PatSyn
p)) = PatSyn -> GapThing
GtPatSyn PatSyn
p
fromTyThing (ATyCon TyCon
t) = TyCon -> GapThing
GtT TyCon
t
fromTyThing TyThing
_ = GapThing
GtN
infoThing :: String -> Ghc SDoc
infoThing :: String -> Ghc SDoc
infoThing String
str = do
[Name]
names <- String -> Ghc [Name]
forall (m :: * -> *). GhcMonad m => String -> m [Name]
parseName String
str
[Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs <- (Name -> Ghc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
-> [Name]
-> Ghc [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Name
-> Ghc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
forall (m :: * -> *).
GhcMonad m =>
Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
getInfo Bool
False) [Name]
names
let filtered :: [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered = ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> TyThing)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> TyThing
forall a b c d e. (a, b, c, d, e) -> a
getTyThing ([(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)])
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a b. (a -> b) -> a -> b
$ [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs
SDoc -> Ghc SDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> Ghc SDoc) -> SDoc -> Ghc SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse (String -> SDoc
text String
"") ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((TyThing, Fixity, [ClsInst], [FamInst]) -> SDoc
pprInfo ((TyThing, Fixity, [ClsInst], [FamInst]) -> SDoc)
-> ((TyThing, Fixity, [ClsInst], [FamInst], SDoc)
-> (TyThing, Fixity, [ClsInst], [FamInst]))
-> (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
-> (TyThing, Fixity, [ClsInst], [FamInst])
forall a b c d e. (a, b, c, d, e) -> (a, b, c, d)
fixInfo) [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered)
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren a -> TyThing
get_thing [a]
xs
= [a
x | a
x <- [a]
xs, Bool -> Bool
not (TyThing -> Name
forall a. NamedThing a => a -> Name
getName (a -> TyThing
get_thing a
x) Name -> NameSet -> Bool
`elemNameSet` NameSet
implicits)]
where
implicits :: NameSet
implicits = [Name] -> NameSet
mkNameSet [TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
t | a
x <- [a]
xs, TyThing
t <- TyThing -> [TyThing]
implicitTyThings (a -> TyThing
get_thing a
x)]
pprInfo :: (TyThing, GHC.Fixity, [InstEnv.ClsInst], [FamInst]) -> SDoc
pprInfo :: (TyThing, Fixity, [ClsInst], [FamInst]) -> SDoc
pprInfo (TyThing
thing, Fixity
fixity, [ClsInst]
insts, [FamInst]
famInsts)
= TyThing -> SDoc
pprTyThingInContextLoc TyThing
thing
SDoc -> SDoc -> SDoc
$$ Fixity -> SDoc
show_fixity Fixity
fixity
SDoc -> SDoc -> SDoc
$$ [ClsInst] -> SDoc
InstEnv.pprInstances [ClsInst]
insts
SDoc -> SDoc -> SDoc
$$ [FamInst] -> SDoc
pprFamInsts [FamInst]
famInsts
where
show_fixity :: Fixity -> SDoc
show_fixity Fixity
fx
| Fixity
fx Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
defaultFixity = SDoc
Outputable.empty
| Bool
otherwise = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fx SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing)