packages feed

cabal-clean 0.1.20210924 → 0.1.20220814

raw patch · 8 files changed

+104/−84 lines, 8 files

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+0.1.20220814+------------++Windows: Fix crash when `du` is not available.+ 0.1.20210924 ------------
README.md view
@@ -91,7 +91,7 @@ --------  List build artifacts of current project,-marking superseded ones that can be deleded:+marking superseded ones that can be deleted:      cabal-clean
cabal-clean.cabal view
@@ -1,7 +1,7 @@ cabal-version:       >=1.10  name:                cabal-clean-version:             0.1.20210924+version:             0.1.20220814 synopsis:            Remove outdated cabal build artefacts from `dist-newstyle`.  description:         Simple command line tool to remove cabal build artefacts@@ -30,18 +30,14 @@   GHC == 8.6.5   GHC == 8.8.4   GHC == 8.10.7-  GHC == 9.0.1-  GHC == 9.2.0.20210821+  GHC == 9.0.2+  GHC == 9.2.4+  GHC == 9.4.1  source-repository head   type:     git   location: git://github.com/andreasabel/cabal-clean.git -source-repository this-  type:     git-  location: git://github.com/andreasabel/cabal-clean.git-  tag:      v0.1.20210924- executable cabal-clean   main-is:             Main.hs @@ -49,6 +45,7 @@     License     Options     Structure+    Types     Util     Version     Paths_cabal_clean
src/Main.hs view
@@ -19,8 +19,6 @@  import System.Console.Pretty   ( supportsPretty )-import System.IO-  ( hPutStr, hPutStrLn, stderr )  import License   ( copyright, license )@@ -178,15 +176,3 @@       , "(E.g., there could be symlinks to executables stored there.)"       ]     ]---- * Verbosity functionality.--chat :: Options -> String -> IO ()-chat = chatGen $ hPutStr stderr--chatLn :: Options -> String -> IO ()-chatLn = chatGen $ hPutStrLn stderr--chatGen :: (String -> IO ()) -> Options -> String -> IO ()-chatGen prt o msg = when (optVerbose o) $-  prt $ styleOpt o Faint $ unwords ["info:", msg]
src/Options.hs view
@@ -5,7 +5,7 @@   ( Color(Green, Red, White)   , Style(ColoredNormal, Faint, Italic)   )-import System.FilePath (FilePath)+import Util  data Options = Options   { optDelete     :: Bool@@ -26,3 +26,15 @@ applyWhenColors opts   | optNoColors opts = \ _ _ -> id   | otherwise        = id++-- * Verbosity functionality.++chat :: Options -> String -> IO ()+chat = chatGen $ hPutStr stderr++chatLn :: Options -> String -> IO ()+chatLn = chatGen $ hPutStrLn stderr++chatGen :: (String -> IO ()) -> Options -> String -> IO ()+chatGen prt o msg = when (optVerbose o) $+  prt $ styleOpt o Faint $ unwords ["info:", msg]
src/Structure.hs view
@@ -39,6 +39,7 @@ import Util  import Options+import Types  -- | The structure of the build directory. @@ -67,25 +68,6 @@   , obsolete :: Bool   } deriving Show --- | We treat the architecture identifier as opaque.-type Arch = String---- | A package is given by its name.-type Package = String---- | A package version is a list of natural numbers.-type PackageVersion  = NumericVersion---- | A GHC major version is a list of natural numbers.-type MajorVersion = NumericVersion---- | A GHC minor version is a list of natural numbers.-type MinorVersion = NumericVersion--type CompilerVersion = (MajorVersion, MinorVersion)--type NumericVersion = [Int]- -- * Loading the build tree from disc.  type Warnings = [String]@@ -133,16 +115,19 @@ -- or a new compiler minor version.  markObsolete :: BuildTree -> BuildTree-markObsolete (BuildTree t) = BuildTree $-  flip fmap t $ modifyDesc $ \case-    [] -> []-    (ver, m) : vms ->-      (ver, flip (fmap . fmap) m $ modifyDesc $ \case-        [] -> []-        me : mes -> me : map (second markEntryObsolete) mes-      ) : map (second $ fmap $ fmap $ fmap markEntryObsolete) vms-+markObsolete =+  -- for each Package, from highest to lowest PackageVersion:+  modifyBuildTree $ fmap $ modifyDesc $ modifyCons+    -- keep the highest PackageVersion, but iterate through GHC MinorVersion+    (second $ fmap $ fmap $ modifyDesc $ modifyCons+      -- keep the highest MinorVersion+      id+      -- mark lower MinorVersion as obsolete+      (map $ second markEntryObsolete))+    -- mark lower PackageVersion as obsolete+    (map $ second $ fmap $ fmap $ fmap markEntryObsolete)   where+  modifyBuildTree f (BuildTree t) = BuildTree (f t)   modifyDesc f = Map.fromDescList . f . Map.toDescList   -- mapDesc f = Map.fromDescList . map (second f) . Map.toDescList @@ -162,8 +147,7 @@  printBuildTree :: Options -> BuildTree -> IO () printBuildTree opts = foldMapEntry $ \ (Entry dir obsolete) -> do-  (exitcode, stdout, _stderr) <- readProcessWithExitCode "du" ["-hs", dir] ""-  let s = if exitcode == ExitSuccess then stdout else dir ++ "\n"+  s <- readProcess "du" ["-hs", dir] "" `catchIOError` \ _ -> pure (dir ++ "\n")   putStr $ colorize obsolete s   where   colorize True  = colorOpt opts Red   . ("---\t" ++)@@ -205,32 +189,9 @@ foldMapEntry :: Monoid m => (Entry -> m) -> BuildTree -> m foldMapEntry f (BuildTree t) = (foldMap . foldMap . foldMap . foldMap . foldMap) f t --- * Parsing directory names--parseKey :: Arch -> CompilerString -> PackageString -> Maybe Key-parseKey arch hc s = do-  (major, minor) <- parseCompilerString hc-  (pkg  , ver  ) <- parsePackageString s-  return $ Key pkg ver arch major minor--type CompilerString = String--parseCompilerString :: CompilerString -> Maybe CompilerVersion-parseCompilerString s = do-  n <- findIndex (== '-') s-  case splitAt n s of-    ("ghc", _:v) -> splitAt 2 <$> parseVersionString v-    _ -> Nothing--type PackageString = String--parsePackageString :: PackageString -> Maybe (Package, PackageVersion)-parsePackageString s = do-  n <- findIndexEnd (== '-') s-  let (p, _:v) = splitAt n s-  (p,) <$> parseVersionString v--type VersionString = String--parseVersionString :: VersionString -> Maybe NumericVersion-parseVersionString = mapM readMaybe . splitWhen (== '.')+-- -- UNUSED+-- parseKey :: Arch -> CompilerString -> PackageString -> Maybe Key+-- parseKey arch hc s = do+--   (major, minor) <- parseCompilerString hc+--   (pkg  , ver  ) <- parsePackageString s+--   return $ Key pkg ver arch major minor
+ src/Types.hs view
@@ -0,0 +1,48 @@+-- | Common data structures and types for the project.++module Types where++import Util++-- | We treat the architecture identifier as opaque.+type Arch = String++-- | A package is given by its name.+type Package = String++-- | A package version is a list of natural numbers.+type PackageVersion  = NumericVersion++-- | A GHC major version is a list of natural numbers.+type MajorVersion = NumericVersion++-- | A GHC minor version is a list of natural numbers.+type MinorVersion = NumericVersion++type CompilerVersion = (MajorVersion, MinorVersion)++type NumericVersion = [Int]++-- * Parsing directory names++type CompilerString = String++parseCompilerString :: CompilerString -> Maybe CompilerVersion+parseCompilerString s = do+  n <- findIndex (== '-') s+  case splitAt n s of+    ("ghc", _:v) -> splitAt 2 <$> parseVersionString v+    _ -> Nothing++type PackageString = String++parsePackageString :: PackageString -> Maybe (Package, PackageVersion)+parsePackageString s = do+  n <- findIndexEnd (== '-') s+  let (p, _:v) = splitAt n s+  (p,) <$> parseVersionString v++type VersionString = String++parseVersionString :: VersionString -> Maybe NumericVersion+parseVersionString = mapM readMaybe . splitWhen (== '.')
src/Util.hs view
@@ -20,7 +20,9 @@ import System.Directory       as X (doesDirectoryExist, listDirectory, removeDirectoryRecursive) import System.Exit            as X (die, ExitCode(..)) import System.FilePath        as X ((</>))-import System.Process         as X (readProcessWithExitCode)+import System.Process         as X (readProcess)+import System.IO              as X (hPutStr, hPutStrLn, stderr)+import System.IO.Error        as X (catchIOError)  import Text.Read              as X (readMaybe) @@ -43,3 +45,12 @@ last1 :: a -> [a] -> a last1 a []     = a last1 _ (a:as) = last1 a as++modifyCons :: (a -> a) -> ([a] -> [a]) -> [a] -> [a]+modifyCons f g = \case+  []   -> []+  x:xs -> f x : g xs++-- UNUSED+modifyTail :: ([a] -> [a]) -> [a] -> [a]+modifyTail = modifyCons id