sizes 2.0.3 → 2.0.4
raw patch · 2 files changed
+92/−94 lines, 2 filesdep +dlist
Dependencies added: dlist
Files
- Main.hs +89/−92
- sizes.cabal +3/−2
Main.hs view
@@ -4,16 +4,20 @@ module Main where +import Control.Applicative import Control.Concurrent.ParallelIO import Control.DeepSeq import Control.Exception import Control.Lens-import Control.Monad hiding (sequence)-import qualified Data.Text.Encoding as E+import Control.Monad+import Data.DList (DList)+import qualified Data.DList as DL import Data.Function import qualified Data.List as L import Data.Monoid import Data.Text as T hiding (filter, map, chunksOf)+import qualified Data.Text.Encoding as E+import Debug.Trace import Filesystem (listDirectory, isFile) import Filesystem.Path.CurrentOS import GHC.Conc@@ -25,12 +29,11 @@ import Text.Printf import Text.Regex.Posix import Unsafe.Coerce-import Debug.Trace default (Integer, Text) version :: String-version = "2.0.3"+version = "2.0.4" copyright :: String copyright = "2012"@@ -43,9 +46,9 @@ , annex :: Bool , apparent :: Bool , exclude :: String- , minSize :: Integer- , minCount :: Integer- , blockSize :: Integer+ , minSize :: Int+ , minCount :: Int+ , blockSize :: Int , smalls :: Bool -- , dirsOnly :: Bool , depth :: Int@@ -81,20 +84,25 @@ program "sizes" &= help "Calculate amount of disk used by the given directories" -data EntryInfo = EntryInfo { _entryPath :: !FilePath- , _entryCount :: !Integer- , _entryActualSize :: !Integer- , _entryAllocSize :: !Integer- , _entryIsDir :: !Bool }+data EntryInfo = EntryInfo { _entryPath :: FilePath+ , _entryCount :: Int+ , _entryAllocSize :: Int+ , _entryIsDir :: Bool } deriving Show makeLenses ''EntryInfo +newEntry :: FilePath -> Bool -> EntryInfo+newEntry p = EntryInfo p 0 0++instance Monoid EntryInfo where+ mempty = newEntry "" False+ x `mappend` y = seq x $ seq y $+ entryCount +~ y^.entryCount $+ entryAllocSize +~ y^.entryAllocSize $ x+ instance NFData EntryInfo where rnf a = a `seq` ()--newEntry :: FilePath -> Bool -> EntryInfo-newEntry p = EntryInfo p 0 0 0 main :: IO () main = do@@ -111,32 +119,35 @@ reportSizes opts $ map (fromText . pack) directories stopGlobalPool +reportEntryP :: SizesOpts -> EntryInfo -> Bool+reportEntryP opts entry = smalls opts+ || entry^.entryAllocSize >= minSize'+ || entry^.entryCount >= minCount'+ where+ minSize' = (if minSize opts == 0 then 10 else minSize opts) * 1024^2+ minCount' = if minCount opts == 0 then 100 else minCount opts+ reportSizes :: SizesOpts -> [FilePath] -> IO () reportSizes opts xs = do entryInfos <- parallel $ map reportSizesForDir xs- let infos = map fst entryInfos ++ mconcat (map snd entryInfos)- sorted = L.sortBy ((compare `on`) $ if byCount opts- then (^. entryCount)- else (^. entryAllocSize)) infos- forM_ sorted $ \entry ->- when ( smalls opts- || entry^.entryAllocSize >= minSize'- || entry^.entryCount >= minCount')- $ reportEntry entry+ let infos = map fst entryInfos +++ DL.toList (DL.concat (map snd entryInfos))+ sorted = L.sortBy ((compare `on`) $+ if byCount opts+ then (^. entryCount)+ else (^. entryAllocSize)) infos+ mapM_ reportEntry (filter (reportEntryP opts) sorted) where- reportSizesForDir dir = do- fsStatus <- getFilesystemStatus (E.encodeUtf8 (toTextIgnore dir))+ reportSizesForDir =+ -- fsStatus <- getFilesystemStatus (E.encodeUtf8 (toTextIgnore dir)) let fsBlkSize = statBlockSize -- filesystemBlockSize fsStatus opts' = if blockSize opts == 0 then opts { blockSize = fromIntegral fsBlkSize } else opts- gatherSizesW opts' 0 dir-- minSize' = (if minSize opts == 0 then 10 else minSize opts) * 1024^2- minCount' = (if minCount opts == 0 then 100 else minCount opts)+ in gatherSizesW opts' 0 -humanReadable :: Integer -> String+humanReadable :: Int -> String humanReadable x | x < 1024 = printf "%db" x | x < 1024^2 = printf "%.0fK" (fromIntegral x / (1024 :: Double))@@ -149,7 +160,7 @@ reportEntry :: EntryInfo -> IO () reportEntry entry =- let path = unpack . toTextIgnore $ entry^.entryPath+ let path = unpack (toTextIgnore (entry^.entryPath)) in printf (unpack "%10s %10d %s%s\n") (humanReadable (entry^.entryAllocSize)) (entry^.entryCount) path@@ -157,57 +168,45 @@ then "/" else "") toTextIgnore :: FilePath -> Text-toTextIgnore p = case toText p of Left _ -> ""; Right x -> x+toTextIgnore = either id id . toText -gatherSizesW :: SizesOpts -> Int -> FilePath -> IO (EntryInfo, [EntryInfo])+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 -> do- print (e :: IOException)- return (newEntry p False, []))--gatherSizes :: SizesOpts -> Int -> FilePath -> IO (EntryInfo, [EntryInfo])-gatherSizes opts curDepth path = do- status <- if curDepth == 0- then getFileStatus path'- else getSymbolicLinkStatus path'- gatherSizes' status+ (\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' where- path' = unpack $ toTextIgnore path-- annexRe = unpack "\\.git/annex/"+ path' = unpack (toTextIgnore path)+ annexRe = unpack "\\.git/annex/"+ minSize' = (if minSize opts == 0 then 10 else minSize opts) * 1024^2 gatherSizes' status- | (exclude opts) /= "" && path' =~ exclude opts = returnEmpty-- | isDirectory status = do- files <- listDirectory path- entries <- let func = gatherSizesW opts (curDepth + 1) . collapse- in if curDepth == 0- then parallel $ map func files- else mapM func files-- let firsts = map fst entries+ | not (L.null (exclude opts)) && path' =~ exclude opts = returnEmpty path - return $!! ( L.foldl' (\current entry ->- entryCount +~ entry^.entryCount $- entryActualSize +~ entry^.entryActualSize $- entryAllocSize +~ entry^.entryAllocSize $ current)- (newEntry path True)- firsts- , if curDepth <= depth opts- then firsts ++ L.concatMap snd entries- else [] )+ | 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) - | ( isRegularFile status- && not (annex opts && path' =~ annexRe))+ | (isRegularFile status && not (annex opts && path' =~ annexRe)) || (annex opts && isSymbolicLink status) = catch (getFileSize status)- (\e -> do print (e :: IOException)- returnEmpty)+ (\e -> print (e :: IOException) >> returnEmpty path) - | otherwise = returnEmpty+ | otherwise = returnEmpty path -- If status is for a symbolic link, it must be a Git-annex'd file getFileSize status = do@@ -217,30 +216,28 @@ 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+ 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 = fromIntegral $ fileSize status'- blksize = fromIntegral $- fileBlockSize (unsafeCoerce status')-- return ( entryCount .~ 1- $ entryActualSize .~ fsize- $ entryAllocSize .~ (if apparent opts- then fsize- else blksize * blockSize opts)- $ newEntry path False, [])+ let fsize = fileSize status'+ blksize = fileBlockSize (unsafeCoerce status')+ allocSize = if apparent opts+ then fromIntegral fsize+ else fromIntegral blksize * blockSize opts - returnEmpty = return (newEntry path False, [])+ return (EntryInfo { _entryPath = path+ , _entryCount = 1+ , _entryAllocSize = allocSize+ , _entryIsDir = False }, DL.empty) -- Main.hs (sizes) ends here
sizes.cabal view
@@ -1,6 +1,6 @@ Name: sizes -Version: 2.0.3+Version: 2.0.4 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,7 @@ Include-dirs: . Includes: HsStat.h c-sources: HsStat.c- Ghc-options: -threaded+ ghc-options: -threaded -with-rtsopts=-K16M Build-depends: base >= 4 && < 5 , bytestring@@ -33,6 +33,7 @@ , regex-posix >= 0.95 , system-fileio >= 0.3.9 , system-filepath >= 0.4.7+ , dlist >= 0.5 , text , unix