sizes 1.2.0 → 2.0.1
raw patch · 4 files changed
+176/−48 lines, 4 filesdep +bytestringdep ~unix
Dependencies added: bytestring
Dependency ranges changed: unix
Files
- HsStat.c +12/−0
- Main.hs +108/−44
- Stat.hsc +47/−0
- sizes.cabal +9/−4
+ HsStat.c view
@@ -0,0 +1,12 @@+#include "HsStat.h"++#if defined(__MINGW32__)+inline int __hscore_statvfs(wchar_t *path, struct_statvfs *buf) {+ /* jww (2012-10-18): ??? */+ return _wstatvfsi64(path,buf);+}+#else+inline int __hscore_statvfs(char *path, struct_statvfs *buf) {+ return statvfs(path,buf);+}+#endif
Main.hs view
@@ -9,24 +9,28 @@ import Control.Exception import Control.Lens import Control.Monad hiding (sequence)+import qualified Data.Text.Encoding as E import Data.Function import qualified Data.List as L import Data.Monoid import Data.Text as T hiding (filter, map, chunksOf)-import Filesystem (listDirectory)+import Filesystem (listDirectory, isFile) import Filesystem.Path.CurrentOS import GHC.Conc-import Prelude hiding (FilePath, sequence, catch)+import Prelude hiding (FilePath, sequence)+import Stat import System.Console.CmdArgs import System.Environment (getArgs, withArgs) import System.Posix.Files import Text.Printf import Text.Regex.Posix+import Unsafe.Coerce+import Debug.Trace default (Integer, Text) version :: String-version = "1.2.0"+version = "2.0.1" copyright :: String copyright = "2012"@@ -34,45 +38,55 @@ sizesSummary :: String sizesSummary = "sizes v" ++ version ++ ", (C) John Wiegley " ++ copyright -data SizesOpts = SizesOpts { jobs :: Int- , byCount :: Bool- , exclude :: String- , minSize :: Integer- , minCount :: Integer- , smalls :: Bool+data SizesOpts = SizesOpts { jobs :: Int+ , byCount :: Bool+ , annex :: Bool+ , apparent :: Bool+ , exclude :: String+ , minSize :: Integer+ , minCount :: Integer+ , blockSize :: Integer+ , smalls :: Bool -- , dirsOnly :: Bool- , depth :: Int- , dirs :: [String] }+ , depth :: Int+ , dirs :: [String] } deriving (Data, Typeable, Show, Eq) sizesOpts :: SizesOpts sizesOpts = SizesOpts- { jobs = def &= name "j" &= typ "INT"- &= help "Run INT concurrent finds at once (default: 2)"- , byCount = def &= name "c" &= typ "BOOL"- &= help "Sort output by count (default: by size)"- , exclude = def &= name "x" &= typ "REGEX"- &= help "Sort output by count (default: by size)"- , minSize = def &= name "m" &= typ "INT"- &= help "Smallest entries to show, in MB (default: 10)"- , minCount = def &= name "M" &= typ "INT"- &= help "Smallest entries to show, in count (default: 100)"- , smalls = def &= name "s" &= typ "BOOL"- &= help "Also show small (<1M && <100 files) entries"+ { jobs = def &= name "j" &= typ "INT"+ &= help "Run INT concurrent finds at once (default: 2)"+ , byCount = def &= name "c" &= typ "BOOL"+ &= help "Sort output by count (default: by size)"+ , annex = def &= name "A" &= typ "BOOL"+ &= help "Be mindful of how git-annex stores files"+ , apparent = def &= typ "BOOL"+ &= help "Print apparent sizes, rather than disk usage"+ , exclude = def &= name "x" &= typ "REGEX"+ &= help "Sort output by count (default: by size)"+ , minSize = def &= name "m" &= typ "INT"+ &= help "Smallest size to show, in MB (default: 10)"+ , minCount = def &= name "M" &= typ "INT"+ &= help "Smallest count to show (default: 100)"+ , blockSize = def &= name "B" &= typ "INT"+ &= help "Size of blocks on disk (default: 512)"+ , smalls = def &= name "s" &= typ "BOOL"+ &= help "Also show small (<1M && <100 files) entries" -- , dirsOnly = def &= typ "BOOL" -- &= help "Show directories only"- , depth = def &= typ "INT"- &= help "Report all entries to a depth of INT (default: 0)"- , dirs = def &= args &= typ "DIRS..." } &=+ , depth = def &= typ "INT"+ &= help "Report entries to a depth of INT (default: 0)"+ , dirs = def &= args &= typ "DIRS..." } &= summary sizesSummary &= program "sizes" &= help "Calculate amount of disk used by the given directories" -data EntryInfo = EntryInfo { _entryPath :: !FilePath- , _entryCount :: !Integer- , _entrySize :: !Integer- , _entryIsDir :: !Bool }- deriving Show+data EntryInfo = EntryInfo { _entryPath :: !FilePath+ , _entryCount :: !Integer+ , _entryActualSize :: !Integer+ , _entryAllocSize :: !Integer+ , _entryIsDir :: !Bool }+ deriving Show makeLenses ''EntryInfo @@ -80,35 +94,45 @@ rnf a = a `seq` () newEntry :: FilePath -> Bool -> EntryInfo-newEntry p = EntryInfo p 0 0+newEntry p = EntryInfo p 0 0 0 main :: IO () main = do mainArgs <- getArgs- opts <- withArgs (if L.null mainArgs then ["."] else mainArgs)+ opts <- withArgs (if L.null mainArgs then [] else mainArgs) (cmdArgs sizesOpts) _ <- GHC.Conc.setNumCapabilities $ case jobs opts of 0 -> 2; x -> x runSizes opts runSizes :: SizesOpts -> IO () runSizes opts = do- reportSizes opts $ map (fromText . pack) (dirs opts)+ let dirsOpt = dirs opts+ directories = if L.null dirsOpt then ["."] else dirsOpt+ reportSizes opts $ map (fromText . pack) directories stopGlobalPool reportSizes :: SizesOpts -> [FilePath] -> IO () reportSizes opts xs = do- entryInfos <- parallel $ map (gatherSizesW opts 0) xs+ 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 (^. entrySize)) infos+ else (^. entryAllocSize)) infos forM_ sorted $ \entry -> when ( smalls opts- || entry^.entrySize >= minSize'+ || entry^.entryAllocSize >= minSize' || entry^.entryCount >= minCount') $ reportEntry entry where+ reportSizesForDir dir = do+ 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) @@ -127,7 +151,8 @@ reportEntry entry = let path = unpack . toTextIgnore $ entry^.entryPath in printf (unpack "%10s %10d %s%s\n")- (humanReadable (entry^.entrySize)) (entry^.entryCount) path+ (humanReadable (entry^.entryAllocSize))+ (entry^.entryCount) path (unpack $ if entry^.entryIsDir && L.last path /= '/' then "/" else "") @@ -151,6 +176,8 @@ where path' = unpack $ toTextIgnore path + annexRe = unpack "\\.git/annex/"+ gatherSizes' status | (exclude opts) /= "" && path' =~ exclude opts = returnEmpty @@ -160,22 +187,59 @@ in if curDepth == 0 then parallel $ map func files else mapM func files+ let firsts = map fst entries+ return $!! ( L.foldl' (\current entry ->- entryCount +~ entry^.entryCount $- entrySize +~ entry^.entrySize $ current)+ 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 [] ) - | isRegularFile status =- return (entryCount .~ 1 $- entrySize .~ fromIntegral (fileSize status) $- newEntry path False, [])+ | ( isRegularFile status+ && not (annex opts && path' =~ annexRe))+ || (annex opts && isSymbolicLink status) =+ catch (getFileSize status)+ (\e -> do print (e :: IOException)+ returnEmpty) | otherwise = returnEmpty++ -- 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 = 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, []) returnEmpty = return (newEntry path False, [])
+ Stat.hsc view
@@ -0,0 +1,47 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Stat where++import Foreign.C.String+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe+import System.Posix.ByteString.FilePath+import System.Posix.Internals ( CFilePath )+import System.Posix.Types+import Unsafe.Coerce++#include "HsStat.h"++type CStat = ()+newtype FileStatus = FileStatus (ForeignPtr CStat)++statBlockSize :: FileOffset+statBlockSize = (#const S_BLKSIZE)++fileBlockSize :: FileStatus -> FileOffset+fileBlockSize (Stat.FileStatus stat) =+ unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_blocks)++type CStatvfs = ()+newtype FilesystemStatus = FilesystemStatus (ForeignPtr CStatvfs)++-- jww (2012-10-18): This will+foreign import ccall unsafe "HsBase.h __hscore_statvfs"+ c_statvfs :: CFilePath -> Ptr CStatvfs -> IO CInt++getFilesystemStatus :: RawFilePath -> IO Stat.FilesystemStatus+getFilesystemStatus path = do+ fp <- mallocForeignPtrBytes (#const sizeof(struct statvfs))+ withForeignPtr fp $ \p ->+ withFilePath path $ \s ->+ throwErrnoPathIfMinus1_ "getFilesystemStatus" path (c_statvfs s p)+ return (FilesystemStatus fp)++filesystemBlockSize :: FilesystemStatus -> CULong+filesystemBlockSize (Stat.FilesystemStatus statvfs) =+ unsafePerformIO $ withForeignPtr statvfs $ (#peek struct statvfs, f_frsize)++-- Stat.hsc ends here
sizes.cabal view
@@ -1,6 +1,6 @@ Name: sizes -Version: 1.2.0+Version: 2.0.1 Synopsis: Recursively show space (size and i-nodes) used in subdirectories Description: Recursively show space (size and i-nodes) used in subdirectories@@ -17,10 +17,15 @@ Extra-Source-Files: README.md Executable sizes- Main-is: Main.hs- Ghc-options: -threaded+ Main-is: Main.hs+ Other-modules: Stat+ Include-dirs: .+ Includes: HsStat.h+ c-sources: HsStat.c+ Ghc-options: -threaded Build-depends: base >= 4 && < 5+ , bytestring >= 0.10 , cmdargs >= 0.10 , deepseq >= 1.3 , lens >= 2.8@@ -29,7 +34,7 @@ , system-fileio >= 0.3.9 , system-filepath >= 0.4.7 , text >= 0.11.2- , unix >= 2.5.1+ , unix == 2.6.0.0 Source-repository head type: git