From 790362013b093c98d64fdefaa9bba79b4ca1a9fb Mon Sep 17 00:00:00 2001
From: Jens Petersen <juhpetersen@gmail.com>
Date: Tue, 19 May 2020 13:34:42 +0800
Subject: [PATCH] remove-old-stack-work-libs.hs: use regexp to handle internal
 libraries

regexp match filters out "-ver-hash"
---
 etc/diskspace/remove-old-stack-work-libs.hs | 27 +++++++++------------
 1 file changed, 11 insertions(+), 16 deletions(-)

diff --git a/etc/diskspace/remove-old-stack-work-libs.hs b/etc/diskspace/remove-old-stack-work-libs.hs
index 50009d8d..2a85942e 100755
--- a/etc/diskspace/remove-old-stack-work-libs.hs
+++ b/etc/diskspace/remove-old-stack-work-libs.hs
@@ -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