From 0fa495a6f30cfdbb8bb20029fb8c1d9922e13ea2 Mon Sep 17 00:00:00 2001 From: Mitsutoshi Aoe Date: Tue, 18 Jun 2019 10:22:19 +0900 Subject: [PATCH 1/2] install.hs: Make all available GHCs in PATH buildable --- install.hs | 44 +++++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/install.hs b/install.hs index 0e3c314c4..b61323ab3 100755 --- a/install.hs +++ b/install.hs @@ -19,6 +19,7 @@ import Control.Monad.Extra ( unlessM ) import Data.Maybe ( isJust ) import System.Directory ( findExecutable + , findExecutables , listDirectory ) import System.Environment ( getProgName @@ -34,6 +35,8 @@ import Data.Maybe ( isNothing import Data.List ( dropWhileEnd , intersperse , intercalate + , isInfixOf + , nubBy , sort ) import qualified Data.Text as T @@ -42,7 +45,9 @@ import Data.Version ( parseVersion , makeVersion , showVersion ) -import Data.Function ( (&) ) +import Data.Function ( (&) + , on + ) import Text.ParserCombinators.ReadP ( readP_to_S ) type VersionNumber = String @@ -143,7 +148,7 @@ main = do forM_ ghcVersions cabalTest forM_ - hieVersions + ghcVersions (\version -> phony ("cabal-hie-" ++ version) $ do validateCabalNewInstallIsSupported need ["submodules"] @@ -182,7 +187,7 @@ validateCabalNewInstallIsSupported = when isWindowsSystem $ do configureCabal :: VersionNumber -> Action () configureCabal versionNumber = do - ghcPath <- getGhcPath versionNumber >>= \case + ghcPath <- getGhcPathOf versionNumber >>= \case Nothing -> do liftIO $ putStrLn $ embedInStars (ghcVersionNotFoundFailMsg versionNumber) error (ghcVersionNotFoundFailMsg versionNumber) @@ -193,12 +198,18 @@ configureCabal versionNumber = do findInstalledGhcs :: IO [(VersionNumber, GhcPath)] findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] - mapMaybeM - (\version -> getGhcPath version >>= \case + knownGhcs <- mapMaybeM + (\version -> getGhcPathOf version >>= \case Nothing -> return Nothing Just p -> return $ Just (version, p) ) (reverse hieVersions) + availableGhcs <- getGhcPaths + return + -- filter out stack provided GHCs + $ filter (not . isInfixOf ".stack" . snd) + -- nub by version. knownGhcs takes precedence. + $ nubBy ((==) `on` fst) (knownGhcs ++ availableGhcs) cabalBuildHie :: VersionNumber -> Action () cabalBuildHie versionNumber = do @@ -515,16 +526,19 @@ getStackGhcPathShake = do -- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. -- If this yields no result, it is checked, whether the numeric-version of the `ghc` -- command fits to the desired version. -getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath) -getGhcPath ghcVersion = liftIO $ - findExecutable ("ghc-" ++ ghcVersion) >>= \case - Nothing -> do - findExecutable "ghc" >>= \case - Nothing -> return Nothing - Just p -> do - Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String) - if ghcVersion == trim version then return $ Just p else return Nothing - p -> return p +getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath) +getGhcPathOf ghcVersion = + liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case + Nothing -> lookup ghcVersion <$> getGhcPaths + path -> return path + +-- | Get a list of GHCs that are available in $PATH +getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)] +getGhcPaths = liftIO $ do + paths <- findExecutables "ghc" + forM paths $ \path -> do + Stdout version <- cmd path ["--numeric-version"] + return (trim version, path) -- | Read the local install root of the stack project specified by the VersionNumber -- Returns the filepath of the local install root. From fdaf48bc135332278211c9a07ae9ce3cc5fb5b33 Mon Sep 17 00:00:00 2001 From: Mitsutoshi Aoe Date: Wed, 19 Jun 2019 09:02:08 +0900 Subject: [PATCH 2/2] fixup! install.hs: Make all available GHCs in PATH buildable --- install.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/install.hs b/install.hs index b61323ab3..c3ca1b0f1 100755 --- a/install.hs +++ b/install.hs @@ -206,10 +206,10 @@ findInstalledGhcs = do (reverse hieVersions) availableGhcs <- getGhcPaths return - -- filter out stack provided GHCs - $ filter (not . isInfixOf ".stack" . snd) -- nub by version. knownGhcs takes precedence. - $ nubBy ((==) `on` fst) (knownGhcs ++ availableGhcs) + $ nubBy ((==) `on` fst) + -- filter out stack provided GHCs + $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) cabalBuildHie :: VersionNumber -> Action () cabalBuildHie versionNumber = do