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)
21 import Control.Exception
25 import System.IO.Error as IO
27 -----------------------------------------------------------------------------
28 -- create tags file for currently loaded modules.
30 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
32 createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags"
33 createCTagsFileCmd file = ghciCreateTagsFile CTags file
35 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
36 createETagsFileCmd file = ghciCreateTagsFile ETags file
38 data TagsKind = ETags | CTags
40 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
41 ghciCreateTagsFile kind file = do
43 io $ createTagsFile session kind file
46 -- - remove restriction that all modules must be interpreted
47 -- (problem: we don't know source locations for entities unless
48 -- we compiled the module.
50 -- - extract createTagsFile so it can be used from the command-line
51 -- (probably need to fix first problem before this is useful).
53 createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
54 createTagsFile session tagskind tagFile = do
55 graph <- GHC.getModuleGraph session
56 let ms = map GHC.ms_mod graph
58 is_interpreted <- GHC.moduleIsInterpreted session m
59 -- should we just skip these?
60 when (not is_interpreted) $
61 throwDyn (CmdLineError ("module '"
62 ++ GHC.moduleNameString (GHC.moduleName m)
63 ++ "' is not interpreted"))
64 mbModInfo <- GHC.getModuleInfo session m
66 | Just modinfo <- mbModInfo,
67 Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
68 | otherwise = GHC.alwaysQualify
71 Just modInfo -> return $! listTags unqual modInfo
74 mtags <- mapM tagModule ms
75 either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
77 Left e -> hPutStrLn stderr $ ioeGetErrorString e
80 listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
81 listTags unqual modInfo =
82 [ tagInfo unqual name loc
83 | name <- GHC.modInfoExports modInfo
84 , let loc = nameSrcLoc name
88 type TagInfo = (String -- tag name
94 -- get tag info, for later translation into Vim or Emacs style
95 tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
96 tagInfo unqual name loc
97 = ( showSDocForUser unqual $ pprOccName (nameOccName name)
98 , showSDocForUser unqual $ ftext (srcLocFile loc)
103 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
104 collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
105 let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
106 IO.try (writeFile file tags)
107 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
108 let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
109 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
110 tagGroups <- mapM tagFileGroup groups
111 IO.try (writeFile file $ concat tagGroups)
113 tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
114 tagFileGroup group@((_,fileName,_,_):_) = do
115 file <- readFile fileName -- need to get additional info from sources..
116 let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
117 sortedGroup = sortLe byLine group
118 tags = unlines $ perFile sortedGroup 1 0 $ lines file
119 return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
120 perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
121 perFile (tagInfo:tags) (count+1) (pos+length line) lines
122 perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
123 showETag tagInfo line pos : perFile tags count pos lines
124 perFile tags count pos lines = []
126 -- simple ctags format, for Vim et al
127 showTag :: TagInfo -> String
128 showTag (tag,file,lineNo,colNo)
129 = tag ++ "\t" ++ file ++ "\t" ++ show lineNo
131 -- etags format, for Emacs/XEmacs
132 showETag :: TagInfo -> String -> Int -> String
133 showETag (tag,file,lineNo,colNo) line charPos
134 = take colNo line ++ tag
136 ++ "\x01" ++ show lineNo
137 ++ "," ++ show charPos