git.iko.soy/stackage
on master help sign in
remove-old-stack-work-libs.hs: hashes are either 22 or 21 chars
fda199bJens Petersen
etc/diskspace/remove-old-stack-work-libs.hs+12−15
compare with master
unifiedsplit
@@ -7,6 +7,7 @@
7-- work/*/unpack-dir/.stack-work/install/x86_64-linux/*/*/lib/x86_64-linux-ghc-*
7-- work/*/unpack-dir/.stack-work/install/x86_64-linux/*/*/lib/x86_64-linux-ghc-*
8
8
9import Data.List
9import Data.List
10+import Data.List.Extra
10import System.Directory
11import System.Directory
11import System.FilePath
12import System.FilePath
12
13
@@ -21,23 +22,25 @@ main = do
21 samePkgLibDir l1 l2 = pkgDirName l1 == pkgDirName l2
22 samePkgLibDir l1 l2 = pkgDirName l1 == pkgDirName l2
22 where
23 where
23 pkgDirName p =
24 pkgDirName p =
24− if length p < 26 || countDashes p < 2
25+ if length p < 25
25− then error $ p ++ " not in name-version-hash format"
26+ then error $ p ++ " too short to be in correct name-version-hash format"
26 else (removeDashSegment . removeHashSegment) p
27 else (removeDashSegment . removeHashSegment) p
27
28
28− countDashes = length . filter (== '-')
29+ removeHashSegment p =
30+ let dashes = elemIndices '-' p in
31+ if length dashes < 2
32+ then error $ p ++ " not in name-version-hash format"
33+ else let final = last dashes in
34+ if length p - final `elem` [22,23] then take final p
35+ else error $ p ++ " has incorrect hash length"
29
36
30 removeDashSegment = init . dropWhileEnd (/= '-')
37 removeDashSegment = init . dropWhileEnd (/= '-')
31
38
32− removeHashSegment p = let nv_ = dropEnd 22 p in
33− if last nv_ == '-' then init nv_
34− else error $ p ++ " has incorrect hash format"
35−
36 samePkgDynLib d1 d2 = pkgDynName d1 == pkgDynName d2
39 samePkgDynLib d1 d2 = pkgDynName d1 == pkgDynName d2
37 where
40 where
38 pkgDynName p =
41 pkgDynName p =
39− if length p < 43 || countDashes p < 3
42+ if length p < 42
40− then error $ p ++ " not in libHSname-version-hash-ghc*.so format"
43+ then error $ p ++ " too short to be libHSname-version-hash-ghc*.so format"
41 else (removeDashSegment . removeHashSegment . removeDashSegment) p
44 else (removeDashSegment . removeHashSegment . removeDashSegment) p
42
45
43 removeOlder remover files = do
46 removeOlder remover files = do
@@ -51,9 +54,3 @@ main = do
51 return $ map fst $ sortBy compareSnd fileTimes
54 return $ map fst $ sortBy compareSnd fileTimes
52
55
53 compareSnd (_,t1) (_,t2) = compare t1 t2
56 compareSnd (_,t1) (_,t2) = compare t1 t2
54−
55−-- from Data.List.Extra
56−dropEnd :: Int -> [a] -> [a]
57−dropEnd i xs = f xs (drop i xs)
58− where f (x:xs) (y:ys) = x : f xs ys
59− f _ _ = []