diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/src/Directories.hs b/src/Directories.hs --- a/src/Directories.hs +++ b/src/Directories.hs @@ -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 "." diff --git a/src/GHC.hs b/src/GHC.hs --- a/src/GHC.hs +++ b/src/GHC.hs @@ -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 diff --git a/src/GHCTarball.hs b/src/GHCTarball.hs new file mode 100644 --- /dev/null +++ b/src/GHCTarball.hs @@ -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" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Snapshots.hs b/src/Snapshots.hs --- a/src/Snapshots.hs +++ b/src/Snapshots.hs @@ -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) diff --git a/stack-clean-old.cabal b/stack-clean-old.cabal --- a/stack-clean-old.cabal +++ b/stack-clean-old.cabal @@ -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 maintainer: Jens Petersen -copyright: 2020-2022 Jens Petersen +copyright: 2020-2023 Jens Petersen 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