mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
remove-old-stack-work-libs.hs: use regexp to handle internal libraries
regexp match filters out "-ver-hash"
This commit is contained in:
parent
3ced32f343
commit
790362013b
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user