haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-24 13:11:57 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

simplify remove-old-stack-work-libs.hs more

Browse Source
This commit is contained in:
Jens Petersen 2020-05-19 10:58:47 +08:00
parent e243a37f64
commit 9ba15fcde0
1 changed files with 5 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
etc/diskspace/remove-old-stack-work-libs.hs
View File

@ -8,11 +8,12 @@
import Data.List import Data.List
import System.Directory import System.Directory
import System.FilePath
main = do main = do
files <- sort <$> listDirectory "." files <- sort <$> listDirectory "."
(libdirs,dynlibs) <- partitionM doesDirectoryExist files let (dynlibs,libdirs) = partition (".so" `isExtensionOf`) files
let pkglibdirs = groupBy samePkgLibDir libdirs pkglibdirs = groupBy samePkgLibDir libdirs
pkgdynlibs = groupBy samePkgDynLib dynlibs pkgdynlibs = groupBy samePkgDynLib dynlibs
mapM_ (removeOlder removeDirectoryRecursive) pkglibdirs mapM_ (removeOlder removeDirectoryRecursive) pkglibdirs
mapM_ (removeOlder removeFile) pkgdynlibs mapM_ (removeOlder removeFile) pkgdynlibs
@ -32,10 +33,11 @@ main = do
where where
pkgDynName p = pkgDynName p =
if countDashes p < 3 if countDashes p < 3
then error $ p ++ " not in libname-version-hash-ghc*.so format" then error $ p ++ " not in libHSname-version-hash-ghc*.so format"
else (removeDashSegment . removeDashSegment . removeDashSegment) p else (removeDashSegment . removeDashSegment . removeDashSegment) p
removeOlder remover files = do removeOlder remover files = do
-- keep 2 latest builds
oldfiles <- drop 2 . reverse <$> sortByAge files oldfiles <- drop 2 . reverse <$> sortByAge files
mapM_ remover oldfiles mapM_ remover oldfiles
@ -45,11 +47,3 @@ main = do
return $ map fst $ sortBy compareSnd fileTimes return $ map fst $ sortBy compareSnd fileTimes
compareSnd (_,t1) (_,t2) = compare t1 t2 compareSnd (_,t1) (_,t2) = compare t1 t2
-- borrowed from Control.Monad.Extra
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM f [] = pure ([], [])
partitionM f (x:xs) = do
res <- f x
(as,bs) <- partitionM f xs
pure ([x | res]++as, [x | not res]++bs)