Add a size-comparison util
[ghc.git] / 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) ' '