hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Replace redirected filenames in info.

Browse Source
This commit is contained in:
Nikolay Yakimov
2015-07-04 17:49:48 +03:00
parent c2ff5be4ea
commit e7329a9d24
4 changed files with 55 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
Language/Haskell/GhcMod/Gap.hs
View File

@@ -67,6 +67,7 @@ import TcType
import Var (varType)
import System.Directory
import qualified Name
import qualified InstEnv
import qualified Pretty
import qualified StringBuffer as SB
@@ -328,8 +329,8 @@ filterOutChildren get_thing xs
where
implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
infoThing :: GhcMonad m => Expression -> m SDoc
infoThing (Expression str) = do
infoThing :: GhcMonad m => (FilePath -> FilePath) -> Expression -> m SDoc
infoThing m (Expression str) = do
names <- parseName str
#if __GLASGOW_HASKELL__ >= 708
mb_stuffs <- mapM (getInfo False) names
@@ -338,30 +339,45 @@ infoThing (Expression str) = do
mb_stuffs <- mapM getInfo names
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
#endif
return $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
return $ vcat (intersperse (text "") $ map (pprInfo m False) filtered)
#if __GLASGOW_HASKELL__ >= 708
pprInfo :: Bool -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
pprInfo _ (thing, fixity, insts, famInsts)
= pprTyThingInContextLoc thing
pprInfo :: (FilePath -> FilePath) -> Bool -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
pprInfo m _ (thing, fixity, insts, famInsts)
= pprTyThingInContextLoc' thing
$$ show_fixity fixity
$$ InstEnv.pprInstances insts
$$ pprFamInsts famInsts
where
show_fixity fx
| fx == defaultFixity = Outputable.empty
| otherwise = ppr fx <+> ppr (getName thing)
#else
pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst]) -> SDoc
pprInfo pefas (thing, fixity, insts)
= pprTyThingInContextLoc pefas thing
pprInfo :: (FilePath -> FilePath) -> PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst]) -> SDoc
pprInfo m pefas (thing, fixity, insts)
= pprTyThingInContextLoc' pefas thing
$$ show_fixity fixity
$$ vcat (map pprInstance insts)
#endif
where
show_fixity fx
| fx == defaultFixity = Outputable.empty
| otherwise = ppr fx <+> ppr (getName thing)
#if __GLASGOW_HASKELL__ >= 708
pprTyThingInContextLoc' thing' = hang (pprTyThingInContext thing') 2
(char '\t' <> ptext (sLit "--") <+> loc)
where loc = ptext (sLit "Defined") <+> pprNameDefnLoc' (getName thing')
#else
pprTyThingInContextLoc' pefas thing' = hang (pprTyThingInContext pefas thing') 2
(char '\t' <> ptext (sLit "--") <+> loc)
where loc = ptext (sLit "Defined") <+> pprNameDefnLoc' (getName thing')
#endif
pprNameDefnLoc' name
= case Name.nameSrcLoc name of
RealSrcLoc s -> ptext (sLit "at") <+> ppr (subst s)
UnhelpfulLoc s
| Name.isInternalName name || Name.isSystemName name
-> ptext (sLit "at") <+> ftext s
| otherwise
-> ptext (sLit "in") <+> quotes (ppr (nameModule name))
where subst s = mkRealSrcLoc (realFP s) (srcLocLine s) (srcLocCol s)
realFP = mkFastString . m . unpackFS . srcLocFile
----------------------------------------------------------------
----------------------------------------------------------------