8 -- search for definitions of things
9 -- we do this by looking for the following patterns:
10 -- data XXX = ... giving a datatype location
11 -- newtype XXX = ... giving a newtype location
12 -- bla :: ... giving a function location
14 -- by doing it this way, we avoid picking up local definitions
15 -- (whether this is good or not is a matter for debate)
18 -- We generate both CTAGS and ETAGS format tags files
19 -- The former is for use in most sensible editors, while EMACS uses ETAGS
25 filedata <- mapM findthings filenames
26 ctagsfile <- openFile "tags" WriteMode
27 etagsfile <- openFile "TAGS" WriteMode
28 writectagsfile ctagsfile filedata
29 writeetagsfile etagsfile filedata
33 type FileName = String
35 type ThingName = String
37 -- The position of a token or definition
42 String -- string that makes up that line
45 -- A definition we have found
46 data FoundThing = FoundThing ThingName Pos
49 -- Data we have obtained from a file
50 data FileData = FileData FileName [FoundThing]
53 data Token = Token String Pos
57 -- stuff for dealing with ctags output format
59 writectagsfile :: Handle -> [FileData] -> IO ()
60 writectagsfile ctagsfile filedata = do
61 let things = concat $ map getfoundthings filedata
62 mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
64 getfoundthings :: FileData -> [FoundThing]
65 getfoundthings (FileData filename things) = things
67 dumpthing :: FoundThing -> String
68 dumpthing (FoundThing name (Pos filename line _ _)) =
69 name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
72 -- stuff for dealing with etags output format
74 writeetagsfile :: Handle -> [FileData] -> IO ()
75 writeetagsfile etagsfile filedata = do
76 mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
78 e_dumpfiledata :: FileData -> String
79 e_dumpfiledata (FileData filename things) =
80 "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
82 thingsdump = concat $ map e_dumpthing things
83 thingslength = length thingsdump
85 e_dumpthing :: FoundThing -> String
86 e_dumpthing (FoundThing name (Pos filename line token fullline)) =
87 (concat $ take (token + 1) $ spacedwords fullline)
88 ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
91 -- like "words", but keeping the whitespace, and so letting us build
94 spacedwords :: String -> [String]
96 spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
98 (blanks,rest) = span Char.isSpace xs
99 (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
102 -- Find the definitions in a file
104 findthings :: FileName -> IO FileData
105 findthings filename = do
106 text <- readFile filename
107 let aslines = lines text
108 let wordlines = map words aslines
109 let noslcoms = map stripslcomments wordlines
110 let tokens = concat $ zipWith3 (withline filename) noslcoms
112 let nocoms = stripblockcomments tokens
113 return $ FileData filename $ findstuff nocoms
115 -- Create tokens from words, by recording their line number
116 -- and which token they are through that line
118 withline :: FileName -> [String] -> String -> Int -> [Token]
119 withline filename words fullline i =
120 zipWith (\w t -> Token w (Pos filename i t fullline)) words $ [0 ..]
122 -- comments stripping
124 stripslcomments :: [String] -> [String]
125 stripslcomments (x:xs) | isPrefixOf "--" x = []
126 | otherwise = x : stripslcomments xs
127 stripslcomments [] = []
129 stripblockcomments :: [Token] -> [Token]
130 stripblockcomments ((Token "\\end{code}" _):xs) =
131 stripblockcomments $ afterlitend xs
132 stripblockcomments ((Token "{-" _):xs) =
133 stripblockcomments $ afterblockcomend xs
134 stripblockcomments (x:xs) = x:stripblockcomments xs
135 stripblockcomments [] = []
137 afterlitend2 :: [Token] -> [Token]
138 afterlitend2 (x:xs) = afterlitend xs
141 afterlitend :: [Token] -> [Token]
142 afterlitend ((Token "\\begin{code}" _):xs) = xs
143 afterlitend (x:xs) = afterlitend xs
146 afterblockcomend :: [Token] -> [Token]
147 afterblockcomend ((Token token _):xs) | contains "-}" token = xs
148 | otherwise = afterblockcomend xs
149 afterblockcomend [] = []
152 -- does one string contain another string
154 contains :: Eq a => [a] -> [a] -> Bool
155 contains sub full = any (isPrefixOf sub) $ tails full
158 ints i = i:(ints $ i+1)
161 -- actually pick up definitions
163 findstuff :: [Token] -> [FoundThing]
164 findstuff ((Token "data" _):(Token name pos):xs) =
165 FoundThing name pos : (getcons xs) ++ (findstuff xs)
166 findstuff ((Token "newtype" _):(Token name pos):xs) =
167 FoundThing name pos : findstuff xs
168 findstuff ((Token "type" _):(Token name pos):xs) =
169 FoundThing name pos : findstuff xs
170 findstuff ((Token name pos):(Token "::" _):xs) =
171 FoundThing name pos : findstuff xs
172 findstuff (x:xs) = findstuff xs
176 -- get the constructor definitions, knowing that a datatype has just started
178 getcons :: [Token] -> [FoundThing]
179 getcons ((Token "=" _):(Token name pos):xs) =
180 FoundThing name pos : getcons2 xs
181 getcons (x:xs) = getcons xs
185 getcons2 ((Token "=" _):xs) = []
186 getcons2 ((Token "|" _):(Token name pos):xs) =
187 FoundThing name pos : getcons2 xs
188 getcons2 (x:xs) = getcons2 xs