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

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

Browse Source 
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
1 changed files with 11 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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