sizes 2.0.4 → 2.0.5
raw patch · 2 files changed
+52/−59 lines, 2 files
Files
- Main.hs +49/−57
- sizes.cabal +3/−2
Main.hs view
@@ -33,7 +33,7 @@ default (Integer, Text) version :: String-version = "2.0.4"+version = "2.0.5" copyright :: String copyright = "2012"@@ -77,8 +77,8 @@ &= help "Also show small (<1M && <100 files) entries" -- , dirsOnly = def &= typ "BOOL" -- &= help "Show directories only"- , depth = def &= typ "INT"- &= help "Report entries to a depth of INT (default: 0)"+ , depth = def &= typ "INT" &= opt (1 :: Int)+ &= help "Report entries to a depth of INT (default: 1)" , dirs = def &= args &= typ "DIRS..." } &= summary sizesSummary &= program "sizes" &=@@ -108,7 +108,7 @@ main = do mainArgs <- getArgs opts <- withArgs (if L.null mainArgs then [] else mainArgs)- (cmdArgs sizesOpts)+ (cmdArgs sizesOpts) _ <- GHC.Conc.setNumCapabilities $ case jobs opts of 0 -> 2; x -> x runSizes opts @@ -145,7 +145,7 @@ opts' = if blockSize opts == 0 then opts { blockSize = fromIntegral fsBlkSize } else opts- in gatherSizesW opts' 0+ in gatherSizes opts' 0 humanReadable :: Int -> String humanReadable x@@ -173,71 +173,63 @@ returnEmpty :: FilePath -> IO (EntryInfo, DList EntryInfo) returnEmpty path = return (newEntry path False, DL.empty) -gatherSizesW :: SizesOpts -> Int -> FilePath -> IO (EntryInfo, DList EntryInfo)-gatherSizesW opts d p =- catch (gatherSizes opts d p)- (\e -> print (e :: IOException) >> returnEmpty p)-{-# INLINE gatherSizesW #-}- gatherSizes :: SizesOpts -> Int -> FilePath -> IO (EntryInfo, DList EntryInfo) gatherSizes opts curDepth path =- gatherSizes' =<< if curDepth == 0- then getFileStatus path'- else getSymbolicLinkStatus path'+ catch (go =<< if curDepth == 0+ then getFileStatus path'+ else getSymbolicLinkStatus path')+ (\e -> do putStrLn $ path' ++ ": " ++ show (e :: IOException)+ returnEmpty path) where path' = unpack (toTextIgnore path) annexRe = unpack "\\.git/annex/"- minSize' = (if minSize opts == 0 then 10 else minSize opts) * 1024^2 - gatherSizes' status+ go status | not (L.null (exclude opts)) && path' =~ exclude opts = returnEmpty path | isDirectory status =- listDirectory path- >>= mapAndUnzipM (gatherSizesW opts (curDepth + 1) . collapse)- >>= \(xs, ys) ->- let x = mconcat (newEntry path True : xs)- in return (x, if curDepth < depth opts- then DL.append (DL.fromList xs) (mconcat ys)- else DL.empty)+ foldM (\(y, ys) x -> do+ (x',xs') <- gatherSizes opts (curDepth + 1) (collapse x)+ let x'' = y <> x'+ xs'' = if curDepth < depth opts+ then ys <> DL.singleton x' <> xs'+ else DL.empty+ return $! x'' `seq` xs'' `seq` (x'', xs''))+ (newEntry path True, DL.empty) =<< listDirectory path | (isRegularFile status && not (annex opts && path' =~ annexRe))- || (annex opts && isSymbolicLink status) =- catch (getFileSize status)- (\e -> print (e :: IOException) >> returnEmpty path)-- | otherwise = returnEmpty path+ || (annex opts && isSymbolicLink status) = do+ status' <-+ -- If status is for a symbolic link, it must be a Git-annex'd file+ if isSymbolicLink status+ then do+ destPath <- readSymbolicLink path'+ if destPath =~ annexRe+ then do+ let destFilePath = fromText (T.pack destPath)+ destPath' = if relative destFilePath+ then T.unpack . toTextIgnore $+ parent path </> destFilePath+ else destPath+ destFilePath' = fromText (T.pack destPath')+ exists <- isFile destFilePath'+ if exists+ then getFileStatus destPath'+ else return status+ else return status+ else return status - -- If status is for a symbolic link, it must be a Git-annex'd file- getFileSize status = do- status' <-- if isSymbolicLink status- then do- destPath <- readSymbolicLink path'- if destPath =~ annexRe- then do- let destFilePath = fromText (T.pack destPath)- destPath' = if relative destFilePath- then T.unpack . toTextIgnore $- parent path </> destFilePath- else destPath- destFilePath' = fromText (T.pack destPath')- exists <- isFile destFilePath'- if exists- then getFileStatus destPath'- else return status- else return status- else return status+ let fsize = fileSize status'+ blksize = fileBlockSize (unsafeCoerce status')+ allocSize = if apparent opts+ then fromIntegral fsize+ else fromIntegral blksize * blockSize opts - let fsize = fileSize status'- blksize = fileBlockSize (unsafeCoerce status')- allocSize = if apparent opts- then fromIntegral fsize- else fromIntegral blksize * blockSize opts+ return (EntryInfo { _entryPath = path+ , _entryCount = 1+ , _entryAllocSize = allocSize+ , _entryIsDir = False }, DL.empty) - return (EntryInfo { _entryPath = path- , _entryCount = 1- , _entryAllocSize = allocSize- , _entryIsDir = False }, DL.empty)+ | otherwise = returnEmpty path -- Main.hs (sizes) ends here
sizes.cabal view
@@ -1,6 +1,6 @@ Name: sizes -Version: 2.0.4+Version: 2.0.5 Synopsis: Recursively show space (size and i-nodes) used in subdirectories Description: Recursively show space (size and i-nodes) used in subdirectories@@ -22,7 +22,8 @@ Include-dirs: . Includes: HsStat.h c-sources: HsStat.c- ghc-options: -threaded -with-rtsopts=-K16M+-- ghc-options: -debug+ ghc-options: -threaded -with-rtsopts=-K64M Build-depends: base >= 4 && < 5 , bytestring