1 -- This program compares the sizes of corresponding files in two tress
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
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
17 -- --o to compare object files.
18 -- --hi to compare interface files [DEFAULT]
20 -- There's a hack to avoid descending into '*_split' directories
23 module Main (main) where
25 import Control.Exception
30 import Prelude hiding (catch)
31 import System.Directory
32 import System.Environment
33 import System.FilePath
37 main = do hSetBuffering stdout LineBuffering
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"
45 isHiFile :: FilePath -> Bool
46 isHiFile = (".hi" `isSuffixOf`)
48 isOFile :: FilePath -> Bool
49 isOFile = (".o" `isSuffixOf`)
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])
66 ----------------------------------------------------------------------
69 data Tree = Directory { nodeName :: FilePath, _subTrees :: [Tree] }
70 | File { nodeName :: FilePath, _filePath :: FilePath,
75 type Percentage = Double
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
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
99 return $ Just $ File e fn size
102 catchIO :: IO a -> (IOError -> IO a) -> IO a
105 ----------------------------------------------------------------------
106 -- Comparing the trees
108 data Difference = Difference FilePath Size Size Percentage
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)]
117 mkPercentage :: Size -> Size -> Percentage
118 mkPercentage s1 s2 = fromIntegral (s2 - s1) / fromIntegral s1
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 _ _ = []
128 showDifferences :: [Difference] -> [String]
129 showDifferences ds = showTable [lpad, lpad, rpad]
130 (["Size", "Change", "Filename"] :
131 map showDifference ds)
133 showDifference :: Difference -> [String]
134 showDifference (Difference fp s1 _ percentage)
135 = [show s1, showFFloat (Just 2) percentage "%", shorten fp]
137 shorten :: FilePath -> FilePath
138 shorten fp = let xs = map joinPath $ tails $ splitDirectories fp
141 | length x <= allowed ->
143 _ -> case dropWhile ((> allowed - 4) . length) xs of
147 take (allowed - 3) (takeFileName fp) ++ "..."
150 comparingPercentage :: Difference -> Difference -> Ordering
151 comparingPercentage (Difference _ _ _ p1) (Difference _ _ _ p2)
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
160 ----------------------------------------------------------------------
163 (<//>) :: FilePath -> FilePath -> FilePath
165 dir <//> fn = dir </> fn
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
172 lpad :: Int -> String -> String
173 lpad n s = replicate (n - length s) ' ' ++ s
175 rpad :: Int -> String -> String
176 rpad n s = s ++ replicate (n - length s) ' '