cabal-dev-scripts/src/AnalyseImports.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 module Main (main) where
   3
   4 import Control.Applicative    (liftA2, many, (<|>))
   5 import Control.Monad          (void)
   6 import Data.Foldable          (for_)
   7 import Data.List              (sortBy)
   8 import Data.Maybe             (fromMaybe)
   9 import Data.Ord               (comparing)
  10 import Language.Haskell.Lexer (PosToken, Token (..), lexerPass0)
  11 import System.Environment     (getArgs)
  12 import Text.Regex.Applicative (RE)
  13
  14 import qualified Data.Map.Strict        as Map
  15 import qualified Text.Regex.Applicative as RE
  16
  17 main :: IO ()
  18 main = do
  19     args <- getArgs
  20
  21     data_ <- traverse processFile args
  22
  23     putStrLn "Modules"
  24     let modules = sortBy (flip $ comparing snd) $ Map.toList $ Map.fromListWith (+)
  25           [ (mn, 1 :: Int)
  26           | xs <- data_
  27           , (mn, _) <- xs
  28           ]
  29
  30     for_ (take 30 modules) $ \(mn, n) ->
  31         putStrLn $ mn ++ "  " ++ show n
  32
  33     putStrLn ""
  34
  35     putStrLn "Symbols"
  36     let symbols = sortBy (flip $ comparing snd) $ Map.toList $ Map.fromListWith (+)
  37           [ ((mn,sym), 1 :: Int)
  38           | xs <- data_
  39           , (mn, syms) <- xs
  40           , sym <- syms
  41           ]
  42
  43     for_ (take 50 symbols) $ \((mn,sym), n) ->
  44         putStrLn $ mn ++ "." ++ sym ++ "  " ++ show n
  45
  46 processFile :: FilePath -> IO [(String, [String])]
  47 processFile fp = do
  48     contents <- readFile fp
  49     let tokens = filter (\(t, _) -> t `notElem` [Whitespace, Comment, Commentstart, NestedComment])
  50                $ lexerPass0 contents
  51
  52     return $ fromMaybe [] $ RE.match (somewhere imports) tokens
  53
  54 imports :: RE PosToken (String, [String])
  55 imports = (,)
  56     <$ reservedid "import" <*> (conid <|> qconid) <*> msymbols
  57   where
  58     msymbols :: RE PosToken [String]
  59     msymbols =special "(" *> symbols <* special ")" <|> pure []
  60
  61     symbols :: RE PosToken [String]
  62     symbols = liftA2 (:) symbol $ many (special "," *> symbol)
  63
  64     symbol :: RE PosToken String
  65     symbol = varid <|> special "(" *> varsym <* special ")"
  66
  67
  68 -------------------------------------------------------------------------------
  69 -- regex-applicative + haskell-lexer
  70 -------------------------------------------------------------------------------
  71
  72 anything :: RE s ()
  73 anything = void $ RE.few RE.anySym
  74
  75 somewhere :: RE s a -> RE s [a]
  76 somewhere re = anything *> RE.few (re <* anything)
  77
  78 reservedid :: String -> RE PosToken ()
  79 reservedid k = RE.msym $ \case
  80     (Reservedid, (_, k')) | k == k' -> Just ()
  81     _                               -> Nothing
  82
  83 special :: String -> RE PosToken ()
  84 special k = RE.msym $ \case
  85     (Special, (_, k')) | k == k' -> Just ()
  86     _                            -> Nothing
  87
  88 conid :: RE PosToken String
  89 conid = RE.msym $ \case
  90     (Conid, (_, k)) -> Just k
  91     _               -> Nothing
  92
  93 qconid :: RE PosToken String
  94 qconid = RE.msym $ \case
  95     (Qconid, (_, k)) -> Just k
  96     _                -> Nothing
  97
  98 varid :: RE PosToken String
  99 varid = RE.msym $ \case
 100     (Varid, (_, k)) -> Just k
 101     _               -> Nothing
 102
 103 varsym :: RE PosToken String
 104 varsym = RE.msym $ \case
 105     (Varsym, (_, k)) -> Just k
 106     _                -> Nothing