utils/compare_sizes/Main.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             `catchIO` \_ -> -- XXX We ought to check this is a
  93                             -- "not a directory" exception really
  94                       if isFileInteresting e
  95                       then do let fn = dir' <//> e
  96                               h <- openFile (root </> fn) ReadMode
  97                               size <- hFileSize h
  98                               hClose h
  99                               return $ Just $ File e fn size
 100                       else return Nothing
 101
 102 catchIO :: IO a -> (IOError -> IO a) -> IO a
 103 catchIO = catch
 104
 105 ----------------------------------------------------------------------
 106 -- Comparing the trees
 107
 108 data Difference = Difference FilePath Size Size Percentage
 109     deriving Show
 110
 111 compareTree :: Tree -> Tree -> [Difference]
 112 compareTree (Directory _ ts1) (Directory _ ts2) = compareTrees ts1 ts2
 113 compareTree (File _ fn s1) (File _ _ s2)
 114     = [Difference fn s1 s2 (mkPercentage s1 s2)]
 115 compareTree _ _ = []
 116
 117 mkPercentage :: Size -> Size -> Percentage
 118 mkPercentage s1 s2 = fromIntegral (s2 - s1) / fromIntegral s1
 119
 120 compareTrees :: [Tree] -> [Tree] -> [Difference]
 121 compareTrees t1s@(t1 : t1s') t2s@(t2 : t2s')
 122     = case nodeName t1 `compare` nodeName t2 of
 123       LT ->                      compareTrees t1s' t2s
 124       EQ -> compareTree t1 t2 ++ compareTrees t1s' t2s'
 125       GT ->                      compareTrees t1s  t2s'
 126 compareTrees _ _ = []
 127
 128 showDifferences :: [Difference] -> [String]
 129 showDifferences ds = showTable [lpad, lpad, rpad]
 130                      (["Size", "Change", "Filename"] :
 131                       map showDifference ds)
 132
 133 showDifference :: Difference -> [String]
 134 showDifference (Difference fp s1 _ percentage)
 135     = [show s1, showFFloat (Just 2) percentage "%", shorten fp]
 136
 137 shorten :: FilePath -> FilePath
 138 shorten fp = let xs = map joinPath $ tails $ splitDirectories fp
 139              in case xs of
 140                 x : _
 141                  | length x <= allowed ->
 142                     x
 143                 _ -> case dropWhile ((> allowed - 4) . length) xs of
 144                      x : _ ->
 145                          "..." </> x
 146                      [] ->
 147                          take (allowed - 3) (takeFileName fp) ++ "..."
 148     where allowed = 50
 149
 150 comparingPercentage :: Difference -> Difference -> Ordering
 151 comparingPercentage (Difference _ _ _ p1) (Difference _ _ _ p2)
 152     = compare p1 p2
 153
 154 mkTotalDifference :: [Difference] -> Difference
 155 mkTotalDifference ds = let s1 = sum [ x | Difference _ x _ _ <- ds ]
 156                            s2 = sum [ x | Difference _ _ x _ <- ds ]
 157                            percentage = mkPercentage s1 s2
 158                        in Difference "TOTAL" s1 s2 percentage
 159
 160 ----------------------------------------------------------------------
 161 -- Utils
 162
 163 (<//>) :: FilePath -> FilePath -> FilePath
 164 "." <//> fp = fp
 165 dir <//> fn = dir </> fn
 166
 167 showTable :: [Int -> String -> String] -> [[String]] -> [String]
 168 showTable padders xss
 169     = let lengths = map (maximum . map length) $ transpose xss
 170       in map (concat . intersperse " | " . zipWith3 id padders lengths) xss
 171
 172 lpad :: Int -> String -> String
 173 lpad n s = replicate (n - length s) ' ' ++ s
 174
 175 rpad :: Int -> String -> String
 176 rpad n s = s ++ replicate (n - length s) ' '