1 -----------------------------------------------------------------------------
3 -- GHCi's :ctags and :etags commands
5 -- (c) The GHC Team 2005-2007
7 -----------------------------------------------------------------------------
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 module GhciTags (createCTagsFileCmd, createETagsFileCmd) where
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)
29 import Control.Exception
33 import System.IO.Error as IO
35 -----------------------------------------------------------------------------
36 -- create tags file for currently loaded modules.
38 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
40 createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags"
41 createCTagsFileCmd file = ghciCreateTagsFile CTags file
43 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
44 createETagsFileCmd file = ghciCreateTagsFile ETags file
46 data TagsKind = ETags | CTags
48 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
49 ghciCreateTagsFile kind file = do
51 io $ createTagsFile session kind file
54 -- - remove restriction that all modules must be interpreted
55 -- (problem: we don't know source locations for entities unless
56 -- we compiled the module.
58 -- - extract createTagsFile so it can be used from the command-line
59 -- (probably need to fix first problem before this is useful).
61 createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
62 createTagsFile session tagskind tagFile = do
63 graph <- GHC.getModuleGraph session
64 let ms = map GHC.ms_mod graph
66 is_interpreted <- GHC.moduleIsInterpreted session m
67 -- should we just skip these?
68 when (not is_interpreted) $
69 throwDyn (CmdLineError ("module '"
70 ++ GHC.moduleNameString (GHC.moduleName m)
71 ++ "' is not interpreted"))
72 mbModInfo <- GHC.getModuleInfo session m
76 mb_print_unqual <- GHC.mkPrintUnqualifiedForModule session minf
77 return (fromMaybe GHC.alwaysQualify mb_print_unqual)
79 return GHC.alwaysQualify
81 Just modInfo -> return $! listTags unqual modInfo
84 mtags <- mapM tagModule ms
85 either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
87 Left e -> hPutStrLn stderr $ ioeGetErrorString e
90 listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
91 listTags unqual modInfo =
92 [ tagInfo unqual name loc
93 | name <- GHC.modInfoExports modInfo
94 , let loc = srcSpanStart (nameSrcSpan name)
98 type TagInfo = (String -- tag name
101 ,Int -- column number
104 -- get tag info, for later translation into Vim or Emacs style
105 tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
106 tagInfo unqual name loc
107 = ( showSDocForUser unqual $ pprOccName (nameOccName name)
108 , showSDocForUser unqual $ ftext (srcLocFile loc)
113 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
114 collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
115 let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
116 IO.try (writeFile file tags)
117 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
118 let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
119 groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
120 tagGroups <- mapM tagFileGroup groups
121 IO.try (writeFile file $ concat tagGroups)
123 tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
124 tagFileGroup group@((_,fileName,_,_):_) = do
125 file <- readFile fileName -- need to get additional info from sources..
126 let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
127 sortedGroup = sortLe byLine group
128 tags = unlines $ perFile sortedGroup 1 0 $ lines file
129 return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
130 perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
131 perFile (tagInfo:tags) (count+1) (pos+length line) lines
132 perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
133 showETag tagInfo line pos : perFile tags count pos lines
134 perFile tags count pos lines = []
136 -- simple ctags format, for Vim et al
137 showTag :: TagInfo -> String
138 showTag (tag,file,lineNo,colNo)
139 = tag ++ "\t" ++ file ++ "\t" ++ show lineNo
141 -- etags format, for Emacs/XEmacs
142 showETag :: TagInfo -> String -> Int -> String
143 showETag (tag,file,lineNo,colNo) line charPos
144 = take colNo line ++ tag
146 ++ "\x01" ++ show lineNo
147 ++ "," ++ show charPos