X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FGhciTags.hs;h=b53a56f967db5136b618bbd48e39ddfe6a1a1849;hp=95d0d61547e8ad3953fd2e8a9a1f5d3a5d0f3e30;hb=a9fa2e92d23824571127260f1e4792d225fbad1a;hpb=e235fc390df9b015216ebc62c9b9c9e1d40d586d diff --git a/compiler/ghci/GhciTags.hs b/compiler/ghci/GhciTags.hs index 95d0d61..b53a56f 100644 --- a/compiler/ghci/GhciTags.hs +++ b/compiler/ghci/GhciTags.hs @@ -17,6 +17,7 @@ import Util -- into the GHC API instead import Name (nameOccName) import OccName (pprOccName) +import MonadUtils import Data.Maybe import Panic @@ -40,8 +41,7 @@ data TagsKind = ETags | CTags ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi () ghciCreateTagsFile kind file = do - session <- getSession - io $ createTagsFile session kind file + createTagsFile kind file -- ToDo: -- - remove restriction that all modules must be interpreted @@ -51,22 +51,22 @@ ghciCreateTagsFile kind file = do -- - extract createTagsFile so it can be used from the command-line -- (probably need to fix first problem before this is useful). -- -createTagsFile :: Session -> TagsKind -> FilePath -> IO () -createTagsFile session tagskind tagFile = do - graph <- GHC.getModuleGraph session +createTagsFile :: TagsKind -> FilePath -> GHCi () +createTagsFile tagskind tagFile = do + graph <- GHC.getModuleGraph let ms = map GHC.ms_mod graph tagModule m = do - is_interpreted <- GHC.moduleIsInterpreted session m + is_interpreted <- GHC.moduleIsInterpreted m -- should we just skip these? when (not is_interpreted) $ ghcError (CmdLineError ("module '" ++ GHC.moduleNameString (GHC.moduleName m) ++ "' is not interpreted")) - mbModInfo <- GHC.getModuleInfo session m + mbModInfo <- GHC.getModuleInfo m unqual <- case mbModInfo of Just minf -> do - mb_print_unqual <- GHC.mkPrintUnqualifiedForModule session minf + mb_print_unqual <- GHC.mkPrintUnqualifiedForModule minf return (fromMaybe GHC.alwaysQualify mb_print_unqual) Nothing -> return GHC.alwaysQualify @@ -75,9 +75,9 @@ createTagsFile session tagskind tagFile = do _ -> return [] mtags <- mapM tagModule ms - either_res <- collateAndWriteTags tagskind tagFile $ concat mtags + either_res <- liftIO $ collateAndWriteTags tagskind tagFile $ concat mtags case either_res of - Left e -> hPutStrLn stderr $ ioeGetErrorString e + Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e Right _ -> return () listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]