sizes 2.4.2 → 2.4.3
raw patch · 10 files changed
+720/−358 lines, 10 filesdep +hedgehogdep +sizessetup-changed
Dependencies added: hedgehog, sizes
Files
- LICENSE +0/−28
- LICENSE.md +28/−0
- Main.hs +0/−283
- README.md +106/−2
- Setup.hs +1/−0
- Sizes.hs +393/−0
- Stat.hsc +0/−2
- app/Main.hs +6/−0
- sizes.cabal +66/−43
- test/Spec.hs +120/−0
− LICENSE
@@ -1,28 +0,0 @@-Copyright (c) 2003-2009, John Wiegley. All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are-met:--- Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--- Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--- Neither the name of New Artisans LLC nor the names of its- contributors may be used to endorse or promote products derived from- this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright (c) 2012-2025, John Wiegley. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++- Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++- Neither the name of New Artisans LLC nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− Main.hs
@@ -1,283 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}--module Main where---- jww (2013-08-23): Still need to deal with hard-links.--import Control.Applicative-import Control.Concurrent.ParallelIO-import Control.DeepSeq-import Control.Exception hiding (catch)-import Control.Monad.Catch (MonadCatch, catch)-import Control.Lens-import Control.Monad-import Control.Monad.State.Strict-import Data.DList (DList)-import qualified Data.DList as DL-import Data.Function-import qualified Data.List as L-import Data.Monoid-import qualified Data.Set as Set-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-import Prelude hiding (FilePath, sequence, catch)-import Stat-import System.Console.CmdArgs-import System.Environment (getArgs, withArgs)-import System.Posix.Files hiding (fileBlockSize)-import System.Posix.Types (DeviceID, FileID)-import Text.Printf-import Text.Regex.PCRE-import Unsafe.Coerce--default (Integer, Text)--version :: String-version = "2.4.2"--copyright :: String-copyright = "2025"--sizesSummary :: String-sizesSummary = "sizes v" ++ version ++ ", (C) John Wiegley " ++ copyright--data SizesOpts = SizesOpts { jobs :: Int- , byCount :: Bool- , annex :: Bool- , apparent :: Bool- , baseTen :: Bool- , exclude :: String- , minSize :: Int- , minCount :: Int- , blockSize :: Int- , smalls :: Bool- , dedupeLinks :: Bool- -- , dirsOnly :: Bool- , 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)"- , 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"- , baseTen = def &= name "H" &= typ "BOOL"- &= help "Print amounts divided by 1000 rather than 1024"- , exclude = def &= name "x" &= typ "REGEX"- &= help "Exclude files whose path matches the REGEX"- , 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"- , dedupeLinks = def &= name "L" &= typ "BOOL"- &= help "Deduplicate hard links (count each inode only once)"- -- , dirsOnly = def &= typ "BOOL"- -- &= help "Show directories only"- , depth = def &= typ "INT"- &= help "Report entries to a depth of INT (default: 1)"- , 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 :: Int- , _entryAllocSize :: Int- , _entryIsDir :: Bool }- deriving Show--makeLenses ''EntryInfo---- Track (DeviceID, FileID) pairs to detect hard links-type SeenInodes = Set.Set (DeviceID, FileID)--newEntry :: FilePath -> Bool -> EntryInfo-newEntry p = EntryInfo p 0 0--instance Semigroup EntryInfo where- x <> y = seq x $ seq y $- entryCount +~ y^.entryCount $- entryAllocSize +~ y^.entryAllocSize $ x--instance Monoid EntryInfo where- mempty = newEntry "" False- mappend = (<>)--instance NFData EntryInfo where- rnf a = a `seq` ()--main :: IO ()-main = do- mainArgs <- getArgs- opts <- withArgs (if L.null mainArgs then [] else mainArgs)- (cmdArgs sizesOpts)- _ <- GHC.Conc.setNumCapabilities $ case jobs opts of 0 -> 2; x -> x- runSizes $ case depth opts of 0 -> opts { depth = 1 }; _ -> opts--runSizes :: SizesOpts -> IO ()-runSizes opts = do- let dirsOpt = dirs opts- directories = if L.null dirsOpt then ["."] else dirsOpt- 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) *- (if baseTen opts then 1000 else 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 ++- DL.toList (DL.concat (map snd entryInfos))- sorted = L.sortBy ((compare `on`) $- if byCount opts- then (^. entryCount)- else (^. entryAllocSize)) infos- mapM_ (reportEntry (baseTen opts)) (filter (reportEntryP opts) sorted)-- where- reportSizesForDir dir =- -- fsStatus <- getFilesystemStatus (E.encodeUtf8 (toTextIgnore dir))- let fsBlkSize = statBlockSize -- filesystemBlockSize fsStatus- opts' = if blockSize opts == 0- then opts { blockSize = fromIntegral fsBlkSize }- else opts- in fst <$> runStateT (gatherSizes opts' 0 dir) Set.empty--humanReadable :: Int -> Int -> String-humanReadable x div- | x < div = printf "%db" x- | x < div^2 = printf "%.0fK" (fromIntegral x / (fromIntegral div :: Double))- | x < div^3 = printf "%.1fM" (fromIntegral x / (fromIntegral div^2 :: Double))- | x < div^4 = printf "%.2fG" (fromIntegral x / (fromIntegral div^3 :: Double))- | x < div^5 = printf "%.3fT" (fromIntegral x / (fromIntegral div^4 :: Double))- | x < div^6 = printf "%.3fP" (fromIntegral x / (fromIntegral div^5 :: Double))- | x < div^7 = printf "%.3fX" (fromIntegral x / (fromIntegral div^6 :: Double))- | otherwise = printf "%db" x--reportEntry :: Bool -> EntryInfo -> IO ()-reportEntry bTen entry =- let path = unpack (toTextIgnore (entry^.entryPath))- in printf- (unpack "%10s %10d %s%s\n")- (humanReadable (entry^.entryAllocSize) (if bTen then 1000 else 1024))- (entry^.entryCount) path- (unpack $ if entry^.entryIsDir && L.last path /= '/'- then "/" else "")--toTextIgnore :: FilePath -> Text-toTextIgnore = either id id . toText--returnEmpty :: FilePath -> StateT SeenInodes IO (EntryInfo, DList EntryInfo)-returnEmpty path = return (newEntry path False, DL.empty)--gatherSizes :: SizesOpts -> Int -> FilePath -> StateT SeenInodes IO (EntryInfo, DList EntryInfo)-gatherSizes opts curDepth path = do- excl <- if L.null (exclude opts)- then return $ Right False- else liftIO $ try $ return $ path' =~ exclude opts -- jww (2013-08-15): poor- case excl of- Left (_ :: SomeException) -> returnEmpty path- Right True -> returnEmpty path- _ ->- (do status <- liftIO (if curDepth == 0- then getFileStatus path'- else getSymbolicLinkStatus path')- go status)- `catch`- (\e -> do liftIO $ putStrLn $ path' ++ ": " ++ Prelude.show (e :: IOException)- returnEmpty path)- where- pathT = toTextIgnore path- path' = unpack pathT-- go status- | isDirectory status =- 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) =<< liftIO (listDirectory path)-- | (isRegularFile status- && not (annex opts && ".git/annex/" `isInfixOf` pathT))- || (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 <- liftIO $ readSymbolicLink path'- if ".git/annex/" `L.isInfixOf` destPath- 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 <- liftIO $ isFile destFilePath'- if exists- then liftIO $ getFileStatus destPath'- else return status- else return status- else return status-- -- Check for hard link deduplication- let dev = deviceID status'- ino = fileID status'- numLinks = linkCount status'- shouldDedupe = dedupeLinks opts && numLinks > 1-- -- If deduplication is enabled and this has multiple hard links, check if we've seen it- alreadySeen <- if shouldDedupe- then do- seen <- get- if Set.member (dev, ino) seen- then return True- else do- put $ Set.insert (dev, ino) seen- return False- else return False-- let fsize = fileSize status'- blksize = fileBlockSize (unsafeCoerce status')- allocSize = if alreadySeen- then 0 -- Don't count size if we've already seen this inode- else if apparent opts- then fromIntegral fsize- else fromIntegral blksize * blockSize opts-- return (EntryInfo { _entryPath = path- , _entryCount = if alreadySeen then 0 else 1- , _entryAllocSize = allocSize- , _entryIsDir = False }, DL.empty)-- | otherwise = returnEmpty path---- Main.hs (sizes) ends here
README.md view
@@ -1,2 +1,106 @@-sizes compute the space and i-node consumption of all files and directories-under the current directory. Think du, but with a bit more flexibility.+# sizes++I wrote `sizes` because `du` wasn't giving me what I needed. When you're+managing large filesystems -- especially ones with git-annex repositories --+you want to see where your disk space is actually going, sorted by size or+file count, with the ability to exclude paths and handle hard-linked files+properly.++It's `du` with a bit more flexibility: concurrent traversal, PCRE path+exclusion, git-annex awareness, hard link deduplication, and output that+focuses on what matters.++## Getting started++```bash+# With Nix (preferred)+nix build github:jwiegley/sizes+./result/bin/sizes /path/to/dir++# Or install via Cabal+cabal install sizes+```++## Usage++```bash+# Basic: show directories using >10MB+sizes /path/to/dir++# Sort by file count+sizes -c /path/to/dir++# Use 4 concurrent threads+sizes -j4 /path/to/dir++# Exclude paths matching a regex+sizes -x '\.cache' /path/to/dir++# Stay on one filesystem (skip mounted volumes, NFS/SMB shares, etc.)+sizes -X /path/to/dir++# Handle git-annex repos correctly+sizes -A /path/to/annex-repo++# Deduplicate hard links+sizes -L /path/to/dir++# Show apparent sizes (not allocated blocks)+sizes --apparent /path/to/dir++# Base-10 units (MB/GB instead of MiB/GiB)+sizes -H /path/to/dir++# Lower the minimum threshold+sizes -m 1 /path/to/dir++# Increase reporting depth+sizes --depth 3 /path/to/dir++# Show everything, including small entries+sizes -s /path/to/dir+```++## Options++| Flag | Description |+|------|-------------|+| `-j INT` | Concurrent threads (default: 2) |+| `-c` | Sort by file count |+| `-A` | Git-annex aware |+| `--apparent` | Apparent sizes, not disk blocks |+| `-H` | Base-10 (MB/GB) |+| `-x REGEX` | Exclude matching paths |+| `-m INT` | Minimum size in MB (default: 10) |+| `-M INT` | Minimum file count (default: 100) |+| `-B INT` | Block size in bytes (default: 512) |+| `-s` | Show small entries |+| `-L` | Deduplicate hard links |+| `-X`, `--one-file-system` | Don't descend into other filesystems |+| `--depth INT` | Reporting depth (default: 1) |++## Development++```bash+# Enter dev shell+nix develop++# Build+cabal build++# Run tests+cabal test++# Format code+fourmolu --mode inplace Sizes.hs app/Main.hs test/Spec.hs++# Lint+hlint Sizes.hs app/Main.hs test/Spec.hs++# Run all checks+nix flake check+```++## License++BSD-3-Clause -- see [LICENSE.md](LICENSE.md).
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
+ Sizes.hs view
@@ -0,0 +1,393 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Sizes (+ -- * Main entry point+ sizesMain,++ -- * Types+ SizesOpts (..),+ EntryInfo (..),+ SeenInodes,++ -- * Lenses+ entryPath,+ entryCount,+ entryAllocSize,+ entryIsDir,++ -- * Functions+ humanReadable,+ reportEntryP,+ newEntry,+ crossesFileSystemBoundary,+) where++-- jww (2013-08-23): Still need to deal with hard-links.++import Control.Concurrent.ParallelIO+import Control.DeepSeq+import Control.Exception hiding (catch)+import Control.Lens+import Control.Monad+import Control.Monad.Catch (catch)+import Control.Monad.State.Strict+import Data.DList (DList)+import qualified Data.DList as DL+import Data.Function+import qualified Data.List as L+import qualified Data.Set as Set+import Data.Text as T hiding (chunksOf, filter, map)+import Filesystem (isFile, listDirectory)+import Filesystem.Path.CurrentOS+import GHC.Conc+import Stat+import System.Console.CmdArgs+import System.Environment (getArgs, withArgs)+import System.Posix.Files hiding (fileBlockSize)+import System.Posix.Types (DeviceID, FileID)+import Text.Printf+import Text.Regex.PCRE+import Unsafe.Coerce+import Prelude hiding (FilePath, sequence)++default (Integer, Text)++version :: String+version = "2.4.3"++copyright :: String+copyright = "2012-2026"++sizesSummary :: String+sizesSummary = "sizes v" ++ version ++ ", (C) John Wiegley " ++ copyright++data SizesOpts = SizesOpts+ { jobs :: Int+ , byCount :: Bool+ , annex :: Bool+ , apparent :: Bool+ , baseTen :: Bool+ , exclude :: String+ , minSize :: Int+ , minCount :: Int+ , blockSize :: Int+ , smalls :: Bool+ , dedupeLinks :: Bool+ , oneFileSystem :: Bool+ , -- , dirsOnly :: Bool+ 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)"+ , 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"+ , baseTen =+ def+ &= name "H"+ &= typ "BOOL"+ &= help "Print amounts divided by 1000 rather than 1024"+ , exclude =+ def+ &= name "x"+ &= typ "REGEX"+ &= help "Exclude files whose path matches the REGEX"+ , 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"+ , dedupeLinks =+ def+ &= name "L"+ &= typ "BOOL"+ &= help "Deduplicate hard links (count each inode only once)"+ , oneFileSystem =+ def+ &= explicit+ &= name "one-file-system"+ &= name "X"+ &= typ "BOOL"+ &= help "Do not descend into directories on other filesystems"+ , -- , dirsOnly = def &= typ "BOOL"+ -- &= help "Show directories only"+ depth =+ def+ &= typ "INT"+ &= help "Report entries to a depth of INT (default: 1)"+ , 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 :: Int+ , _entryAllocSize :: Int+ , _entryIsDir :: Bool+ }+ deriving (Show, Eq)++makeLenses ''EntryInfo++-- Track (DeviceID, FileID) pairs to detect hard links+type SeenInodes = Set.Set (DeviceID, FileID)++newEntry :: FilePath -> Bool -> EntryInfo+newEntry p = EntryInfo p 0 0++instance Semigroup EntryInfo where+ x <> y =+ seq x $+ seq y $+ entryCount +~ y ^. entryCount $+ entryAllocSize +~ y ^. entryAllocSize $+ x++instance Monoid EntryInfo where+ mempty = newEntry "" False++instance NFData EntryInfo where+ rnf a = a `seq` ()++sizesMain :: IO ()+sizesMain = do+ mainArgs <- getArgs+ opts <-+ withArgs+ (if L.null mainArgs then [] else mainArgs)+ (cmdArgs sizesOpts)+ GHC.Conc.setNumCapabilities $ case jobs opts of 0 -> 2; x -> x+ runSizes $ case depth opts of 0 -> opts{depth = 1}; _ -> opts++runSizes :: SizesOpts -> IO ()+runSizes opts = do+ let dirsOpt = dirs opts+ directories = if L.null dirsOpt then ["."] else dirsOpt+ reportSizes opts $ Prelude.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)+ * (if baseTen opts then 1000 else 1024) ^ (2 :: Int)+ minCount' = if minCount opts == 0 then 100 else minCount opts++reportSizes :: SizesOpts -> [FilePath] -> IO ()+reportSizes opts xs = do+ entryInfos <- parallel $ Prelude.map reportSizesForDir xs+ let infos =+ Prelude.map fst entryInfos+ ++ DL.toList (DL.concat (Prelude.map snd entryInfos))+ sorted =+ L.sortBy+ ( (compare `on`) $+ if byCount opts+ then (^. entryCount)+ else (^. entryAllocSize)+ )+ infos+ mapM_+ (reportEntry (baseTen opts))+ (Prelude.filter (reportEntryP opts) sorted)+ where+ reportSizesForDir dir =+ -- fsStatus <- getFilesystemStatus (E.encodeUtf8 (toTextIgnore dir))+ let fsBlkSize = statBlockSize -- filesystemBlockSize fsStatus+ opts' =+ if blockSize opts == 0+ then opts{blockSize = fromIntegral fsBlkSize}+ else opts+ in fst <$> runStateT (gatherSizes opts' Nothing 0 dir) Set.empty++humanReadable :: Int -> Int -> String+humanReadable x d+ | x < d = printf "%db" x+ | x < d ^ (2 :: Int) = printf "%.0fK" (fromIntegral x / (fromIntegral d :: Double))+ | x < d ^ (3 :: Int) = printf "%.1fM" (fromIntegral x / (fromIntegral d ^ (2 :: Int) :: Double))+ | x < d ^ (4 :: Int) = printf "%.2fG" (fromIntegral x / (fromIntegral d ^ (3 :: Int) :: Double))+ | x < d ^ (5 :: Int) = printf "%.3fT" (fromIntegral x / (fromIntegral d ^ (4 :: Int) :: Double))+ | x < d ^ (6 :: Int) = printf "%.3fP" (fromIntegral x / (fromIntegral d ^ (5 :: Int) :: Double))+ | x < d ^ (7 :: Int) = printf "%.3fX" (fromIntegral x / (fromIntegral d ^ (6 :: Int) :: Double))+ | otherwise = printf "%db" x++reportEntry :: Bool -> EntryInfo -> IO ()+reportEntry bTen entry =+ let path = T.unpack (toTextIgnore (entry ^. entryPath))+ in printf+ (T.unpack "%10s %10d %s%s\n")+ (humanReadable (entry ^. entryAllocSize) (if bTen then 1000 else 1024))+ (entry ^. entryCount)+ path+ ( T.unpack $+ if entry ^. entryIsDir && L.last path /= '/'+ then "/"+ else ""+ )++toTextIgnore :: FilePath -> Text+toTextIgnore = either id id . toText++returnEmpty :: FilePath -> StateT SeenInodes IO (EntryInfo, DList EntryInfo)+returnEmpty path = return (newEntry path False, DL.empty)++{- | Decide whether an entry should be skipped because it lies on a different+filesystem than the traversal root. The second argument is the device of+the traversal root, or 'Nothing' at the top-level argument itself (where the+boundary is merely established, so nothing is skipped).+-}+crossesFileSystemBoundary :: Bool -> Maybe DeviceID -> DeviceID -> Bool+crossesFileSystemBoundary False _ _ = False+crossesFileSystemBoundary True Nothing _ = False+crossesFileSystemBoundary True (Just rootDev) dev = dev /= rootDev++gatherSizes :: SizesOpts -> Maybe DeviceID -> Int -> FilePath -> StateT SeenInodes IO (EntryInfo, DList EntryInfo)+gatherSizes opts mRootDev curDepth path = do+ excl <-+ if L.null (exclude opts)+ then return $ Right False+ else liftIO $ try $ return $ path' =~ exclude opts -- jww (2013-08-15): poor+ case excl of+ Left (_ :: SomeException) -> returnEmpty path+ Right True -> returnEmpty path+ _ ->+ ( do+ status <-+ liftIO+ ( if curDepth == 0+ then getFileStatus path'+ else getSymbolicLinkStatus path'+ )+ if crossesFileSystemBoundary (oneFileSystem opts) mRootDev (deviceID status)+ then returnEmpty path+ else go status+ )+ `catch` ( \e -> do+ liftIO $ putStrLn $ path' ++ ": " ++ Prelude.show (e :: IOException)+ returnEmpty path+ )+ where+ pathT = toTextIgnore path+ path' = T.unpack pathT++ go status+ | isDirectory status =+ foldM+ ( \(y, ys) x -> do+ (x', xs') <- gatherSizes opts (Just (deviceID status)) (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)+ =<< liftIO (listDirectory path)+ | ( isRegularFile status+ && not (annex opts && ".git/annex/" `isInfixOf` pathT)+ )+ || (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 <- liftIO $ readSymbolicLink path'+ if ".git/annex/" `L.isInfixOf` destPath+ 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 <- liftIO $ isFile destFilePath'+ if exists+ then liftIO $ getFileStatus destPath'+ else return status+ else return status+ else return status++ -- Check for hard link deduplication+ let dev = deviceID status'+ ino = fileID status'+ numLinks = linkCount status'+ shouldDedupe = dedupeLinks opts && numLinks > 1++ -- If deduplication is enabled and this has multiple hard links, check if we've seen it+ alreadySeen <-+ if shouldDedupe+ then do+ seen <- get+ if Set.member (dev, ino) seen+ then return True+ else do+ put $ Set.insert (dev, ino) seen+ return False+ else return False++ let fsize = fileSize status'+ blksize = fileBlockSize (unsafeCoerce status')+ allocSize+ | alreadySeen = 0 -- Don't count size if we've already seen this inode+ | apparent opts = fromIntegral fsize+ | otherwise = fromIntegral blksize * blockSize opts++ return+ ( EntryInfo+ { _entryPath = path+ , _entryCount = if alreadySeen then 0 else 1+ , _entryAllocSize = allocSize+ , _entryIsDir = False+ }+ , DL.empty+ )+ | otherwise = returnEmpty path++-- Sizes.hs ends here
Stat.hsc view
@@ -2,7 +2,6 @@ module Stat where -import Foreign.C.String import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr@@ -11,7 +10,6 @@ import System.Posix.ByteString.FilePath import System.Posix.Internals ( CFilePath ) import System.Posix.Types-import Unsafe.Coerce #include "HsStat.h"
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Sizes (sizesMain)++main :: IO ()+main = sizesMain
sizes.cabal view
@@ -1,53 +1,76 @@-Name: sizes+cabal-version: 2.4+name: sizes+version: 2.4.3+synopsis: Recursively show space (size and i-nodes) used in subdirectories+description:+ A command-line utility that recursively analyzes directory trees to display+ space usage information, including both file sizes and inode counts. -Version: 2.4.2-Synopsis: Recursively show space (size and i-nodes) used in subdirectories+homepage: https://github.com/jwiegley/sizes+license: BSD-3-Clause+license-file: LICENSE.md+author: John Wiegley+maintainer: John Wiegley <johnw@newartisans.com>+category: Development+build-type: Simple -Description:- A command-line utility that recursively analyzes directory trees to display- space usage information, including both file sizes and inode counts. This tool- provides detailed statistics about disk space consumption in subdirectories,- making it useful for identifying large files and directories, analyzing storage- usage patterns, and managing disk space efficiently. The output can be filtered- and sorted to help locate space-consuming items quickly.+extra-source-files:+ README.md+ Stat.hsc+ HsStat.h+ HsStat.c -Homepage: https://github.com/jwiegley/sizes-License: BSD3-License-file: LICENSE-Author: John Wiegley-Maintainer: John Wiegley <johnw@newartisans.com>-Category: Development-Build-type: Simple-Cabal-version: >= 1.10+library+ exposed-modules:+ Sizes+ Stat -Extra-Source-Files: README.md Stat.hsc HsStat.h HsStat.c+ hs-source-dirs: .+ include-dirs: .+ includes: HsStat.h+ c-sources: HsStat.c+ default-language: Haskell2010+ ghc-options: -Wall -Wcompat -Executable sizes- Main-is: Main.hs- Other-modules: Stat- Include-dirs: .- Includes: HsStat.h- c-sources: HsStat.c- ghc-options: -threaded -with-rtsopts=-K64M+ build-depends:+ , base >= 4 && < 5+ , cmdargs >= 0.10 && < 0.11+ , containers >= 0.5 && < 0.8+ , deepseq >= 1.3 && < 1.6+ , dlist >= 0.5 && < 1.1+ , exceptions >= 0.8 && < 0.11+ , lens >= 2.8 && < 6+ , mtl >= 2.2 && < 2.4+ , parallel-io >= 0.3.2 && < 0.4+ , regex-pcre >= 0.95 && < 0.96+ , semigroups >= 0.8 && < 0.21+ , system-fileio >= 0.3.9 && < 0.4+ , system-filepath >= 0.4.7 && < 0.5+ , text >= 0.11 && < 2.2+ , unix >= 2.5 && < 2.9 - default-language: Haskell2010+executable sizes+ main-is: Main.hs+ hs-source-dirs: app+ default-language: Haskell2010+ ghc-options: -Wall -Wcompat -threaded -with-rtsopts=-K64M - Build-depends: base >= 4 && < 5- , cmdargs >= 0.10 && < 0.11- , containers >= 0.5 && < 0.8- , deepseq >= 1.3 && < 1.6- , exceptions >= 0.8 && < 0.11- , lens >= 2.8 && < 6- , mtl >= 2.2 && < 2.4- , parallel-io >= 0.3.2 && < 0.4- , regex-pcre >= 0.95 && < 0.96- , system-fileio >= 0.3.9 && < 0.4- , system-filepath >= 0.4.7 && < 0.5- , dlist >= 0.5 && < 1.1- , semigroups >= 0.8 && < 0.21- , text >= 0.11 && < 2.2- , unix >= 2.5 && < 2.9+ build-depends:+ , base >= 4 && < 5+ , sizes -Source-repository head+test-suite sizes-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall -Wcompat++ build-depends:+ , base >= 4 && < 5+ , hedgehog >= 1.0 && < 1.6+ , sizes++source-repository head type: git location: https://github.com/jwiegley/sizes
+ test/Spec.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Control.Monad (unless)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Sizes (EntryInfo (..), crossesFileSystemBoundary, humanReadable)+import System.Exit (exitFailure)+import System.Posix.Types (DeviceID)++main :: IO ()+main = do+ passed <- checkParallel $$(discover)+ unless passed exitFailure++-- | Generate an EntryInfo with random count and size.+genEntryInfo :: Gen EntryInfo+genEntryInfo = do+ count <- Gen.int (Range.linear 0 10000)+ size <- Gen.int (Range.linear 0 (1024 * 1024 * 1024))+ isDir <- Gen.bool+ pure $ mempty{_entryCount = count, _entryAllocSize = size, _entryIsDir = isDir}++-- humanReadable: bytes+prop_humanReadable_bytes :: Property+prop_humanReadable_bytes =+ withTests 1 . property $+ humanReadable 500 1024 === "500b"++-- humanReadable: kilobytes+prop_humanReadable_kilobytes :: Property+prop_humanReadable_kilobytes =+ withTests 1 . property $+ humanReadable 2048 1024 === "2K"++-- humanReadable: megabytes (base-2)+prop_humanReadable_megabytes :: Property+prop_humanReadable_megabytes =+ withTests 1 . property $+ humanReadable (5 * 1024 * 1024) 1024 === "5.0M"++-- humanReadable: gigabytes (base-2)+prop_humanReadable_gigabytes :: Property+prop_humanReadable_gigabytes =+ withTests 1 . property $+ humanReadable (2 * 1024 * 1024 * 1024) 1024 === "2.00G"++-- humanReadable: megabytes (base-10)+prop_humanReadable_base10 :: Property+prop_humanReadable_base10 =+ withTests 1 . property $+ humanReadable 5000000 1000 === "5.0M"++-- Semigroup: count accumulation is associative+prop_semigroup_count_associative :: Property+prop_semigroup_count_associative = property $ do+ a <- forAll genEntryInfo+ b <- forAll genEntryInfo+ c <- forAll genEntryInfo+ _entryCount ((a <> b) <> c) === _entryCount (a <> (b <> c))++-- Semigroup: size accumulation is associative+prop_semigroup_size_associative :: Property+prop_semigroup_size_associative = property $ do+ a <- forAll genEntryInfo+ b <- forAll genEntryInfo+ c <- forAll genEntryInfo+ _entryAllocSize ((a <> b) <> c) === _entryAllocSize (a <> (b <> c))++-- Monoid: right identity preserves count+prop_monoid_right_identity_count :: Property+prop_monoid_right_identity_count = property $ do+ e <- forAll genEntryInfo+ _entryCount (e <> mempty) === _entryCount e++-- Monoid: right identity preserves size+prop_monoid_right_identity_size :: Property+prop_monoid_right_identity_size = property $ do+ e <- forAll genEntryInfo+ _entryAllocSize (e <> mempty) === _entryAllocSize e++-- humanReadable always returns a non-empty string+prop_humanReadable_nonempty :: Property+prop_humanReadable_nonempty = property $ do+ x <- forAll $ Gen.int (Range.linear 0 (1024 * 1024 * 1024 * 1024))+ d <- forAll $ Gen.element [1000, 1024]+ assert $ not (null (humanReadable x d))++-- | Generate an arbitrary device ID.+genDevice :: Gen DeviceID+genDevice = fromIntegral <$> Gen.int (Range.linear 0 100000)++-- crossesFileSystemBoundary: with the option disabled, nothing is ever a crossing+prop_oneFS_disabled_never_crosses :: Property+prop_oneFS_disabled_never_crosses = property $ do+ root <- forAll $ Gen.maybe genDevice+ dev <- forAll genDevice+ crossesFileSystemBoundary False root dev === False++-- crossesFileSystemBoundary: the traversal root only establishes the boundary+prop_oneFS_root_establishes_boundary :: Property+prop_oneFS_root_establishes_boundary = property $ do+ dev <- forAll genDevice+ crossesFileSystemBoundary True Nothing dev === False++-- crossesFileSystemBoundary: same device as the root is not a crossing+prop_oneFS_same_device_stays :: Property+prop_oneFS_same_device_stays = property $ do+ dev <- forAll genDevice+ crossesFileSystemBoundary True (Just dev) dev === False++-- crossesFileSystemBoundary: a different device than the root is a crossing+prop_oneFS_different_device_crosses :: Property+prop_oneFS_different_device_crosses = property $ do+ root <- forAll genDevice+ delta <- forAll $ Gen.int (Range.linear 1 100000)+ let dev = root + fromIntegral delta+ crossesFileSystemBoundary True (Just root) dev === True