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