Add a size-comparison util

1 files changed, 151 insertions, 0 deletions

diff --git a/utils/compare_sizes/compareSizes.hs b/utils/compare_sizes/compareSizes.hs
new file mode 100644
index 0000000000..a1671eb207
--- /dev/null
+++ b/utils/compare_sizes/compareSizes.hs
@@ -0,0 +1,151 @@
+
+module Main (main) where
+
+import Control.Exception
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Numeric
+import Prelude hiding (catch)
+import System.Directory
+import System.Environment
+import System.FilePath
+import System.IO
+
+main :: IO ()
+main = do hSetBuffering stdout LineBuffering
+          args <- getArgs
+          case args of
+              ["--hi", dir1, dir2] -> doit isHiFile dir1 dir2
+              ["--o", dir1, dir2]  -> doit isOFile  dir1 dir2
+              [dir1, dir2]         -> doit isHiFile dir1 dir2
+              _ -> error "Bad arguments"
+
+isHiFile :: FilePath -> Bool
+isHiFile = (".hi" `isSuffixOf`)
+
+isOFile :: FilePath -> Bool
+isOFile = (".o" `isSuffixOf`)
+
+doit :: (FilePath -> Bool) -> FilePath -> FilePath -> IO ()
+doit isFileInteresting dir1 dir2
+    = do when verbose $ putStrLn "Reading tree 1"
+         tree1 <- getTree isFileInteresting dir1 "." "."
+         when verbose $ putStrLn "Reading tree 2"
+         tree2 <- getTree isFileInteresting dir2 "." "."
+         when verbose $ putStrLn "Comparing trees"
+         let ds = compareTree tree1 tree2
+             ds' = sortBy comparingPercentage ds
+             total = mkTotalDifference ds'
+         mapM_ putStrLn $ showDifferences (ds' ++ [total])
+
+verbose :: Bool
+verbose = False
+
+----------------------------------------------------------------------
+-- Reading the trees
+
+data Tree = Directory { nodeName :: FilePath, _subTrees :: [Tree] }
+          | File      { nodeName :: FilePath, _filePath :: FilePath,
+                                              _size :: Size }
+    deriving Show
+
+type Size = Integer
+type Percentage = Double
+
+getTree :: (FilePath -> Bool) -> FilePath -> FilePath -> FilePath -> IO Tree
+getTree isFileInteresting root dir subdir
+    = do entries <- getDirectoryContents (root </> dir </> subdir)
+         mSubtrees <- mapM doEntry $ sort $ filter interesting entries
+         return $ Directory subdir $ catMaybes mSubtrees
+    where interesting "."  = False
+          interesting ".." = False
+          -- We don't want to descend into object-splitting directories,
+          -- and compare the hundreds of split object files. Instead we
+          -- just compare the combined object file outside of the _split
+          -- directory.
+          interesting d    = not ("_split" `isSuffixOf` d)
+          dir' = dir <//> subdir
+          doEntry :: FilePath -> IO (Maybe Tree)
+          doEntry e = liftM Just (getTree isFileInteresting root dir' e)
+              `catch` \_ -> -- XXX Do this better
+                      if isFileInteresting e
+                      then do let fn = dir' <//> e
+                              h <- openFile (root </> fn) ReadMode
+                              size <- hFileSize h
+                              hClose h
+                              return $ Just $ File e fn size
+                      else return Nothing
+
+----------------------------------------------------------------------
+-- Comparing the trees
+
+data Difference = Difference FilePath Size Size Percentage
+    deriving Show
+
+compareTree :: Tree -> Tree -> [Difference]
+compareTree (Directory _ ts1) (Directory _ ts2) = compareTrees ts1 ts2
+compareTree (File _ fn s1) (File _ _ s2)
+    = [Difference fn s1 s2 (mkPercentage s1 s2)]
+compareTree _ _ = []
+
+mkPercentage :: Size -> Size -> Percentage
+mkPercentage s1 s2 = fromIntegral (s2 - s1) / fromIntegral s1
+
+compareTrees :: [Tree] -> [Tree] -> [Difference]
+compareTrees t1s@(t1 : t1s') t2s@(t2 : t2s')
+    = case nodeName t1 `compare` nodeName t2 of
+      LT ->                      compareTrees t1s' t2s
+      EQ -> compareTree t1 t2 ++ compareTrees t1s' t2s'
+      GT ->                      compareTrees t1s  t2s'
+compareTrees _ _ = []
+
+showDifferences :: [Difference] -> [String]
+showDifferences ds = showTable [lpad, lpad, rpad]
+                     (["Size", "Change", "Filename"] :
+                      map showDifference ds)
+
+showDifference :: Difference -> [String]
+showDifference (Difference fp s1 _ percentage)
+    = [show s1, showFFloat (Just 2) percentage "%", shorten fp]
+
+shorten :: FilePath -> FilePath
+shorten fp = let xs = map joinPath $ tails $ splitDirectories fp
+             in case xs of
+                x : _
+                 | length x <= allowed ->
+                    x
+                _ -> case dropWhile ((> allowed - 4) . length) xs of
+                     x : _ ->
+                         "..." </> x
+                     [] ->
+                         take (allowed - 3) (takeFileName fp) ++ "..."
+    where allowed = 50
+
+comparingPercentage :: Difference -> Difference -> Ordering
+comparingPercentage (Difference _ _ _ p1) (Difference _ _ _ p2)
+    = compare p1 p2
+
+mkTotalDifference :: [Difference] -> Difference
+mkTotalDifference ds = let s1 = sum [ x | Difference _ x _ _ <- ds ]
+                           s2 = sum [ x | Difference _ _ x _ <- ds ]
+                           percentage = mkPercentage s1 s2
+                       in Difference "TOTAL" s1 s2 percentage
+
+----------------------------------------------------------------------
+-- Utils
+
+(<//>) :: FilePath -> FilePath -> FilePath
+"." <//> fp = fp
+dir <//> fn = dir </> fn
+
+showTable :: [Int -> String -> String] -> [[String]] -> [String]
+showTable padders xss
+    = let lengths = map (maximum . map length) $ transpose xss
+      in map (concat . intersperse " | " . zipWith3 id padders lengths) xss
+
+lpad :: Int -> String -> String
+lpad n s = replicate (n - length s) ' ' ++ s
+
+rpad :: Int -> String -> String
+rpad n s = s ++ replicate (n - length s) ' '