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