stack-clean-old 0.4.6 → 0.4.7
raw patch · 8 files changed
+210/−31 lines, 8 files
Files
- ChangeLog.md +7/−0
- README.md +84/−18
- src/Directories.hs +7/−2
- src/GHC.hs +9/−2
- src/GHCTarball.hs +85/−0
- src/Main.hs +12/−5
- src/Snapshots.hs +3/−2
- stack-clean-old.cabal +3/−2
ChangeLog.md view
@@ -1,5 +1,12 @@ # Release history for stack-clean-old +## 0.4.7 (2023-08-22)+- add --tarballs for programs/ ghc tarballs too (#9)+- bug fix to match both ghc-*.* and ghc-variant-*.* (#14)+- rename --os-system to --platform and add more explanation (#15)+- parse ghc installation versions more carefully+- ignore hidden files in stack dirs+ ## 0.4.6 (2022-02-03) - fix --recursive and --subdirs to work again - show --recursive dir paths
README.md view
@@ -4,7 +4,7 @@ snapshot builds and ghc versions to recover diskspace. ## Usage-`stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-P|--project)|(-G|--global)] [(-s|--subdirs)|(-r|--recursive)] [-d|--delete] [GHCVER]`+`stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-P|--project)|(-G|--global)|(-C|--compilers)|(-T|--tarballs)] [(-s|--subdirs)|(-r|--recursive)] [-d|--delete] [GHCVER]` In a project directory it acts on `.stack-work/install/` by default, otherwise on `~/.stack/{snapshots,programs}/`.@@ -48,33 +48,38 @@ all matching `.stack-work` dirs from the current directory and below respectively. +Note is you have different ghc variants/archs installed+you may need to use the `--platform` option to choose which one to query/clean:+examples include `x86_64-linux-tinfo6`, `x86_64-linux`, `aarch64-linux-nix`,+`x86_64-osx`, `aarch64-osx`, etc.+ ### Example usage List a project's builds: ```ShellSession $ stack-clean-old list-154M 8.2.2 (5 dirs)-154M 8.4.4 (5 dirs)-163M 8.6.5 (5 dirs)+154M 9.2.8 (5 dirs)+154M 9.4.5 (5 dirs)+163M 9.6.2 (5 dirs) ```-Remove project's 8.2.2 builds:+Remove project's 9.0.2 builds: ```ShellSession-$ stack-clean-old remove --delete --project 8.2.2+$ stack-clean-old remove --delete --project 9.0.2 : ``` (--project is optional in a project dir). -Remove stack ghc-8.4 snapshot builds and minor compilers before 8.4.4:+Remove stack ghc-9.4 snapshot builds and minor compilers before 9.4.4: ```ShellSession-$ stack-clean-old list --global 8.4-421M 8.4.1 (7 dirs)-368M 8.4.2 (6 dirs)-489M 8.4.3 (8 dirs)-799M 8.4.4 (24 dirs)-$ stack-clean-old keep-minor -d -g 8.4.4-ghc-tinfo6-8.4.3 removed-7 dirs removed for 8.4.1-6 dirs removed for 8.4.2-8 dirs removed for 8.4.3+$ stack-clean-old list --global 9.4+421M 9.4.1 (7 dirs)+368M 9.4.2 (6 dirs)+489M 9.4.3 (8 dirs)+799M 9.4.4 (24 dirs)+$ stack-clean-old keep-minor -d -g 9.4.4+ghc-tinfo6-9.4.3 removed+7 dirs removed for 9.4.1+6 dirs removed for 9.4.2+8 dirs removed for 9.4.3 ``` (--global is optional outside a project dir). @@ -94,15 +99,18 @@ _all_ `.stack-work/` dirs within (or outside) a project directory to save space (seems same as `stack clean --full` inside a project). -### Help output+## Help output (Note you can also run this tool via `stack clean-old`.) To get help you can run `stack-clean-old --help` or just: ```ShellSession+$ stack-clean-old --version+0.4.7 $ stack-clean-old Stack clean up tool Usage: stack-clean-old [--version] COMMAND+ Cleans away old stack-work builds (and pending: stack snapshots) to recover diskspace. Use the --delete option to perform actual removals. https://github.com/juhp/stack-clean-old#readme@@ -119,6 +127,64 @@ purge-older Purge older builds in .stack-work/install delete-work Remove project's .stack-work/ (optionally recursively)+```++### Command options+All the commands have similar options. e.g.:++Size and list command:+```+$ stack-clean-old list --help+Usage: stack-clean-old list [(-P|--project) | (-S|--snapshots) | (-G|--global) |+ (-C|--compilers) | (-T|--tarballs)]+ [(-s|--subdirs) | (-r|--recursive)] [GHCVER]+ [-o|--platform SYSTEM]++ List sizes per ghc version++Available options:+ -P,--project Act on current project's .stack-work/ [default in+ project dir]+ -S,--snapshots Act on ~/.stack/snapshots/+ -G,--global Act on both ~/.stack/{programs,snapshots}/ [default+ outside project dir]+ -C,--compilers Act on ~/.stack/programs/ installations+ -T,--tarballs Act on ~/.stack/programs/ tarballs+ -s,--subdirs List subdirectories+ -r,--recursive List subdirectories+ -o,--platform SYSTEM Specify which OS platform to work on (eg+ 'x86_64-linux-tinfo6', 'aarch64-linux-nix',+ 'x86_64-osx', 'aarch64-osx', etc)+ -h,--help Show this help text+```++Removal commands additionally have `--delete`:+```shellsession+$ stack-clean-old remove --help+Usage: stack-clean-old remove [-d|--delete]+ [(-P|--project) | (-S|--snapshots) |+ (-G|--global) | (-C|--compilers) |+ (-T|--tarballs)]+ [(-s|--subdirs) | (-r|--recursive)] GHCVER+ [-o|--platform SYSTEM]++ Remove for a ghc version++Available options:+ -d,--delete Do deletion [default is dryrun]+ -P,--project Act on current project's .stack-work/ [default in+ project dir]+ -S,--snapshots Act on ~/.stack/snapshots/+ -G,--global Act on both ~/.stack/{programs,snapshots}/ [default+ outside project dir]+ -C,--compilers Act on ~/.stack/programs/ installations+ -T,--tarballs Act on ~/.stack/programs/ tarballs+ -s,--subdirs List subdirectories+ -r,--recursive List subdirectories+ -o,--platform SYSTEM Specify which OS platform to work on (eg+ 'x86_64-linux-tinfo6', 'aarch64-linux-nix',+ 'x86_64-osx', 'aarch64-osx', etc)+ -h,--help Show this help text ``` ## Installation
src/Directories.hs view
@@ -1,7 +1,8 @@ module Directories ( getStackSubdir, globDirs,- switchToSystemDirUnder+ switchToSystemDirUnder,+ listCurrentDirectory ) where @@ -26,7 +27,7 @@ if exists then setCurrentDirectory dir else error' $ dir ++ " not found"- systems <- listDirectory "."+ systems <- listCurrentDirectory -- FIXME be more precise/check "system" dirs -- eg 64bit intel Linux: x86_64-linux-tinfo6 let system =@@ -43,3 +44,7 @@ ["Please specify platform with --os-system (-o).", dir ++ " has:"] ++ ss setCurrentDirectory system++listCurrentDirectory :: IO [FilePath]+listCurrentDirectory =+ filter (\d -> head d /= '.') <$> listDirectory "."
src/GHC.hs view
@@ -7,6 +7,7 @@ where import Control.Monad.Extra+import Data.Char (isDigit) import Data.List.Extra import Data.Version.Extra import SimpleCmd@@ -33,7 +34,7 @@ getGhcInstallDirs :: Maybe Version -> Maybe String -> IO [FilePath] getGhcInstallDirs mghcver msystem = do setStackProgramsDir msystem- sortOn ghcInstallVersion <$> globDirs ("ghc-" ++ matchVersion)+ sortOn ghcInstallVersion <$> globDirs ("ghc" ++ matchVersion) where matchVersion = case mghcver of@@ -43,7 +44,13 @@ ghcInstallVersion :: FilePath -> Version ghcInstallVersion =- readVersion . takeWhileEnd (/= '-') . dropSuffix ".temp"+ readVersion . checkChars . takeWhileEnd (/= '-') . dropSuffix ".temp"+ where+ checkChars vs =+ let isVerChar c = isDigit c || c == '.'+ in if all isVerChar vs+ then vs+ else error $ "unknown version:" +-+ vs listGhcInstallation :: Maybe Version -> Maybe String -> IO () listGhcInstallation mghcver msystem = do
+ src/GHCTarball.hs view
@@ -0,0 +1,85 @@+module GHCTarball (+ listGhcTarballs,+ removeGhcMinorTarball,+ removeGhcVersionTarball+ )+where++import Control.Monad.Extra+import Data.Char (isDigit)+import Data.List.Extra+import Data.Version.Extra+import SimpleCmd+import System.FilePath (dropExtension)+import System.FilePath.Glob++import Directories (getStackSubdir, switchToSystemDirUnder)+import qualified Remove+import Types+import Versions++getStackProgramsDir :: IO FilePath+getStackProgramsDir =+ getStackSubdir "programs"++setStackProgramsDir :: Maybe String -> IO ()+setStackProgramsDir msystem =+ getStackProgramsDir >>= switchToSystemDirUnder msystem++getGhcTarballs :: Maybe Version -> Maybe String -> IO [FilePath]+getGhcTarballs mghcver msystem = do+ setStackProgramsDir msystem+ sortOn ghcTarballVersion . map (dropPrefix "./") <$> namesMatching ("ghc" ++ matchVersion ++ ".tar.*")+ where+ matchVersion =+ case mghcver of+ Nothing -> "*"+ Just ver ->+ "*-" ++ showVersion ver ++ if isMajorVersion ver then "*" else ""++ghcTarballVersion :: FilePath -> Version+ghcTarballVersion =+ readVersion . checkChars . takeWhileEnd (/= '-') . dropSuffix ".tar" . dropExtension+ where+ checkChars vs =+ let isVerChar c = isDigit c || c == '.'+ in if all isVerChar vs+ then vs+ else error $ "unknown version:" +-+ vs++listGhcTarballs :: Maybe Version -> Maybe String -> IO ()+listGhcTarballs mghcver msystem = do+ files <- getGhcTarballs mghcver msystem+ mapM_ putStrLn $+ case mghcver of+ Nothing -> files+ Just ghcver -> filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcTarballVersion) files++removeGhcVersionTarball :: Deletion -> Version -> Maybe String -> IO ()+removeGhcVersionTarball deletion ghcver msystem = do+ files <- getGhcTarballs (Just ghcver) msystem+ case files of+ [] -> putStrLn $ "Tarball for " ++ showVersion ghcver ++ " not found"+ [g] | not (isMajorVersion ghcver) -> doRemoveGhcTarballVersion deletion g+ gs -> if isMajorVersion ghcver then do+ Remove.prompt deletion ("all stack ghc " ++ showVersion ghcver ++ " tarballs: ")+ mapM_ (doRemoveGhcTarballVersion deletion) gs+ else error' "more than one match found!!"++removeGhcMinorTarball :: Deletion -> Maybe Version -> Maybe String+ -> IO ()+removeGhcMinorTarball deletion mghcver msystem = do+ files <- getGhcTarballs (majorVersion <$> mghcver) msystem+ case mghcver of+ Nothing -> do+ let majors = groupOn (majorVersion . ghcTarballVersion) files+ forM_ majors $ \ minors ->+ forM_ (init minors) $ doRemoveGhcTarballVersion deletion+ Just ghcver -> do+ let minors = filter ((< ghcver) . ghcTarballVersion) files+ forM_ minors $ doRemoveGhcTarballVersion deletion++doRemoveGhcTarballVersion :: Deletion -> FilePath -> IO ()+doRemoveGhcTarballVersion deletion ghctarball = do+ Remove.removeFile deletion ghctarball+ putStrLn $ ghctarball ++ " tarball " ++ (if isDelete deletion then "" else "would be ") ++ "removed"
src/Main.hs view
@@ -18,11 +18,12 @@ import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import GHC+import GHCTarball import Paths_stack_clean_old (version) import Snapshots import Types -data Mode = Default | Project | Snapshots | Compilers | GHC+data Mode = Default | Project | Snapshots | Compilers | GHC | Tarballs data Recursion = Subdirs | Recursive deriving Eq@@ -72,9 +73,10 @@ where modeOpt = flagWith' Project 'P' "project" "Act on current project's .stack-work/ [default in project dir]" <|>- flagWith' GHC 'G' "global" "Act on both ~/.stack/{programs,snapshots}/ [default outside project dir]" <|> flagWith' Snapshots 'S' "snapshots" "Act on ~/.stack/snapshots/" <|>- flagWith Default Compilers 'C' "compilers" "Act on ~/.stack/programs/"+ flagWith' GHC 'G' "global" "Act on both ~/.stack/{programs,snapshots}/ [default outside project dir]" <|>+ flagWith' Compilers 'C' "compilers" "Act on ~/.stack/programs/ installations" <|>+ flagWith Default Tarballs 'T' "tarballs" "Act on ~/.stack/programs/ tarballs" deleteOpt = flagWith Dryrun Delete 'd' "delete" "Do deletion [default is dryrun]" @@ -91,8 +93,8 @@ keepOption = optionalWith auto 'k' "keep" "INT" "number of project builds per ghc version [default 5]" 5 - systemOpt = strOptionWith 'o' "os-system" "SYSTEM"- "Specify which of the OS platforms to work on (eg 'x86_64-linux-tinfo6' or 'aarch64-linux-nix', etc)"+ systemOpt = strOptionWith 'o' "platform" "SYSTEM"+ "Specify which OS platform to work on (eg 'x86_64-linux-tinfo6', 'aarch64-linux-nix', 'x86_64-osx', 'aarch64-osx', etc)" withRecursion :: Bool -> Maybe Recursion -> IO () -> IO () withRecursion needinstall mrecursion =@@ -123,6 +125,7 @@ Project -> withRecursion' False False mrecursion $ sizeStackWork notHuman Snapshots -> sizeSnapshots notHuman Compilers -> sizeGhcInstalls notHuman+ Tarballs -> error' "use --compilers" GHC -> do sizeCmd Snapshots Nothing notHuman sizeCmd Compilers Nothing notHuman@@ -139,6 +142,7 @@ Project -> setStackWorkInstallDir msystem >> listGhcSnapshots mver Snapshots -> setStackSnapshotsDir msystem >> listGhcSnapshots mver Compilers -> listGhcInstallation mver msystem+ Tarballs -> listGhcTarballs mver msystem GHC -> do listCmd Snapshots Nothing mver msystem listCmd Compilers Nothing mver msystem@@ -169,6 +173,8 @@ cleanGhcSnapshots deletion cwd ghcver Compilers -> do removeGhcVersionInstallation deletion ghcver msystem+ Tarballs -> do+ removeGhcVersionTarball deletion ghcver msystem GHC -> do removeRun deletion Compilers Nothing ghcver msystem removeRun deletion Snapshots Nothing ghcver msystem@@ -198,6 +204,7 @@ setStackSnapshotsDir msystem cleanMinorSnapshots deletion cwd mver Compilers -> removeGhcMinorInstallation deletion mver msystem+ Tarballs -> removeGhcMinorTarball deletion mver msystem GHC -> do removeMinorsRun deletion Compilers Nothing mver msystem removeMinorsRun deletion Snapshots Nothing mver msystem
src/Snapshots.hs view
@@ -27,7 +27,8 @@ import System.FilePath import Text.Printf -import Directories (globDirs, getStackSubdir, switchToSystemDirUnder)+import Directories (globDirs, getStackSubdir, listCurrentDirectory,+ switchToSystemDirUnder) import qualified Remove import Types import Versions@@ -148,7 +149,7 @@ newestTimeStamp dir = do withCurrentDirectory dir $ do- files <- listDirectory "."+ files <- listCurrentDirectory timestamp <- maximum <$> mapM getModificationTime files return (dir, timestamp)
stack-clean-old.cabal view
@@ -1,5 +1,5 @@ name: stack-clean-old-version: 0.4.6+version: 0.4.7 synopsis: Clean away old stack build artifacts description: A tool for removing old .stack-work/install builds and@@ -9,7 +9,7 @@ license-file: LICENSE author: Jens Petersen <juhpetersen@gmail.com> maintainer: Jens Petersen <juhpetersen@gmail.com>-copyright: 2020-2022 Jens Petersen <juhpetersen@gmail.com>+copyright: 2020-2023 Jens Petersen <juhpetersen@gmail.com> homepage: https://github.com/juhp/stack-clean-old bug-reports: https://github.com/juhp/stack-clean-old/issues build-type: Simple@@ -27,6 +27,7 @@ other-modules: Paths_stack_clean_old Directories GHC+ GHCTarball Remove Snapshots Types