utils/compare_sizes/compareSizes.hs

   1 -- This program compares the sizes of corresponding files in two tress
   2
   3 --   $ ./compareSizes --hi ~/ghc/darcs/ghc ~/ghc/6.12-branch/ghc
   4 --        Size | Change | Filename
   5 --      25644 | -0.99% | compiler/stage1/build/Demand.hi
   6 --      21103 | -0.98% | compiler/stage2/build/Demand.hi
   7 --     180044 | -0.98% | libraries/base/dist-install/build/GHC/Classes.hi
   8 --       6415 | -0.58% | .../Data/Array/Parallel/Prelude/Base/Tuple.hi
   9 --       6507 | -0.57% | .../Data/Array/Parallel/Prelude/Base/Tuple.hi
  10 --   [...]
  11 --       3264 |  3.16% | .../Parallel/Unlifted/Sequential/Flat/Enum.hi
  12 --      51389 |  3.30% | .../build/Language/Haskell/Extension.hi
  13 --       1415 | 72.18% | libraries/base/dist-install/build/Data/Tuple.hi
  14 --   28752162 | -0.00% | TOTAL
  15
  16 -- Flags:
  17 --    --o to compare object files.
  18 --    --hi to compare interface files [DEFAULT]
  19
  20 -- There's a hack to avoid descending into '*_split' directories
  21
  22
  23 module Main (main) where
  24
  25 import Control.Exception
  26 import Control.Monad
  27 import Data.List
  28 import Data.Maybe
  29 import Numeric
  30 import Prelude hiding (catch)
  31 import System.Directory
  32 import System.Environment
  33 import System.FilePath
  34 import System.IO
  35
  36 main :: IO ()
  37 main = do hSetBuffering stdout LineBuffering
  38           args <- getArgs
  39           case args of
  40               ["--hi", dir1, dir2] -> doit isHiFile dir1 dir2
  41               ["--o", dir1, dir2]  -> doit isOFile  dir1 dir2
  42               [dir1, dir2]         -> doit isHiFile dir1 dir2
  43               _ -> error "Bad arguments"
  44
  45 isHiFile :: FilePath -> Bool
  46 isHiFile = (".hi" `isSuffixOf`)
  47
  48 isOFile :: FilePath -> Bool
  49 isOFile = (".o" `isSuffixOf`)
  50
  51 doit :: (FilePath -> Bool) -> FilePath -> FilePath -> IO ()
  52 doit isFileInteresting dir1 dir2
  53     = do when verbose $ putStrLn "Reading tree 1"
  54          tree1 <- getTree isFileInteresting dir1 "." "."
  55          when verbose $ putStrLn "Reading tree 2"
  56          tree2 <- getTree isFileInteresting dir2 "." "."
  57          when verbose $ putStrLn "Comparing trees"
  58          let ds = compareTree tree1 tree2
  59              ds' = sortBy comparingPercentage ds
  60              total = mkTotalDifference ds'
  61          mapM_ putStrLn $ showDifferences (ds' ++ [total])
  62
  63 verbose :: Bool
  64 verbose = False
  65
  66 ----------------------------------------------------------------------
  67 -- Reading the trees
  68
  69 data Tree = Directory { nodeName :: FilePath, _subTrees :: [Tree] }
  70           | File      { nodeName :: FilePath, _filePath :: FilePath,
  71                                               _size :: Size }
  72     deriving Show
  73
  74 type Size = Integer
  75 type Percentage = Double
  76
  77 getTree :: (FilePath -> Bool) -> FilePath -> FilePath -> FilePath -> IO Tree
  78 getTree isFileInteresting root dir subdir
  79     = do entries <- getDirectoryContents (root </> dir </> subdir)
  80          mSubtrees <- mapM doEntry $ sort $ filter interesting entries
  81          return $ Directory subdir $ catMaybes mSubtrees
  82     where interesting "."  = False
  83           interesting ".." = False
  84           -- We don't want to descend into object-splitting directories,
  85           -- and compare the hundreds of split object files. Instead we
  86           -- just compare the combined object file outside of the _split
  87           -- directory.
  88           interesting d    = not ("_split" `isSuffixOf` d)
  89           dir' = dir <//> subdir
  90           doEntry :: FilePath -> IO (Maybe Tree)
  91           doEntry e = liftM Just (getTree isFileInteresting root dir' e)
  92               `catch` \_ -> -- XXX Do this better
  93                       if isFileInteresting e
  94                       then do let fn = dir' <//> e
  95                               h <- openFile (root </> fn) ReadMode
  96                               size <- hFileSize h
  97                               hClose h
  98                               return $ Just $ File e fn size
  99                       else return Nothing
 100
 101 ----------------------------------------------------------------------
 102 -- Comparing the trees
 103
 104 data Difference = Difference FilePath Size Size Percentage
 105     deriving Show
 106
 107 compareTree :: Tree -> Tree -> [Difference]
 108 compareTree (Directory _ ts1) (Directory _ ts2) = compareTrees ts1 ts2
 109 compareTree (File _ fn s1) (File _ _ s2)
 110     = [Difference fn s1 s2 (mkPercentage s1 s2)]
 111 compareTree _ _ = []
 112
 113 mkPercentage :: Size -> Size -> Percentage
 114 mkPercentage s1 s2 = fromIntegral (s2 - s1) / fromIntegral s1
 115
 116 compareTrees :: [Tree] -> [Tree] -> [Difference]
 117 compareTrees t1s@(t1 : t1s') t2s@(t2 : t2s')
 118     = case nodeName t1 `compare` nodeName t2 of
 119       LT ->                      compareTrees t1s' t2s
 120       EQ -> compareTree t1 t2 ++ compareTrees t1s' t2s'
 121       GT ->                      compareTrees t1s  t2s'
 122 compareTrees _ _ = []
 123
 124 showDifferences :: [Difference] -> [String]
 125 showDifferences ds = showTable [lpad, lpad, rpad]
 126                      (["Size", "Change", "Filename"] :
 127                       map showDifference ds)
 128
 129 showDifference :: Difference -> [String]
 130 showDifference (Difference fp s1 _ percentage)
 131     = [show s1, showFFloat (Just 2) percentage "%", shorten fp]
 132
 133 shorten :: FilePath -> FilePath
 134 shorten fp = let xs = map joinPath $ tails $ splitDirectories fp
 135              in case xs of
 136                 x : _
 137                  | length x <= allowed ->
 138                     x
 139                 _ -> case dropWhile ((> allowed - 4) . length) xs of
 140                      x : _ ->
 141                          "..." </> x
 142                      [] ->
 143                          take (allowed - 3) (takeFileName fp) ++ "..."
 144     where allowed = 50
 145
 146 comparingPercentage :: Difference -> Difference -> Ordering
 147 comparingPercentage (Difference _ _ _ p1) (Difference _ _ _ p2)
 148     = compare p1 p2
 149
 150 mkTotalDifference :: [Difference] -> Difference
 151 mkTotalDifference ds = let s1 = sum [ x | Difference _ x _ _ <- ds ]
 152                            s2 = sum [ x | Difference _ _ x _ <- ds ]
 153                            percentage = mkPercentage s1 s2
 154                        in Difference "TOTAL" s1 s2 percentage
 155
 156 ----------------------------------------------------------------------
 157 -- Utils
 158
 159 (<//>) :: FilePath -> FilePath -> FilePath
 160 "." <//> fp = fp
 161 dir <//> fn = dir </> fn
 162
 163 showTable :: [Int -> String -> String] -> [[String]] -> [String]
 164 showTable padders xss
 165     = let lengths = map (maximum . map length) $ transpose xss
 166       in map (concat . intersperse " | " . zipWith3 id padders lengths) xss
 167
 168 lpad :: Int -> String -> String
 169 lpad n s = replicate (n - length s) ' ' ++ s
 170
 171 rpad :: Int -> String -> String
 172 rpad n s = s ++ replicate (n - length s) ' '