diff --git a/Language/Haskell/GhcMod/CaseSplit.hs b/Language/Haskell/GhcMod/CaseSplit.hs index 7c98f6e..7bcd3fa 100644 --- a/Language/Haskell/GhcMod/CaseSplit.hs +++ b/Language/Haskell/GhcMod/CaseSplit.hs @@ -27,6 +27,7 @@ import Language.Haskell.GhcMod.SrcUtils import Language.Haskell.GhcMod.Doc import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Types +import Language.Haskell.GhcMod.Utils (withMappedFile) import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping) ---------------------------------------------------------------- @@ -57,12 +58,14 @@ splits file lineNo colNo = whenFound' oopts (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> case x of (SplitInfo varName bndLoc (varLoc,varT) _matches) -> do let varName' = showName dflag style varName -- Convert name to string - t <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $ + t <- withMappedFile file $ \file' -> + genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $ getTyCons dflag style varName varT) return (fourInts bndLoc, t) (TySplitInfo varName bndLoc (varLoc,varT)) -> do let varName' = showName dflag style varName -- Convert name to string - t <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $ + t <- withMappedFile file $ \file' -> + genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $ getTyCons dflag style varName varT) return (fourInts bndLoc, t) where diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 48337e0..bf38e1c 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -75,6 +75,10 @@ import qualified InstEnv import qualified Pretty import qualified StringBuffer as SB +#if __GLASGOW_HASKELL__ >= 710 +import CoAxiom (coAxiomTyCon) +#endif + #if __GLASGOW_HASKELL__ >= 708 import FamInstEnv import ConLike (ConLike(..)) @@ -357,28 +361,44 @@ pprInfo :: (FilePath -> FilePath) -> Bool -> (TyThing, GHC.Fixity, [ClsInst], [F pprInfo m _ (thing, fixity, insts, famInsts) = pprTyThingInContextLoc' thing $$ show_fixity fixity - $$ InstEnv.pprInstances insts - $$ pprFamInsts famInsts + $$ vcat (map pprInstance' insts) + $$ vcat (map pprFamInst' famInsts) #else 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) + $$ 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') + pprTyThingInContextLoc' thing' = showWithLoc (pprDefinedAt' thing') (pprTyThingInContext thing') +#if __GLASGOW_HASKELL__ >= 710 + pprFamInst' (FamInst { fi_flavor = DataFamilyInst rep_tc }) + = pprTyThingInContextLoc (ATyCon rep_tc) + + pprFamInst' (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom + , fi_tys = lhs_tys, fi_rhs = rhs }) + = showWithLoc (pprDefinedAt' (getName axiom)) $ + hang (ptext (sLit "type instance") <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys) + 2 (equals <+> ppr rhs) #else - pprTyThingInContextLoc' pefas' thing' = hang (pprTyThingInContext pefas' thing') 2 - (char '\t' <> ptext (sLit "--") <+> loc) - where loc = ptext (sLit "Defined") <+> pprNameDefnLoc' (getName thing') + pprFamInst' ispec = showWithLoc (pprDefinedAt' (getName ispec)) (pprFamInstHdr ispec) #endif +#else + pprTyThingInContextLoc' pefas' thing' = showWithLoc (pprDefinedAt' thing') (pprTyThingInContext pefas' thing') +#endif + showWithLoc loc doc + = hang doc 2 (char '\t' <> comment <+> loc) + -- The tab tries to make them line up a bit + where + comment = ptext (sLit "--") + pprInstance' ispec = hang (pprInstanceHdr ispec) + 2 (ptext (sLit "--") <+> pprDefinedAt' (getName ispec)) + pprDefinedAt' thing' = ptext (sLit "Defined") <+> pprNameDefnLoc' (getName thing') pprNameDefnLoc' name = case Name.nameSrcLoc name of RealSrcLoc s -> ptext (sLit "at") <+> ppr (subst s) diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 536842b..67fa140 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -464,7 +464,7 @@ loadTargets opts targetStrs = do HscNothing -> do void $ load LoadAllTargets forM_ mg $ - handleSourceError (gmLog GmWarning "loadTargets" . text . show) + handleSourceError (gmLog GmDebug "loadTargets" . text . show) . void . (parseModule >=> typecheckModule >=> desugarModule) HscInterpreted -> do void $ load LoadAllTargets