-- into the GHC API instead
import Name (nameOccName)
import OccName (pprOccName)
+import MonadUtils
import Data.Maybe
-import Control.Exception
+import Panic
import Data.List
import Control.Monad
import System.IO
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
-- - 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) $
- throwDyn (CmdLineError ("module '"
+ 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
_ -> 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]
tagGroups <- mapM tagFileGroup groups
IO.try (writeFile file $ concat tagGroups)
where
- tagFileGroup [] = throwDyn (CmdLineError "empty tag file group??")
+ tagFileGroup [] = ghcError (CmdLineError "empty tag file group??")
tagFileGroup group@((_,fileName,_,_):_) = do
file <- readFile fileName -- need to get additional info from sources..
let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
sortedGroup = sortLe byLine group
tags = unlines $ perFile sortedGroup 1 0 $ lines file
return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
- perFile (tagInfo@(_tag, _file, lNo, _colNo):tags) count pos (line:lines)
- | lNo > count =
- perFile (tagInfo:tags) (count+1) (pos+length line) lines
- perFile (tagInfo@(_tag, _file, lNo, _colNo):tags) count pos lines@(line:_)
- | lNo == count =
- showETag tagInfo line pos : perFile tags count pos lines
+ perFile (tagInfo@(_tag, _file, lNo, _colNo):tags) count pos lines@(line:lines')
+ | lNo > count = perFile (tagInfo:tags) (count+1) (pos+length line) lines'
+ | lNo == count = showETag tagInfo line pos : perFile tags count pos lines
perFile _ _ _ _ = []
-- simple ctags format, for Vim et al