utils/compare_sizes/compareSizes.hs

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