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'
108 tyThing2TagKind (ACoAxiom _) = 'x'
111 data TagInfo = TagInfo
112 { tagExported :: Bool -- is tag exported
113 , tagKind :: Char -- tag kind
114 , tagName :: String -- tag name
115 , tagFile :: String -- file name
116 , tagLine :: Int -- line number
117 , tagCol :: Int -- column number
118 , tagSrcInfo :: Maybe (String,Integer) -- source code line and char offset
122 -- get tag info, for later translation into Vim or Emacs style
123 tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> SrcLoc -> TagInfo
124 tagInfo unqual exported kind name loc
125 = TagInfo exported kind
126 (showSDocForUser unqual $ pprOccName (nameOccName name))
127 (showSDocForUser unqual $ ftext (srcLocFile loc))
128 (srcLocLine loc) (srcLocCol loc) Nothing
131 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
132 -- ctags style with the Ex exresion being just the line number, Vim et al
133 collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
134 let tags = unlines $ sortLe (<=) $ map showCTag tagInfos
135 tryIO (writeFile file tags)
137 -- ctags style with the Ex exresion being a regex searching the line, Vim et al
138 collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
139 tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
140 let tags = unlines $ sortLe (<=) $ map showCTag $concat tagInfoGroups
141 tryIO (writeFile file tags)
143 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
144 tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
145 let tagGroups = map processGroup tagInfoGroups
146 tryIO (writeFile file $ concat tagGroups)
149 processGroup [] = ghcError (CmdLineError "empty tag file group??")
150 processGroup group@(tagInfo:_) =
151 let tags = unlines $ map showETag group in
152 "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
155 makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
156 makeTagGroupsWithSrcInfo tagInfos = do
157 let byFile op ti0 ti1 = tagFile ti0 `op` tagFile ti1
158 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
159 mapM addTagSrcInfo groups
162 addTagSrcInfo [] = ghcError (CmdLineError "empty tag file group??")
163 addTagSrcInfo group@(tagInfo:_) = do
164 file <- readFile $tagFile tagInfo
165 let byLine ti0 ti1 = tagLine ti0 <= tagLine ti1
166 sortedGroup = sortLe byLine group
167 return $ perFile sortedGroup 1 0 $ lines file
169 perFile allTags@(tag:tags) cnt pos allLs@(l:ls)
170 | tagLine tag > cnt =
171 perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls
172 | tagLine tag == cnt =
173 tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs
177 -- ctags format, for Vim et al
178 showCTag :: TagInfo -> String
180 tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++
181 tagKind ti : ( if tagExported ti then "" else "\tfile:" )
185 case tagSrcInfo ti of
186 Nothing -> show $tagLine ti
187 Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
190 escapeSlashes '/' r = '\\' : '/' : r
191 escapeSlashes '\\' r = '\\' : '\\' : r
192 escapeSlashes c r = c : r
195 -- etags format, for Emacs/XEmacs
196 showETag :: TagInfo -> String
197 showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
198 tagSrcInfo = Just (srcLine,charPos) }
199 = take colNo srcLine ++ tag
201 ++ "\x01" ++ show lineNo
202 ++ "," ++ show charPos
203 showETag _ = ghcError (CmdLineError "missing source file info in showETag")