Skip to content
This repository has been archived by the owner on Oct 7, 2020. It is now read-only.

install.hs: Make all available GHCs in PATH buildable #1297

Merged
merged 2 commits into from
Jun 21, 2019
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
44 changes: 29 additions & 15 deletions install.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ import Control.Monad.Extra ( unlessM
)
import Data.Maybe ( isJust )
import System.Directory ( findExecutable
, findExecutables
, listDirectory
)
import System.Environment ( getProgName
Expand All @@ -34,6 +35,8 @@ import Data.Maybe ( isNothing
import Data.List ( dropWhileEnd
, intersperse
, intercalate
, isInfixOf
, nubBy
, sort
)
import qualified Data.Text as T
Expand All @@ -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
Expand Down Expand Up @@ -143,7 +148,7 @@ main = do
forM_ ghcVersions cabalTest

forM_
hieVersions
ghcVersions
(\version -> phony ("cabal-hie-" ++ version) $ do
validateCabalNewInstallIsSupported
need ["submodules"]
Expand Down Expand Up @@ -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)
Expand All @@ -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)
fendor marked this conversation as resolved.
Show resolved Hide resolved
-- nub by version. knownGhcs takes precedence.
$ nubBy ((==) `on` fst) (knownGhcs ++ availableGhcs)

cabalBuildHie :: VersionNumber -> Action ()
cabalBuildHie versionNumber = do
Expand Down Expand Up @@ -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.
Expand Down