@@ -0,0 +1,55 @@
1+#!/usr/bin/env stack
2+-- stack --resolver lts-14 script
3+
4+-- Utility to remove old libs installed under .stack-work/ to save diskspace
5+
6+-- Should be run in:
7+-- work/*/unpack-dir/.stack-work/install/x86_64-linux/*/*/lib/x86_64-linux-ghc-*
8+
9+import Data.List
10+import System.Directory
11+
12+main = do
13+ files <- sort <$> listDirectory "."
14+ (libdirs,dynlibs) <- partitionM doesDirectoryExist files
15+ let pkglibdirs = groupBy samePkgLibDir libdirs
16+ pkgdynlibs = groupBy samePkgDynLib dynlibs
17+ mapM_ (removeOlder removeDirectoryRecursive) pkglibdirs
18+ mapM_ (removeOlder removeFile) pkgdynlibs
19+ where
20+ samePkgLibDir l1 l2 = pkgDirName l1 == pkgDirName l2
21+ where
22+ pkgDirName p =
23+ if countDashes p < 2
24+ then error $ p ++ " not in name-version-hash format"
25+ else (removeDashSegment . removeDashSegment) p
26+
27+ countDashes = length . filter (== '-')
28+
29+ removeDashSegment = init . dropWhileEnd (/= '-')
30+
31+ samePkgDynLib d1 d2 = pkgDynName d1 == pkgDynName d2
32+ where
33+ pkgDynName p =
34+ if countDashes p < 3
35+ then error $ p ++ " not in libname-version-hash-ghc*.so format"
36+ else (removeDashSegment . removeDashSegment . removeDashSegment) p
37+
38+ removeOlder remover files = do
39+ oldfiles <- drop 2 . reverse <$> sortByAge files
40+ mapM_ remover oldfiles
41+
42+ sortByAge files = do
43+ timestamps <- mapM getModificationTime files
44+ let fileTimes = zip files timestamps
45+ return $ map fst $ sortBy compareSnd fileTimes
46+
47+ compareSnd (_,t1) (_,t2) = compare t1 t2
48+
49+-- borrowed from Control.Monad.Extra
50+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
51+partitionM f [] = pure ([], [])
52+partitionM f (x:xs) = do
53+ res <- f x
54+ (as,bs) <- partitionM f xs
55+ pure ([x | res]++as, [x | not res]++bs)