ghc/utils/hasktags/HaskTags.hs

   1 module Main where
   2 import System
   3 import Char
   4 import List
   5
   6
   7 -- search for definitions of things
   8 -- we do this by looking for the following patterns:
   9 -- data XXX = ...      giving a datatype location
  10 -- newtype XXX = ...   giving a newtype location
  11 -- bla :: ...          giving a function location
  12 --
  13 -- by doing it this way, we avoid picking up local definitions
  14
  15
  16 main :: IO ()
  17 main = do
  18         filenames <- getArgs
  19         foundthings <- mapM findthings filenames
  20         mapM_ (\x -> putStrLn $ dumpthing x) (concat foundthings)
  21
  22 type FileName = String
  23
  24 type ThingName = String
  25
  26 data Pos = Pos FileName Int
  27         deriving Show
  28
  29 data FoundThing = FoundThing ThingName Pos
  30         deriving Show
  31
  32 dumpthing :: FoundThing -> String
  33 dumpthing (FoundThing name (Pos filename line)) =
  34         name ++ "\t" ++ filename ++ "\t" ++ (show line)
  35
  36 data Token = Token String Pos
  37         deriving Show
  38
  39 findthings :: FileName -> IO [FoundThing]
  40 findthings filename =
  41         do
  42                 text <- readFile filename
  43                 let aslines = lines text
  44                 let wordlines = map words aslines
  45                 let nocoms = map stripslcomments wordlines
  46                 let tokens = concat $ zipWith (withline filename) nocoms $ ints 0
  47                 return $ findstuff tokens
  48
  49 withline :: FileName -> [String] -> Int -> [Token]
  50 withline fname words i = map (\w -> Token w (Pos fname i)) words
  51
  52 stripslcomments :: [String] -> [String]
  53 stripslcomments ("--":xs) = []
  54 stripslcomments (x:xs) = x : stripslcomments xs
  55 stripslcomments [] = []
  56
  57 ints :: Int -> [Int]
  58 ints i = i:(ints $ i+1)
  59
  60 findstuff :: [Token] -> [FoundThing]
  61 findstuff ((Token "data" _):(Token name pos):xs) =
  62         FoundThing name pos : (getcons xs) ++ (findstuff xs)
  63 findstuff ((Token "type" _):(Token name pos):xs) =
  64         FoundThing name pos : findstuff xs
  65 findstuff ((Token name pos):(Token "::" _):xs) =
  66         FoundThing name pos : findstuff xs
  67 findstuff (x:xs) = findstuff xs
  68 findstuff [] = []
  69
  70
  71 -- get the constructor definitions, knowing that a datatype has just started
  72
  73 getcons :: [Token] -> [FoundThing]
  74 getcons ((Token "=" _):(Token name pos):xs) =
  75         FoundThing name pos : getcons2 xs
  76 getcons (x:xs) = getcons xs
  77 getcons [] = []
  78
  79
  80 getcons2 ((Token "=" _):xs) = []
  81 getcons2 ((Token "|" _):(Token name pos):xs) =
  82         FoundThing name pos : getcons2 xs
  83 getcons2 (x:xs) = getcons2 xs
  84 getcons2 [] = []
  85
  86