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