Use haskeline, rather than editline, for line editing in ghci
[ghc.git] / ghc / GhciTags.hs
1 -----------------------------------------------------------------------------
2 --
3 -- GHCi's :ctags and :etags commands
4 --
5 -- (c) The GHC Team 2005-2007
6 --
7 -----------------------------------------------------------------------------
8
9 module GhciTags (createCTagsFileCmd, createETagsFileCmd) where
10
11 import GHC
12 import GhciMonad
13 import Outputable
14 import Util
15
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)
20 import MonadUtils
21
22 import Data.Maybe
23 import Panic
24 import Data.List
25 import Control.Monad
26 import System.IO
27 import System.IO.Error as IO
28
29 -----------------------------------------------------------------------------
30 -- create tags file for currently loaded modules.
31
32 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
33
34 createCTagsFileCmd "" = ghciCreateTagsFile CTags "tags"
35 createCTagsFileCmd file = ghciCreateTagsFile CTags file
36
37 createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS"
38 createETagsFileCmd file = ghciCreateTagsFile ETags file
39
40 data TagsKind = ETags | CTags
41
42 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
43 ghciCreateTagsFile kind file = do
44 createTagsFile kind file
45
46 -- ToDo:
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.
50 --
51 -- - extract createTagsFile so it can be used from the command-line
52 -- (probably need to fix first problem before this is useful).
53 --
54 createTagsFile :: TagsKind -> FilePath -> GHCi ()
55 createTagsFile tagskind tagFile = do
56 graph <- GHC.getModuleGraph
57 let ms = map GHC.ms_mod graph
58 tagModule m = do
59 is_interpreted <- GHC.moduleIsInterpreted m
60 -- should we just skip these?
61 when (not is_interpreted) $
62 ghcError (CmdLineError ("module '"
63 ++ GHC.moduleNameString (GHC.moduleName m)
64 ++ "' is not interpreted"))
65 mbModInfo <- GHC.getModuleInfo m
66 unqual <-
67 case mbModInfo of
68 Just minf -> do
69 mb_print_unqual <- GHC.mkPrintUnqualifiedForModule minf
70 return (fromMaybe GHC.alwaysQualify mb_print_unqual)
71 Nothing ->
72 return GHC.alwaysQualify
73 case mbModInfo of
74 Just modInfo -> return $! listTags unqual modInfo
75 _ -> return []
76
77 mtags <- mapM tagModule ms
78 either_res <- liftIO $ collateAndWriteTags tagskind tagFile $ concat mtags
79 case either_res of
80 Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
81 Right _ -> return ()
82
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)
88 , isGoodSrcLoc loc
89 ]
90
91 type TagInfo = (String -- tag name
92 ,String -- file name
93 ,Int -- line number
94 ,Int -- column number
95 )
96
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)
102 , srcLocLine loc
103 , srcLocCol loc
104 )
105
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)
115 where
116 tagFileGroup [] = ghcError (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
126 perFile _ _ _ _ = []
127
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
132
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
137 ++ "\x7f" ++ tag
138 ++ "\x01" ++ show lineNo
139 ++ "," ++ show charPos
140