diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index c95818a..55784e8 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -765,49 +765,22 @@ ghcToolFiles ver = do whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) (throwE (NotInstalled GHC ver)) - files <- liftIO $ listDirectory bindir - -- figure out the suffix, because this might not be `Version` for - -- alpha/rc releases, but x.y.a.somedate. + files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir ))) + pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files) - ghcIsHadrian <- liftIO $ isHadrian bindir - onlyUnversioned <- case ghcIsHadrian of - Right () -> pure id - Left (fmap (dropSuffix exeExt) -> [ghc, ghc_ver]) - | (Just symver) <- stripPrefix (ghc <> "-") ghc_ver - , not (null symver) -> pure $ filter (\x -> not $ symver `isInfixOf` x) - _ -> fail "Fatal: Could not find internal GHC version" - - pure $ onlyUnversioned $ fmap (dropSuffix exeExt) files where - isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs - -- GHC is moving some builds to Hadrian for bindists, - -- which doesn't create versioned binaries. - -- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31 - isHadrian :: FilePath -- ^ ghcbin path - -> IO (Either [String] ()) -- ^ Right for Hadrian - isHadrian dir = do - -- Non-hadrian has e.g. ["ghc", "ghc-8.10.4"] - -- which also requires us to discover the internal version - -- to filter the correct tool files. - -- We can't use the symlink on windows, so we fall back to some - -- more complicated logic. - fs <- fmap - -- regex over-matches - (filter (isNotAnyInfix ["haddock", "ghc-pkg", "ghci"])) - $ liftIO $ findFiles - dir - (makeRegexOpts compExtended - execBlank - -- for cross, this won't be "ghc", but e.g. - -- "armv7-unknown-linux-gnueabihf-ghc" - ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc.*$|] :: ByteString) - ) - if | length fs == 1 -> pure $ Right () -- hadrian - | length fs == 2 -> pure $ Left - (sortOn length fs) -- legacy make, result should - -- be ["ghc", "ghc-8.10.4"] - | otherwise -> fail "isHadrian failed!" + groupToolFiles :: [FilePath] -> [[(FilePath, String)]] + groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-") + + getUniqueTools :: [[(FilePath, String)]] -> [String] + getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat + + blackListedTools :: [String] + blackListedTools = ["haddock-ghc"] + + isNotAnyInfix :: [String] -> String -> Bool + isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs -- | This file, when residing in @~\/.ghcup\/ghc\/\\/@ signals that diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index 76fbd35..772de10 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -26,7 +26,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class ( lift ) import Data.Bifunctor import Data.ByteString ( ByteString ) -import Data.List ( nub ) +import Data.List ( nub, intercalate ) import Data.Foldable import Data.String import Data.Text ( Text ) @@ -47,6 +47,7 @@ import GHC.IO.Exception import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Strict.Maybe as S +import qualified Data.List.Split as Split import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding.Error as E @@ -425,3 +426,19 @@ isNewLine w | w == _lf = True | w == _cr = True | otherwise = False + + +-- | Split on a PVP suffix. +-- +-- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706" == ("ghc-iserv-dyn", "9.3.20210706") +-- >>> splitOnPVP "-" "ghc-iserv-dyn" == ("ghc-iserv-dyn", "") +splitOnPVP :: String -> String -> (String, String) +splitOnPVP c s = case Split.splitOn c s of + [] -> def + [_] -> def + xs + | let l = last xs + , (Right _) <- pvp (T.pack l) -> (intercalate c (init xs), l) + | otherwise -> def + where + def = (s, "")