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,
23 -- ToDo: figure out whether we need these, and put something appropriate
24 -- into the GHC API instead
25 import Name (nameOccName)
26 import OccName (pprOccName)
34 import System.IO.Error
36 -----------------------------------------------------------------------------
37 -- create tags file for currently loaded modules.
39 createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,
40 createETagsFileCmd :: String -> GHCi ()
42 createCTagsWithLineNumbersCmd "" =
43 ghciCreateTagsFile CTagsWithLineNumbers "tags"
44 createCTagsWithLineNumbersCmd file =
45 ghciCreateTagsFile CTagsWithLineNumbers file
47 createCTagsWithRegExesCmd "" =
48 ghciCreateTagsFile CTagsWithRegExes "tags"
49 createCTagsWithRegExesCmd file =
50 ghciCreateTagsFile CTagsWithRegExes file
52 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
53 createETagsFileCmd file = ghciCreateTagsFile ETags file
55 data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes
57 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
58 ghciCreateTagsFile kind file = do
59 createTagsFile kind file
62 -- - remove restriction that all modules must be interpreted
63 -- (problem: we don't know source locations for entities unless
64 -- we compiled the module.
66 -- - extract createTagsFile so it can be used from the command-line
67 -- (probably need to fix first problem before this is useful).
69 createTagsFile :: TagsKind -> FilePath -> GHCi ()
70 createTagsFile tagskind tagsFile = do
71 graph <- GHC.getModuleGraph
72 mtags <- mapM listModuleTags (map GHC.ms_mod graph)
73 either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags
75 Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
79 listModuleTags :: GHC.Module -> GHCi [TagInfo]
81 is_interpreted <- GHC.moduleIsInterpreted m
82 -- should we just skip these?
83 when (not is_interpreted) $
84 let mName = GHC.moduleNameString (GHC.moduleName m) in
85 ghcError (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
86 mbModInfo <- GHC.getModuleInfo m
90 mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
91 let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
92 let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
93 let localNames = filter ((m==) . nameModule) names
94 mbTyThings <- mapM GHC.lookupName localNames
95 return $! [ tagInfo unqual exported kind name realLoc
96 | tyThing <- catMaybes mbTyThings
97 , let name = getName tyThing
98 , let exported = GHC.modInfoIsExportedName mInfo name
99 , let kind = tyThing2TagKind tyThing
100 , let loc = srcSpanStart (nameSrcSpan name)
101 , RealSrcLoc realLoc <- [loc]
105 tyThing2TagKind (AnId _) = 'v'
106 tyThing2TagKind (ADataCon _) = 'd'
107 tyThing2TagKind (ATyCon _) = 't'
108 tyThing2TagKind (AClass _) = 'c'
109 tyThing2TagKind (ACoAxiom _) = 'x'
112 data TagInfo = TagInfo
113 { tagExported :: Bool -- is tag exported
114 , tagKind :: Char -- tag kind
115 , tagName :: String -- tag name
116 , tagFile :: String -- file name
117 , tagLine :: Int -- line number
118 , tagCol :: Int -- column number
119 , tagSrcInfo :: Maybe (String,Integer) -- source code line and char offset
123 -- get tag info, for later translation into Vim or Emacs style
124 tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc -> TagInfo
125 tagInfo unqual exported kind name loc
126 = TagInfo exported kind
127 (showSDocForUser unqual $ pprOccName (nameOccName name))
128 (showSDocForUser unqual $ ftext (srcLocFile loc))
129 (srcLocLine loc) (srcLocCol loc) Nothing
132 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
133 -- ctags style with the Ex exresion being just the line number, Vim et al
134 collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
135 let tags = unlines $ sortLe (<=) $ map showCTag tagInfos
136 tryIO (writeFile file tags)
138 -- ctags style with the Ex exresion being a regex searching the line, Vim et al
139 collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
140 tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
141 let tags = unlines $ sortLe (<=) $ map showCTag $concat tagInfoGroups
142 tryIO (writeFile file tags)
144 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
145 tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
146 let tagGroups = map processGroup tagInfoGroups
147 tryIO (writeFile file $ concat tagGroups)
150 processGroup [] = ghcError (CmdLineError "empty tag file group??")
151 processGroup group@(tagInfo:_) =
152 let tags = unlines $ map showETag group in
153 "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
156 makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
157 makeTagGroupsWithSrcInfo tagInfos = do
158 let byFile op ti0 ti1 = tagFile ti0 `op` tagFile ti1
159 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
160 mapM addTagSrcInfo groups
163 addTagSrcInfo [] = ghcError (CmdLineError "empty tag file group??")
164 addTagSrcInfo group@(tagInfo:_) = do
165 file <- readFile $tagFile tagInfo
166 let byLine ti0 ti1 = tagLine ti0 <= tagLine ti1
167 sortedGroup = sortLe byLine group
168 return $ perFile sortedGroup 1 0 $ lines file
170 perFile allTags@(tag:tags) cnt pos allLs@(l:ls)
171 | tagLine tag > cnt =
172 perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls
173 | tagLine tag == cnt =
174 tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs
178 -- ctags format, for Vim et al
179 showCTag :: TagInfo -> String
181 tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++
182 tagKind ti : ( if tagExported ti then "" else "\tfile:" )
186 case tagSrcInfo ti of
187 Nothing -> show $tagLine ti
188 Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
191 escapeSlashes '/' r = '\\' : '/' : r
192 escapeSlashes '\\' r = '\\' : '\\' : r
193 escapeSlashes c r = c : r
196 -- etags format, for Emacs/XEmacs
197 showETag :: TagInfo -> String
198 showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
199 tagSrcInfo = Just (srcLine,charPos) }
200 = take colNo srcLine ++ tag
202 ++ "\x01" ++ show lineNo
203 ++ "," ++ show charPos
204 showETag _ = ghcError (CmdLineError "missing source file info in showETag")