1 -----------------------------------------------------------------------------
3 -- GHCi's :ctags and :etags commands
5 -- (c) The GHC Team 2005-2007
7 -----------------------------------------------------------------------------
9 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
11 createCTagsWithLineNumbersCmd,
12 createCTagsWithRegExesCmd,
22 -- ToDo: figure out whether we need these, and put something appropriate
23 -- into the GHC API instead
24 import Name (nameOccName)
25 import OccName (pprOccName)
33 import System.IO.Error
35 -----------------------------------------------------------------------------
36 -- create tags file for currently loaded modules.
38 createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,
39 createETagsFileCmd :: String -> GHCi ()
41 createCTagsWithLineNumbersCmd "" =
42 ghciCreateTagsFile CTagsWithLineNumbers "tags"
43 createCTagsWithLineNumbersCmd file =
44 ghciCreateTagsFile CTagsWithLineNumbers file
46 createCTagsWithRegExesCmd "" =
47 ghciCreateTagsFile CTagsWithRegExes "tags"
48 createCTagsWithRegExesCmd file =
49 ghciCreateTagsFile CTagsWithRegExes file
51 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
52 createETagsFileCmd file = ghciCreateTagsFile ETags file
54 data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes
56 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
57 ghciCreateTagsFile kind file = do
58 createTagsFile kind file
61 -- - remove restriction that all modules must be interpreted
62 -- (problem: we don't know source locations for entities unless
63 -- we compiled the module.
65 -- - extract createTagsFile so it can be used from the command-line
66 -- (probably need to fix first problem before this is useful).
68 createTagsFile :: TagsKind -> FilePath -> GHCi ()
69 createTagsFile tagskind tagsFile = do
70 graph <- GHC.getModuleGraph
71 mtags <- mapM listModuleTags (map GHC.ms_mod graph)
72 either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags
74 Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
78 listModuleTags :: GHC.Module -> GHCi [TagInfo]
80 is_interpreted <- GHC.moduleIsInterpreted m
81 -- should we just skip these?
82 when (not is_interpreted) $
83 let mName = GHC.moduleNameString (GHC.moduleName m) in
84 ghcError (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
85 mbModInfo <- GHC.getModuleInfo m
89 mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
90 let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
91 let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
92 let localNames = filter ((m==) . nameModule) names
93 mbTyThings <- mapM GHC.lookupName localNames
94 return $! [ tagInfo unqual exported kind name loc
95 | tyThing <- catMaybes mbTyThings
96 , let name = getName tyThing
97 , let exported = GHC.modInfoIsExportedName mInfo name
98 , let kind = tyThing2TagKind tyThing
99 , let loc = srcSpanStart (nameSrcSpan name)
104 tyThing2TagKind (AnId _) = 'v'
105 tyThing2TagKind (ADataCon _) = 'd'
106 tyThing2TagKind (ATyCon _) = 't'
107 tyThing2TagKind (AClass _) = 'c'
110 data TagInfo = TagInfo
111 { tagExported :: Bool -- is tag exported
112 , tagKind :: Char -- tag kind
113 , tagName :: String -- tag name
114 , tagFile :: String -- file name
115 , tagLine :: Int -- line number
116 , tagCol :: Int -- column number
117 , tagSrcInfo :: Maybe (String,Integer) -- source code line and char offset
121 -- get tag info, for later translation into Vim or Emacs style
122 tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> SrcLoc -> TagInfo
123 tagInfo unqual exported kind name loc
124 = TagInfo exported kind
125 (showSDocForUser unqual $ pprOccName (nameOccName name))
126 (showSDocForUser unqual $ ftext (srcLocFile loc))
127 (srcLocLine loc) (srcLocCol loc) Nothing
130 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
131 -- ctags style with the Ex exresion being just the line number, Vim et al
132 collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
133 let tags = unlines $ sortLe (<=) $ map showCTag tagInfos
134 tryIO (writeFile file tags)
136 -- ctags style with the Ex exresion being a regex searching the line, Vim et al
137 collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
138 tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
139 let tags = unlines $ sortLe (<=) $ map showCTag $concat tagInfoGroups
140 tryIO (writeFile file tags)
142 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
143 tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
144 let tagGroups = map processGroup tagInfoGroups
145 tryIO (writeFile file $ concat tagGroups)
148 processGroup [] = ghcError (CmdLineError "empty tag file group??")
149 processGroup group@(tagInfo:_) =
150 let tags = unlines $ map showETag group in
151 "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
154 makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
155 makeTagGroupsWithSrcInfo tagInfos = do
156 let byFile op ti0 ti1 = tagFile ti0 `op` tagFile ti1
157 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
158 mapM addTagSrcInfo groups
161 addTagSrcInfo [] = ghcError (CmdLineError "empty tag file group??")
162 addTagSrcInfo group@(tagInfo:_) = do
163 file <- readFile $tagFile tagInfo
164 let byLine ti0 ti1 = tagLine ti0 <= tagLine ti1
165 sortedGroup = sortLe byLine group
166 return $ perFile sortedGroup 1 0 $ lines file
168 perFile allTags@(tag:tags) cnt pos allLs@(l:ls)
169 | tagLine tag > cnt =
170 perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls
171 | tagLine tag == cnt =
172 tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs
176 -- ctags format, for Vim et al
177 showCTag :: TagInfo -> String
179 tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++
180 tagKind ti : ( if tagExported ti then "" else "\tfile:" )
184 case tagSrcInfo ti of
185 Nothing -> show $tagLine ti
186 Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
189 escapeSlashes '/' r = '\\' : '/' : r
190 escapeSlashes '\\' r = '\\' : '\\' : r
191 escapeSlashes c r = c : r
194 -- etags format, for Emacs/XEmacs
195 showETag :: TagInfo -> String
196 showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
197 tagSrcInfo = Just (srcLine,charPos) }
198 = take colNo srcLine ++ tag
200 ++ "\x01" ++ show lineNo
201 ++ "," ++ show charPos
202 showETag _ = ghcError (CmdLineError "missing source file info in showETag")