1 -----------------------------------------------------------------------------
3 -- GHCi's :ctags and :etags commands
5 -- (c) The GHC Team 2005-2007
7 -----------------------------------------------------------------------------
9 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
10 module GhciTags (createCTagsFileCmd, createETagsFileCmd) where
17 -- ToDo: figure out whether we need these, and put something appropriate
18 -- into the GHC API instead
19 import Name (nameOccName)
20 import OccName (pprOccName)
28 import System.IO.Error as IO
30 -----------------------------------------------------------------------------
31 -- create tags file for currently loaded modules.
33 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
35 createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags"
36 createCTagsFileCmd file = ghciCreateTagsFile CTags file
38 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
39 createETagsFileCmd file = ghciCreateTagsFile ETags file
41 data TagsKind = ETags | CTags
43 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
44 ghciCreateTagsFile kind file = do
45 createTagsFile kind file
48 -- - remove restriction that all modules must be interpreted
49 -- (problem: we don't know source locations for entities unless
50 -- we compiled the module.
52 -- - extract createTagsFile so it can be used from the command-line
53 -- (probably need to fix first problem before this is useful).
55 createTagsFile :: TagsKind -> FilePath -> GHCi ()
56 createTagsFile tagskind tagFile = do
57 graph <- GHC.getModuleGraph
58 let ms = map GHC.ms_mod graph
60 is_interpreted <- GHC.moduleIsInterpreted m
61 -- should we just skip these?
62 when (not is_interpreted) $
63 ghcError (CmdLineError ("module '"
64 ++ GHC.moduleNameString (GHC.moduleName m)
65 ++ "' is not interpreted"))
66 mbModInfo <- GHC.getModuleInfo m
70 mb_print_unqual <- GHC.mkPrintUnqualifiedForModule minf
71 return (fromMaybe GHC.alwaysQualify mb_print_unqual)
73 return GHC.alwaysQualify
75 Just modInfo -> return $! listTags unqual modInfo
78 mtags <- mapM tagModule ms
79 either_res <- liftIO $ collateAndWriteTags tagskind tagFile $ concat mtags
81 Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
84 listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
85 listTags unqual modInfo =
86 [ tagInfo unqual name loc
87 | name <- GHC.modInfoExports modInfo
88 , let loc = srcSpanStart (nameSrcSpan name)
92 type TagInfo = (String -- tag name
98 -- get tag info, for later translation into Vim or Emacs style
99 tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
100 tagInfo unqual name loc
101 = ( showSDocForUser unqual $ pprOccName (nameOccName name)
102 , showSDocForUser unqual $ ftext (srcLocFile loc)
107 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
108 collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
109 let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
110 IO.try (writeFile file tags)
111 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
112 let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
113 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
114 tagGroups <- mapM tagFileGroup groups
115 IO.try (writeFile file $ concat tagGroups)
117 tagFileGroup [] = ghcError (CmdLineError "empty tag file group??")
118 tagFileGroup group@((_,fileName,_,_):_) = do
119 file <- readFile fileName -- need to get additional info from sources..
120 let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
121 sortedGroup = sortLe byLine group
122 tags = unlines $ perFile sortedGroup 1 0 $ lines file
123 return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
124 perFile (tagInfo@(_tag, _file, lNo, _colNo):tags) count pos lines@(line:lines')
125 | lNo > count = perFile (tagInfo:tags) (count+1) (pos+length line) lines'
126 | lNo == count = showETag tagInfo line pos : perFile tags count pos lines
129 -- simple ctags format, for Vim et al
130 showTag :: TagInfo -> String
131 showTag (tag, file, lineNo, _colNo)
132 = tag ++ "\t" ++ file ++ "\t" ++ show lineNo
134 -- etags format, for Emacs/XEmacs
135 showETag :: TagInfo -> String -> Int -> String
136 showETag (tag, _file, lineNo, colNo) line charPos
137 = take colNo line ++ tag
139 ++ "\x01" ++ show lineNo
140 ++ "," ++ show charPos