remove-old-stack-work-libs.hs: use regexp to handle internal libraries

regexp match filters out "-ver-hash"
This commit is contained in:
Jens Petersen 2020-05-19 13:34:42 +08:00
parent 3ced32f343
commit 790362013b

View File

@ -7,17 +7,15 @@
-- work/*/unpack-dir/.stack-work/install/x86_64-linux/*/*/lib/x86_64-linux-ghc-*
import Data.List
import Data.List.Extra
import System.Directory
import System.FilePath
import Text.Regex.TDFA
main = do
files <- sort <$> listDirectory "."
let (dynlibs,libdirs) = partition (".so" `isExtensionOf`) files
pkglibdirs = groupBy samePkgLibDir $
filter (not . ("-internal" `isSuffixOf`)) libdirs
pkgdynlibs = groupBy samePkgDynLib $
filter (not . ("-internal-" `isInfixOf`)) dynlibs
pkglibdirs = groupBy samePkgLibDir libdirs
pkgdynlibs = groupBy samePkgDynLib dynlibs
mapM_ (removeOlder removeDirectoryRecursive) pkglibdirs
mapM_ (removeOlder removeFile) pkgdynlibs
where
@ -26,24 +24,21 @@ main = do
pkgDirName p =
if length p < 25
then error $ p ++ " too short to be in correct name-version-hash format"
else (removeDashSegment . removeHashSegment) p
else extractNameInternal p
removeHashSegment p =
let dashes = elemIndices '-' p in
if length dashes < 2
then error $ p ++ " not in name-version-hash format"
else let final = last dashes in
if length p - final `elem` [23,22,21] then take final p
else error $ p ++ " has incorrect hash length"
removeDashSegment = init . dropWhileEnd (/= '-')
extractNameInternal :: String -> String
extractNameInternal p =
let (name,_,internal) = p =~ "-[0-9.]+-[0-9A-Za-z]{20,22}" :: (String, String, String)
in name ++ internal
samePkgDynLib d1 d2 = pkgDynName d1 == pkgDynName d2
where
pkgDynName p =
if length p < 42
then error $ p ++ " too short to be libHSname-version-hash-ghc*.so format"
else (removeDashSegment . removeHashSegment . removeDashSegment) p
else (extractNameInternal . removeDashSegment) p
removeDashSegment = dropWhileEnd (/= '-')
removeOlder remover files = do
-- keep 2 latest builds