Compare commits

..

32 Commits

Author SHA1 Message Date
5f6b5f845d Add --disable-ld-override for darwin bindists
Fixes #391
2022-07-25 17:57:10 +08:00
b0fecce0d1 Merge remote-tracking branch 'origin/merge-requests/273' 2022-07-24 20:24:00 +08:00
Mike Pilgrem
27c06ddde7 Fix #293 Document expressly how installation scripts can be customised
The proposed addition does not go into the mechanism (the names of the specific environment variables or the PowerShell parameters) but is more express about in what manner the behaviour of the installation scripts can be changed.

Introduces that important flexibility as the first topic under 'More on installation'.

Explains that the PowerShell script finally (by default) runs the script for Unix-like operating systems (so a Windows user understands better that the environment variables in the former are applicable to both, and what is meant by the 'final' bootstrap script in the content of the Windows parameters).

Refers to what has gone before, under 'Continuous integration', rather than repeat the added content.
2022-07-23 21:32:15 +01:00
3154d2839b Merge remote-tracking branch 'origin/merge-requests/272' 2022-07-23 23:27:33 +08:00
Mike Pilgrem
511d8d5ed8 Update guide.md to explain what is meant by 'TUI'. 2022-07-23 14:25:49 +00:00
fe22405ee1 Merge branch 'issue-383' 2022-07-12 20:44:09 +02:00
ea828cd13a Fix non-interactive install on windows 2022-07-12 20:26:57 +02:00
00fa70b9de Merge remote-tracking branch 'origin/merge-requests/266' 2022-07-12 00:15:14 +02:00
823275363c Merge branch 'ghcup-run-improvements' 2022-07-12 00:10:17 +02:00
2f299ee48d Merge branch 'hls-hackage' 2022-07-12 00:06:40 +02:00
7a2a5074fa Fix parsing issues with 'ghcup run' and non-PVP versions
This is a major refactor of some CLI code. We try to distinguish
GHC versions from other versions, so that we can use distinct parsers.

Hopefully this doesn't introduce new bugs.

This also forces ghcup run to use the new internal ~/.ghcup/tmp dir.
2022-07-11 19:45:15 +02:00
ce239ab88e Fix error message 2022-07-11 19:44:10 +02:00
f3c703d655 Support hls in 'ghcup changelog' 2022-07-11 19:44:10 +02:00
b6ff5bc764 Use ghcup's internal dir for 'ghcup run' 2022-07-11 19:43:48 +02:00
b8aeb1f935 Fix guide 2022-07-11 00:43:18 +02:00
b0ef0590a2 Merge branch 'pwsh' 2022-07-10 21:21:17 +02:00
256e1942f2 More stuff 2022-07-10 21:19:45 +02:00
aa71f0dfa1 Set wget 2022-07-10 21:05:51 +02:00
04d527c98a Add DisableCurl powershell switch 2022-07-10 20:58:30 +02:00
Arjun Kathuria
ca5c5550ab removes newline after set' function 2022-07-10 21:49:54 +05:30
7b59621179 Support wget in bootstrap script 2022-07-10 17:56:00 +02:00
9d59463ded Add GHCUP_CURL_OPTS to bootstrap script 2022-07-10 17:35:45 +02:00
Arjun Kathuria
3d49f79beb removes prettyShow from error case in BrickMain set' 2022-07-10 09:52:57 +05:30
Arjun Kathuria
e9740d13fc Updates userPrompt in BrickMain to a more efficient version 2022-07-10 09:50:58 +05:30
Arjun Kathuria
2bd5a8fe1a Removes redundant putPrompt function from Prompts module. 2022-07-10 09:45:39 +05:30
Arjun Kathuria
0acccae523 Removes GHCup.Types.Prompts module and stuffs it into GHCup.Types 2022-07-10 09:44:23 +05:30
Arjun Kathuria
9ceb66ef21 chore: fix a hlint warning 2022-06-28 22:10:02 +05:30
Arjun Kathuria
7cbe38b011 Behavior Enhancement: make user press "S" only once to set, asks to install AND set if tool uninstalled 2022-06-28 19:50:22 +05:30
Arjun Kathuria
3bbc1edb19 updates user prompt message for "set" uninstalled version in BrickMain 2022-06-28 19:49:00 +05:30
Arjun Kathuria
b8dac2d7cd Updates the Prompt module to use logInfo instead of putStrLn,
makes the prompt look prettier
2022-06-28 19:45:17 +05:30
Arjun Kathuria
0e1fd68d93 when setting an uninstalled tool in tui, asks user to install first 2022-06-25 13:45:07 +05:30
Arjun Kathuria
c7eceb2330 Adds GHCup.Prompt modules and its types to project 2022-06-25 13:44:25 +05:30
20 changed files with 452 additions and 189 deletions

View File

@@ -17,6 +17,7 @@ import GHCup.Prelude ( decUTF8Safe )
import GHCup.Prelude.File import GHCup.Prelude.File
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.Process import GHCup.Prelude.Process
import GHCup.Prompts
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
@@ -52,6 +53,8 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy as L
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Data.Vector as V import qualified Data.Vector as V
import System.Environment (getExecutablePath) import System.Environment (getExecutablePath)
@@ -98,7 +101,7 @@ keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt) [ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install') , (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del') , (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction ((liftIO .) . set')) , (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog') , (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAllVersions , ( bShowAllVersions
, \BrickSettings {..} -> , \BrickSettings {..} ->
@@ -486,9 +489,12 @@ install' _ (_, ListResult {..}) = do
<> "Also check the logs in ~/.ghcup/logs" <> "Also check the logs in ~/.ghcup/logs"
set' :: BrickState -> (Int, ListResult) -> IO (Either String ()) set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
set' _ (_, ListResult {..}) = do => BrickState
settings <- readIORef settings' -> (Int, ListResult)
-> m (Either String ())
set' bs input@(_, ListResult {..}) = do
settings <- liftIO $ readIORef settings'
let run = let run =
flip runReaderT settings flip runReaderT settings
@@ -504,7 +510,28 @@ set' _ (_, ListResult {..}) = do
) )
>>= \case >>= \case
VRight _ -> pure $ Right () VRight _ -> pure $ Right ()
VLeft e -> pure $ Left (prettyShow e) VLeft e -> case e of
(V (NotInstalled tool _)) -> do
promptAnswer <- getUserPromptResponse userPrompt
case promptAnswer of
PromptYes -> do
res <- install' bs input
case res of
(Left err) -> pure $ Left err
(Right _) -> do
logInfo "Setting now..."
set' bs input
PromptNo -> pure $ Left (prettyShow e)
where
userPrompt = L.toStrict . B.toLazyText . B.fromString $
"This Version of "
<> show tool
<> " you are trying to set is not installed.\n"
<> "Would you like to install it first? [Y/N]: "
_ -> pure $ Left (prettyShow e)
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m) del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)

View File

@@ -58,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
changelogP :: Parser ChangeLogOptions changelogP :: Parser ChangeLogOptions
changelogP = changelogP =
(\x y -> ChangeLogOptions x y) (\x y -> ChangeLogOptions x y)
@@ -71,15 +71,16 @@ changelogP =
"cabal" -> Right Cabal "cabal" -> Right Cabal
"ghcup" -> Right GHCup "ghcup" -> Right GHCup
"stack" -> Right Stack "stack" -> Right Stack
"hls" -> Right HLS
e -> Left e e -> Left e
) )
) )
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
"Open changelog for given tool (default: ghc)" "Open changelog for given tool (default: ghc)"
<> completer toolCompleter <> completer toolCompleter
) )
) )
<*> optional (toolVersionArgument Nothing Nothing) <*> optional (toolVersionTagArgument Nothing Nothing)
@@ -116,7 +117,8 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
ver' = maybe ver' = maybe
(Right Latest) (Right Latest)
(\case (\case
ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion GHCVersion tv -> Left (_tvVersion tv)
ToolVersion tv -> Left tv
ToolTag t -> Right t ToolTag t -> Right t
) )
clToolVer clToolVer

View File

@@ -70,20 +70,24 @@ import Control.Exception (evaluate)
--[ Types ]-- --[ Types ]--
------------- -------------
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag | ToolTag Tag
-- a superset of ToolVersion -- a superset of ToolVersion
data SetToolVersion = SetToolVersion GHCTargetVersion data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version
| SetToolTag Tag | SetToolTag Tag
| SetRecommended | SetRecommended
| SetNext | SetNext
prettyToolVer :: ToolVersion -> String prettyToolVer :: ToolVersion -> String
prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v' prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t prettyToolVer (ToolTag t) = show t
toSetToolVer :: Maybe ToolVersion -> SetToolVersion toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v' toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t' toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer Nothing = SetRecommended toSetToolVer Nothing = SetRecommended
@@ -96,10 +100,9 @@ toSetToolVer Nothing = SetRecommended
-------------- --------------
-- | same as toolVersionParser, except as an argument. toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion toolVersionTagArgument criteria tool =
toolVersionArgument criteria tool = argument (eitherReader (parser tool))
argument (eitherReader toolVersionEither)
(metavar (mv tool) (metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) []) <> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool) <> foldMap (completer . versionCompleter criteria) tool)
@@ -108,20 +111,19 @@ toolVersionArgument criteria tool =
mv (Just HLS) = "HLS_VERSION|TAG" mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG" mv _ = "VERSION|TAG"
parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither
versionParser :: Parser GHCTargetVersion
versionParser = option
(eitherReader tVersionEither)
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack)) (eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
-- https://github.com/pcapriotti/optparse-applicative/issues/148 -- https://github.com/pcapriotti/optparse-applicative/issues/148
@@ -230,9 +232,15 @@ isolateParser f = case isValid f && isAbsolute f of
True -> Right $ normalise f True -> Right $ normalise f
False -> Left "Please enter a valid filepath for isolate dir." False -> Left "Please enter a valid filepath for isolate dir."
toolVersionEither :: String -> Either String ToolVersion -- this accepts cross prefix
toolVersionEither s' = ghcVersionTagEither :: String -> Either String ToolVersion
second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s') ghcVersionTagEither s' =
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither s' =
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
tagEither :: String -> Either String Tag tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of tagEither s' = case fmap toLower s' of
@@ -244,10 +252,14 @@ tagEither s' = case fmap toLower s' of
other -> Left $ "Unknown tag " <> other other -> Left $ "Unknown tag " <> other
tVersionEither :: String -> Either String GHCTargetVersion ghcVersionEither :: String -> Either String GHCTargetVersion
tVersionEither = ghcVersionEither =
first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
toolVersionEither :: String -> Either String Version
toolVersionEither =
first (const "Not a valid version") . MP.parse version' "" . T.pack
toolParser :: String -> Either String Tool toolParser :: String -> Either String Tool
toolParser s' | t == T.pack "ghc" = Right GHC toolParser s' | t == T.pack "ghc" = Right GHC
@@ -665,7 +677,7 @@ fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool bimap mkTVer Just <$> getRecommended dls tool
?? TagNotFound Recommended tool ?? TagNotFound Recommended tool
fromVersion' (SetToolVersion v) tool = do fromVersion' (SetGHCVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion v) tool dls let vi = getVersionInfo (_tvVersion v) tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
@@ -677,6 +689,18 @@ fromVersion' (SetToolVersion v) tool = do
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v') when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi') pure (GHCTargetVersion (_tvTarget v) v', Just vi')
Nothing -> pure (v, vi) Nothing -> pure (v, vi)
fromVersion' (SetToolVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls
case pvp $ prettyVer v of -- need to be strict here
Left _ -> pure (mkTVer v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mempty v', Just vi')
Nothing -> pure (mkTVer v, vi)
fromVersion' (SetToolTag Latest) tool = do fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool

View File

@@ -401,7 +401,7 @@ hlsCompileOpts =
) )
) )
<*> some ( <*> some (
option (eitherReader toolVersionEither) option (eitherReader ghcVersionTagEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)" ( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC []) <> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC)) <> completer (versionCompleter Nothing GHC))

View File

@@ -196,7 +196,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool)) <> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionArgument Nothing tool) <*> (Just <$> toolVersionTagArgument Nothing tool)
) )
<|> pure (Nothing, Nothing) <|> pure (Nothing, Nothing)
) )

View File

@@ -74,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
prefetchP :: Parser PrefetchCommand prefetchP :: Parser PrefetchCommand
prefetchP = subparser prefetchP = subparser
( command ( command
"ghc" "ghc"
(info (info
(PrefetchGHC (PrefetchGHC
<$> (PrefetchGHCOptions <$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper ) <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionArgument Nothing (Just GHC)) ) <*> optional (toolVersionTagArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation") ( progDesc "Download GHC assets for installation")
) )
<> <>
command command
"cabal" "cabal"
(info (info
(PrefetchCabal (PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )) <*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation") ( progDesc "Download cabal assets for installation")
) )
<> <>
command command
"hls" "hls"
(info (info
(PrefetchHLS (PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )) <*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation") ( progDesc "Download HLS assets for installation")
) )
<> <>
command command
"stack" "stack"
(info (info
(PrefetchStack (PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )) <*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation") ( progDesc "Download stack assets for installation")
) )
<> <>

View File

@@ -71,7 +71,7 @@ data RmOptions = RmOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
rmParser :: Parser (Either RmCommand RmOptions) rmParser :: Parser (Either RmCommand RmOptions)
rmParser = rmParser =
(Left <$> subparser (Left <$> subparser
@@ -103,7 +103,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Run where module GHCup.OptParse.Run where
@@ -46,6 +47,7 @@ import qualified Data.Text as T
#ifndef IS_WINDOWS #ifndef IS_WINDOWS
import qualified System.Posix.Process as SPP import qualified System.Posix.Process as SPP
#endif #endif
import Data.Versions ( prettyVer, Version )
@@ -88,7 +90,7 @@ runOpts =
(short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)") (short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version" (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC []) <> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC) <> (completer $ versionCompleter Nothing GHC)
@@ -96,7 +98,7 @@ runOpts =
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version" (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal []) <> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal) <> (completer $ versionCompleter Nothing Cabal)
@@ -104,7 +106,7 @@ runOpts =
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version" (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS []) <> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS) <> (completer $ versionCompleter Nothing HLS)
@@ -112,7 +114,7 @@ runOpts =
) )
<*> optional <*> optional
(option (option
(eitherReader toolVersionEither) (eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version" (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack []) <> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack) <> (completer $ versionCompleter Nothing Stack)
@@ -217,7 +219,7 @@ runRUN appState action' = do
run :: forall m. run :: forall m .
( MonadFail m ( MonadFail m
, MonadMask m , MonadMask m
, MonadCatch m , MonadCatch m
@@ -233,12 +235,16 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
r <- if not runQuick r <- if not runQuick
then runRUN runAppState $ do then runRUN runAppState $ do
toolchain <- liftE resolveToolchainFull toolchain <- liftE resolveToolchainFull
tmp <- liftIO $ createTmpDir toolchain
-- oh dear
r <- lift ask
tmp <- lift . lift . lift . flip runReaderT (fromAppState r) $ createTmpDir toolchain
liftE $ installToolChainFull toolchain tmp liftE $ installToolChainFull toolchain tmp
pure tmp pure tmp
else runLeanRUN leanAppstate $ do else runLeanRUN leanAppstate $ do
toolchain <- resolveToolchain toolchain <- resolveToolchain
tmp <- liftIO $ createTmpDir toolchain tmp <- lift $ createTmpDir toolchain
liftE $ installToolChain toolchain tmp liftE $ installToolChain toolchain tmp
pure tmp pure tmp
case r of case r of
@@ -268,17 +274,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
where where
createTmpDir :: Toolchain -> IO FilePath
createTmpDir toolchain =
case runBinDir of
Just bindir -> do
createDirRecursive' bindir
canonicalizePath bindir
Nothing -> do
d <- predictableTmpDir toolchain
createDirRecursive' d
canonicalizePath d
-- TODO: doesn't work for cross -- TODO: doesn't work for cross
resolveToolchainFull :: ( MonadFail m resolveToolchainFull :: ( MonadFail m
, MonadThrow m , MonadThrow m
@@ -296,29 +291,33 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
pure v pure v
cabalVer <- forM runCabalVer $ \ver -> do cabalVer <- forM runCabalVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Cabal (v, _) <- liftE $ fromVersion (Just ver) Cabal
pure v pure (_tvVersion v)
hlsVer <- forM runHLSVer $ \ver -> do hlsVer <- forM runHLSVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) HLS (v, _) <- liftE $ fromVersion (Just ver) HLS
pure v pure (_tvVersion v)
stackVer <- forM runStackVer $ \ver -> do stackVer <- forM runStackVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Stack (v, _) <- liftE $ fromVersion (Just ver) Stack
pure v pure (_tvVersion v)
pure Toolchain{..} pure Toolchain{..}
resolveToolchain = do resolveToolchain = do
ghcVer <- case runGHCVer of ghcVer <- case runGHCVer of
Just (ToolVersion v) -> pure $ Just v Just (GHCVersion v) -> pure $ Just v
Just (ToolVersion v) -> pure $ Just (mkTVer v)
Nothing -> pure Nothing Nothing -> pure Nothing
_ -> fail "Internal error" _ -> fail "Internal error"
cabalVer <- case runCabalVer of cabalVer <- case runCabalVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing Nothing -> pure Nothing
_ -> fail "Internal error" _ -> fail "Internal error"
hlsVer <- case runHLSVer of hlsVer <- case runHLSVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing Nothing -> pure Nothing
_ -> fail "Internal error" _ -> fail "Internal error"
stackVer <- case runStackVer of stackVer <- case runStackVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing Nothing -> pure Nothing
_ -> fail "Internal error" _ -> fail "Internal error"
@@ -353,35 +352,43 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
, MergeFileTreeError , MergeFileTreeError
] (ResourceT (ReaderT AppState m)) () ] (ResourceT (ReaderT AppState m)) ()
installToolChainFull Toolchain{..} tmp = do installToolChainFull Toolchain{..} tmp = do
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do case ghcVer of
isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt Just v -> do
case mt of isInstalled <- lift $ checkIfToolInstalled' GHC v
Just (GHC, v) -> do unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin (_tvVersion v)
(_tvVersion v) GHCupInternal
GHCupInternal False
False []
[] setGHC' v tmp
setTool GHC v tmp _ -> pure ()
Just (Cabal, v) -> do case cabalVer of
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin Just v -> do
(_tvVersion v) isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
GHCupInternal unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
False v
setTool Cabal v tmp GHCupInternal
Just (Stack, v) -> do False
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin setCabal' v tmp
(_tvVersion v) _ -> pure ()
GHCupInternal case stackVer of
False Just v -> do
setTool Stack v tmp isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
Just (HLS, v) -> do unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin v
(_tvVersion v) GHCupInternal
GHCupInternal False
False setStack' v tmp
setTool HLS v tmp _ -> pure ()
_ -> pure () case hlsVer of
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' HLS (mkTVer v)
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
v
GHCupInternal
False
setHLS' v tmp
_ -> pure ()
installToolChain :: ( MonadFail m installToolChain :: ( MonadFail m
, MonadThrow m , MonadThrow m
@@ -392,46 +399,47 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
-> FilePath -> FilePath
-> Excepts '[NotInstalled] (ReaderT LeanAppState m) () -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
installToolChain Toolchain{..} tmp = do installToolChain Toolchain{..} tmp = do
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do case ghcVer of
case mt of Just v -> setGHC' v tmp
Just (GHC, v) -> setTool GHC v tmp _ -> pure ()
Just (Cabal, v) -> setTool Cabal v tmp case cabalVer of
Just (Stack, v) -> setTool Stack v tmp Just v -> setCabal' v tmp
Just (HLS, v) -> setTool HLS v tmp _ -> pure ()
_ -> pure () case stackVer of
Just v -> setStack' v tmp
_ -> pure ()
case hlsVer of
Just v -> setHLS' v tmp
_ -> pure ()
setTool tool v tmp = setGHC' v tmp = do
case tool of
GHC -> do
void $ liftE $ setGHC v SetGHC_XYZ (Just tmp) void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
void $ liftE $ setGHC v SetGHCOnly (Just tmp) void $ liftE $ setGHC v SetGHCOnly (Just tmp)
Cabal -> do setCabal' v tmp = do
bin <- liftE $ whereIsTool Cabal v bin <- liftE $ whereIsTool Cabal (mkTVer v)
cbin <- liftIO $ canonicalizePath bin cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt)) lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
Stack -> do setStack' v tmp = do
bin <- liftE $ whereIsTool Stack v bin <- liftE $ whereIsTool Stack (mkTVer v)
cbin <- liftIO $ canonicalizePath bin cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt)) lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
HLS -> do setHLS' v tmp = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let v' = _tvVersion v legacy <- isLegacyHLS v
legacy <- isLegacyHLS v'
if legacy if legacy
then do then do
-- TODO: factor this out -- TODO: factor this out
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v')) hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? (NotInstalled HLS (mkTVer v))
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper) cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw) lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>)) hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
forM_ hlsBins $ \bin -> forM_ hlsBins $ \bin ->
lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin) lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp) liftE $ setHLS v SetHLSOnly (Just tmp)
else do else do
liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp) liftE $ setHLS v SetHLS_XYZ (Just tmp)
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp) liftE $ setHLS v SetHLSOnly (Just tmp)
GHCup -> pure ()
addToPath path = do addToPath path = do
cEnv <- Map.fromList <$> getEnvironment cEnv <- Map.fromList <$> getEnvironment
let paths = ["PATH", "Path"] let paths = ["PATH", "Path"]
@@ -443,16 +451,38 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
liftIO $ setEnv pathVar newPath liftIO $ setEnv pathVar newPath
return envWithNewPath return envWithNewPath
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = createTmpDir :: ( MonadUnliftIO m
liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none")) , MonadCatch m
, MonadThrow m
, MonadMask m
, MonadIO m
)
=> Toolchain
-> ReaderT LeanAppState m FilePath
createTmpDir toolchain =
case runBinDir of
Just bindir -> do
liftIO $ createDirRecursive' bindir
liftIO $ canonicalizePath bindir
Nothing -> do
d <- predictableTmpDir toolchain
liftIO $ createDirRecursive' d
liftIO $ canonicalizePath d
predictableTmpDir :: Monad m
=> Toolchain
-> ReaderT LeanAppState m FilePath
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = do
Dirs { tmpDir } <- getDirs
pure (fromGHCupPath tmpDir </> "ghcup-none")
predictableTmpDir Toolchain{..} = do predictableTmpDir Toolchain{..} = do
tmp <- getTemporaryDirectory Dirs { tmpDir } <- getDirs
pure $ tmp pure $ fromGHCupPath tmpDir
</> ("ghcup-" <> intercalate "_" </> ("ghcup-" <> intercalate "_"
( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer ( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . tVerToText) hlsVer <> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . prettyVer) hlsVer
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
) )
) )
@@ -466,7 +496,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
data Toolchain = Toolchain data Toolchain = Toolchain
{ ghcVer :: Maybe GHCTargetVersion { ghcVer :: Maybe GHCTargetVersion
, cabalVer :: Maybe GHCTargetVersion , cabalVer :: Maybe Version
, hlsVer :: Maybe GHCTargetVersion , hlsVer :: Maybe Version
, stackVer :: Maybe GHCTargetVersion , stackVer :: Maybe Version
} } deriving Show

View File

@@ -74,7 +74,7 @@ data SetOptions = SetOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
setParser :: Parser (Either SetCommand SetOptions) setParser :: Parser (Either SetCommand SetOptions)
setParser = setParser =
(Left <$> subparser (Left <$> subparser
@@ -82,7 +82,7 @@ setParser =
"ghc" "ghc"
( SetGHC ( SetGHC
<$> info <$> info
(setOpts (Just GHC) <**> helper) (setOpts GHC <**> helper)
( progDesc "Set GHC version" ( progDesc "Set GHC version"
<> footerDoc (Just $ text setGHCFooter) <> footerDoc (Just $ text setGHCFooter)
) )
@@ -91,7 +91,7 @@ setParser =
"cabal" "cabal"
( SetCabal ( SetCabal
<$> info <$> info
(setOpts (Just Cabal) <**> helper) (setOpts Cabal <**> helper)
( progDesc "Set Cabal version" ( progDesc "Set Cabal version"
<> footerDoc (Just $ text setCabalFooter) <> footerDoc (Just $ text setCabalFooter)
) )
@@ -100,7 +100,7 @@ setParser =
"hls" "hls"
( SetHLS ( SetHLS
<$> info <$> info
(setOpts (Just HLS) <**> helper) (setOpts HLS <**> helper)
( progDesc "Set haskell-language-server version" ( progDesc "Set haskell-language-server version"
<> footerDoc (Just $ text setHLSFooter) <> footerDoc (Just $ text setHLSFooter)
) )
@@ -109,14 +109,14 @@ setParser =
"stack" "stack"
( SetStack ( SetStack
<$> info <$> info
(setOpts (Just Stack) <**> helper) (setOpts Stack <**> helper)
( progDesc "Set stack version" ( progDesc "Set stack version"
<> footerDoc (Just $ text setStackFooter) <> footerDoc (Just $ text setStackFooter)
) )
) )
) )
) )
<|> (Right <$> setOpts Nothing) <|> (Right <$> setOpts GHC)
where where
setGHCFooter :: String setGHCFooter :: String
setGHCFooter = [s|Discussion: setGHCFooter = [s|Discussion:
@@ -137,22 +137,25 @@ setParser =
Sets the the current haskell-language-server version.|] Sets the the current haskell-language-server version.|]
setOpts :: Maybe Tool -> Parser SetOptions setOpts :: Tool -> Parser SetOptions
setOpts tool = SetOptions <$> setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$> (fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool)) optional (setVersionArgument (Just ListInstalled) tool))
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
setVersionArgument criteria tool = setVersionArgument criteria tool =
argument (eitherReader setEither) argument (eitherReader setEither)
(metavar "VERSION|TAG|next" (metavar "VERSION|TAG|next"
<> completer (tagCompleter (fromMaybe GHC tool) ["next"]) <> completer (tagCompleter tool ["next"])
<> foldMap (completer . versionCompleter criteria) tool) <> (completer . versionCompleter criteria) tool)
where where
setEither s' = setEither s' =
parseSet s' parseSet s'
<|> second SetToolTag (tagEither s') <|> second SetToolTag (tagEither s')
<|> second SetToolVersion (tVersionEither s') <|> se s'
se s' = case tool of
GHC -> second SetGHCVersion (ghcVersionEither s')
_ -> second SetToolVersion (toolVersionEither s')
parseSet s' = case fmap toLower s' of parseSet s' = case fmap toLower s' of
"next" -> Right SetNext "next" -> Right SetNext
other -> Left $ "Unknown tag/version " <> other other -> Left $ "Unknown tag/version " <> other
@@ -261,9 +264,9 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
(Right sopts) -> do (Right sopts) -> do
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.") runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts setGHC' sopts
(Left (SetGHC sopts)) -> setGHC' sopts (Left (SetGHC sopts)) -> setGHC' sopts
(Left (SetCabal sopts)) -> setCabal' sopts (Left (SetCabal sopts)) -> setCabal' sopts
(Left (SetHLS sopts)) -> setHLS' sopts (Left (SetHLS sopts)) -> setHLS' sopts
(Left (SetStack sopts)) -> setStack' sopts (Left (SetStack sopts)) -> setStack' sopts
where where
@@ -271,7 +274,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setGHC' SetOptions{ sToolVer } = setGHC' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v) (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
_ -> runSetGHC runAppState (do _ -> runSetGHC runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer GHC v <- liftE $ fst <$> fromVersion' sToolVer GHC
liftE $ setGHC v SetGHCOnly Nothing liftE $ setGHC v SetGHCOnly Nothing
@@ -291,17 +294,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setCabal' SetOptions{ sToolVer } = setCabal' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v) (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
_ -> runSetCabal runAppState (do _ -> runSetCabal runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Cabal v <- liftE $ fst <$> fromVersion' sToolVer Cabal
liftE $ setCabal (_tvVersion v) liftE $ setCabal (_tvVersion v)
pure v pure v
) )
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight v -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version" "Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
@@ -311,17 +314,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setHLS' SetOptions{ sToolVer } = setHLS' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v) (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
_ -> runSetHLS runAppState (do _ -> runSetHLS runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer HLS v <- liftE $ fst <$> fromVersion' sToolVer HLS
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
pure v pure v
) )
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight v -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"HLS " <> prettyVer _tvVersion <> " successfully set as default version" "HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
@@ -332,17 +335,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setStack' SetOptions{ sToolVer } = setStack' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v) (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
_ -> runSetStack runAppState (do _ -> runSetStack runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Stack v <- liftE $ fst <$> fromVersion' sToolVer Stack
liftE $ setStack (_tvVersion v) liftE $ setStack (_tvVersion v)
pure v pure v
) )
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight v -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"Stack " <> prettyVer _tvVersion <> " successfully set as default version" "Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e

View File

@@ -75,14 +75,14 @@ data WhereisOptions = WhereisOptions {
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
whereisP :: Parser WhereisCommand whereisP :: Parser WhereisCommand
whereisP = subparser whereisP = subparser
(commandGroup "Tools locations:" <> (commandGroup "Tools locations:" <>
command command
"ghc" "ghc"
(WhereisTool GHC <$> info (WhereisTool GHC <$> info
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper ) ( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
( progDesc "Get GHC location" ( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter )) <> footerDoc (Just $ text whereisGHCFooter ))
) )
@@ -90,7 +90,7 @@ whereisP = subparser
command command
"cabal" "cabal"
(WhereisTool Cabal <$> info (WhereisTool Cabal <$> info
( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ) ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
( progDesc "Get cabal location" ( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter )) <> footerDoc (Just $ text whereisCabalFooter ))
) )
@@ -98,7 +98,7 @@ whereisP = subparser
command command
"hls" "hls"
(WhereisTool HLS <$> info (WhereisTool HLS <$> info
( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ) ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
( progDesc "Get HLS location" ( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter )) <> footerDoc (Just $ text whereisHLSFooter ))
) )
@@ -106,7 +106,7 @@ whereisP = subparser
command command
"stack" "stack"
(WhereisTool Stack <$> info (WhereisTool Stack <$> info
( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ) ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
( progDesc "Get stack location" ( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter )) <> footerDoc (Just $ text whereisStackFooter ))
) )
@@ -268,7 +268,7 @@ whereis :: ( Monad m
whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
Dirs{ .. } <- runReaderT getDirs leanAppstate Dirs{ .. } <- runReaderT getDirs leanAppstate
case (whereisCommand, whereisOptions) of case (whereisCommand, whereisOptions) of
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) -> (WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
runLeanWhereIs leanAppstate (do runLeanWhereIs leanAppstate (do
loc <- liftE $ whereIsTool tool v loc <- liftE $ whereIsTool tool v
if directory if directory
@@ -282,6 +282,20 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30 pure $ ExitFailure 30
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
runLeanWhereIs leanAppstate (do
loc <- liftE $ whereIsTool tool (mkTVer v)
if directory
then pure $ takeDirectory loc
else pure loc
)
>>= \case
VRight r -> do
liftIO $ putStr r
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30
(WhereisTool tool whereVer, WhereisOptions{..}) -> do (WhereisTool tool whereVer, WhereisOptions{..}) -> do
runWhereIs runAppState (do runWhereIs runAppState (do

View File

@@ -238,7 +238,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
| Just False <- optVerbose -> pure () | Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283 -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
alreadyInstalling' <- alreadyInstalling optCommand newTool alreadyInstalling' <- alreadyInstalling optCommand newTool
@@ -279,7 +279,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runAppState action' = do runAppState action' = do
s' <- liftIO appState s' <- liftIO appState
runReaderT action' s' runReaderT action' s'
----------------- -----------------
-- Run command -- -- Run command --
@@ -339,16 +339,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over })) alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver (GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver })) alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver (GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion over) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
alreadyInstalling _ _ = pure False alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env cmp' :: ( HasLog env

View File

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
## Basic usage ## Basic usage
For the simple interactive TUI (not available on windows), run: For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
```sh ```sh
ghcup tui ghcup tui
@@ -186,6 +186,51 @@ url-source:
# More on installation # More on installation
## Customisation of the installation scripts
The scripts offered to install GHCup are available here:
* [bootstrap-haskell](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
for Unix-like operating systems
* [bootstrap-haskell.ps1](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
for Windows (PowerShell). This will, in turn, run the final bootstrap script
(by default, that for the Unix-like operating systems).
The effect of the scripts can be customised by setting one or more
`BOOTSTRAP_HASKELL_*` environment variables (as set out in the first script)
and, in the case of Windows, by specifying parameters (as set out in the
PowerShell script).
For example, you can toggle:
* non-interactive installation
* a more verbose installation
* whether to install only GHCup (and, on Windows, MSYS2)
* not to trigger the upgrade of GHCup
* whether to install the latest version of HLS
* whether to install the latest version of Stack
* whether to respect the XDG Base Directory Specification
* whether to adjust (prepend) the PATH in `bashrc`
* on Windows, whether to adjust MINGW paths in `cabal.config`
You can also specify:
* the GHC version to install
* the Cabal version to install
* which downloader to use (the default is `curl`)
* the base URL for the download of the GHCup binary distribution
On Windows, you can also use the parameters to:
* toggle whether to overwrite a previous installation
* specify the GHCup installation root directory
* specify the Cabal root directory
* specify the directory of an existing installation of MSYS2 (for example,
the one supplied by Stack)
* specify the URL of the final bootstrap script
* toggle whether to run the final bootstrap script via `bash` (instead of in a
new MSYS2 shell)
## Installing custom bindists ## Installing custom bindists
There are a couple of good use cases to install custom bindists: There are a couple of good use cases to install custom bindists:
@@ -301,7 +346,9 @@ Examples:
## Continuous integration ## Continuous integration
On windows, ghcup can be installed automatically on a CI runner non-interactively like so: On Windows, GHCup can be installed automatically on a CI runner
non-interactively, as below. The paramaters to the PowerShell script are
specified positionally, after `-ArgumentList`:
```ps ```ps
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\" Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
@@ -313,12 +360,10 @@ On linux/darwin/freebsd, run the following on your runner:
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
``` ```
This will just install `ghcup` and on windows additionally `msys2`. This will just install `ghcup` and on Windows additionally MSYS2.
For the full list of env variables and parameters to tweak the script behavior, see: See the installation scripts referred to above for the full list of environment
variables and, in the case of Windows, parameters to tweak the script behavior.
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
### github workflows ### github workflows
@@ -353,7 +398,7 @@ gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning. In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
You can also pass the mode via `ghcup --gpg <strict|lax|none>`. You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
# Tips and tricks # Tips and tricks
## ghcup run ## ghcup run
@@ -367,3 +412,34 @@ ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- c
``` ```
This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version. This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
# Troubleshooting
## Script immediately exits on windows
There are two possible reasons:
1. your company blocks the script (some have a whitelist)... ask your administrator
2. your Antivirus or Windows Defender interfere with the installation. Disable them temporarily.
## C compiler cannot create executables
### Darwin
You need to update your XCode command line tools, e.g. [like this](https://stackoverflow.com/questions/34617452/how-to-update-xcode-from-command-line).
## Certificate authority errors (curl)
If your certificates are outdated or improperly configured, curl may be unable
to download ghcup.
There are two known workarounds:
1. Tell curl to ignore certificate errors (dangerous): `curl -k https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | GHCUP_CURL_OPTS="-k" sh`
2. Try to use wget instead: `wget -O /dev/stdout https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | BOOTSTRAP_HASKELL_DOWNLOADER=wget sh`
On windows, you can disable curl like so:
```pwsh
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true,$false,$false,$false,$false,$false,$false,"","","","",$true
```

View File

@@ -57,7 +57,7 @@ hide:
</section> </section>
<p id="help" class="ghcup-help"> <p id="help" class="ghcup-help">
Need help? Ask on Need help? Check the <a href="guide/#troubleshooting">Troubleshooting section</a> or ask on
<span> <span>
<a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"> <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup">
<img src="irc.svg" alt="" /> <img src="irc.svg" alt="" />

View File

@@ -69,6 +69,7 @@ library
GHCup.Prelude.Process GHCup.Prelude.Process
GHCup.Prelude.String.QQ GHCup.Prelude.String.QQ
GHCup.Prelude.Version.QQ GHCup.Prelude.Version.QQ
GHCup.Prompts
GHCup.Requirements GHCup.Requirements
GHCup.Stack GHCup.Stack
GHCup.Types GHCup.Types

View File

@@ -137,7 +137,7 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
instance Pretty AlreadyInstalled where instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') = pPrint (AlreadyInstalled tool ver') =
pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed;" (pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;"
<+> text "if you really want to reinstall it, you may want to run 'ghcup install cabal --force" <+> (pPrint ver' <> text "'") <+> text "if you really want to reinstall it, you may want to run 'ghcup install cabal --force" <+> (pPrint ver' <> text "'")

View File

@@ -301,8 +301,9 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
| otherwise = do | otherwise = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
let alpineArgs let ldOverride
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform | ver >= [vver|8.2.2|]
, _rPlatform `elem` [Linux Alpine, Darwin]
= ["--disable-ld-override"] = ["--disable-ld-override"]
| otherwise | otherwise
= [] = []
@@ -310,7 +311,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh" lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst) ("./configure" : ("--prefix=" <> fromInstallDir inst)
: (alpineArgs <> (T.unpack <$> addConfArgs)) : (ldOverride <> (T.unpack <$> addConfArgs))
) )
(Just $ fromGHCupPath path) (Just $ fromGHCupPath path)
"ghc-configure" "ghc-configure"

28
lib/GHCup/Prompts.hs Normal file
View File

@@ -0,0 +1,28 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module GHCup.Prompts
( PromptQuestion,
PromptResponse (..),
getUserPromptResponse,
)
where
import Control.Monad.Reader
import qualified Data.Text.IO as TIO
import GHCup.Prelude.Logger
import GHCup.Types.Optics
import GHCup.Types (PromptQuestion, PromptResponse(..))
getUserPromptResponse :: ( HasLog env
, MonadReader env m
, MonadIO m)
=> PromptQuestion
-> m PromptResponse
getUserPromptResponse prompt = do
logInfo prompt
resp <- liftIO TIO.getLine
if resp `elem` ["YES", "yes", "y", "Y"]
then pure PromptYes
else pure PromptNo

View File

@@ -407,6 +407,9 @@ data AppState = AppState
instance NFData AppState instance NFData AppState
fromAppState :: AppState -> LeanAppState
fromAppState AppState {..} = LeanAppState {..}
data LeanAppState = LeanAppState data LeanAppState = LeanAppState
{ settings :: Settings { settings :: Settings
, dirs :: Dirs , dirs :: Dirs
@@ -654,3 +657,7 @@ isSafeDir (IsolateDirResolved _) = False
isSafeDir (GHCupDir _) = True isSafeDir (GHCupDir _) = True
isSafeDir (GHCupBinDir _) = False isSafeDir (GHCupBinDir _) = False
type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq)

View File

@@ -16,6 +16,7 @@
# * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls # * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
# * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend) # * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend)
# * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows # * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
# * BOOTSTRAP_HASKELL_DOWNLOADER - which downloader to use (default: curl)
# * GHCUP_BASE_URL - the base url for ghcup binary download (use this to overwrite https://downloads.haskell.org/~ghcup with a mirror) # * GHCUP_BASE_URL - the base url for ghcup binary download (use this to overwrite https://downloads.haskell.org/~ghcup with a mirror)
# License: LGPL-3.0 # License: LGPL-3.0
@@ -30,6 +31,7 @@ ghver="0.1.17.8"
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes
: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)
@@ -138,8 +140,12 @@ ecabal() {
} }
_ecabal() { _ecabal() {
# shellcheck disable=SC2086 if [ -n "${CABAL_BIN}" ] ; then
"${GHCUP_BIN}/cabal" "$@" "${CABAL_BIN}" "$@"
else
# shellcheck disable=SC2086
"${GHCUP_BIN}/cabal" "$@"
fi
} }
_done() { _done() {
@@ -322,11 +328,35 @@ download_ghcup() {
esac esac
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)
edo curl -Lf "${_url}" > "${GHCUP_BIN}"/ghcup.exe case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
"curl")
# shellcheck disable=SC2086
edo curl -Lf ${GHCUP_CURL_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup.exe
;;
"wget")
# shellcheck disable=SC2086
edo wget -O /dev/stdout ${GHCUP_WGET_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup.exe
;;
*)
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
;;
esac
edo chmod +x "${GHCUP_BIN}"/ghcup.exe edo chmod +x "${GHCUP_BIN}"/ghcup.exe
;; ;;
*) *)
edo curl -Lf "${_url}" > "${GHCUP_BIN}"/ghcup case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
"curl")
# shellcheck disable=SC2086
edo curl -Lf ${GHCUP_CURL_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup
;;
"wget")
# shellcheck disable=SC2086
edo wget -O /dev/stdout ${GHCUP_WGET_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup
;;
*)
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
;;
esac
edo chmod +x "${GHCUP_BIN}"/ghcup edo chmod +x "${GHCUP_BIN}"/ghcup
;; ;;
esac esac
@@ -353,6 +383,17 @@ download_ghcup() {
# shellcheck disable=SC1090 # shellcheck disable=SC1090
edo . "${GHCUP_DIR}"/env edo . "${GHCUP_DIR}"/env
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
"curl")
eghcup config set downloader Curl
;;
"wget")
eghcup config set downloader Wget
;;
*)
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
;;
esac
eghcup upgrade eghcup upgrade
} }
@@ -780,7 +821,7 @@ else # don't install ghc and cabal
# we'll remove it afterwards # we'll remove it afterwards
tmp_dir="$(mktemp -d)" tmp_dir="$(mktemp -d)"
eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}" eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer CABAL_BIN="${tmp_dir}/cabal" do_cabal_config_init $ask_cabal_config_init_answer
rm "${tmp_dir}/cabal" rm "${tmp_dir}/cabal"
unset tmp_dir unset tmp_dir
;; ;;

View File

@@ -36,7 +36,9 @@ param (
# Instead of installing a new MSys2, use an existing installation # Instead of installing a new MSys2, use an existing installation
[string]$ExistingMsys2Dir, [string]$ExistingMsys2Dir,
# Specify the cabal root directory (default: '$InstallDir\cabal') # Specify the cabal root directory (default: '$InstallDir\cabal')
[string]$CabalDir [string]$CabalDir,
# Whether to disable use of curl.exe
[switch]$DisableCurl
) )
$Silent = !$Interactive $Silent = !$Interactive
@@ -425,7 +427,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
$archive = 'msys2-x86_64-latest.sfx.exe' $archive = 'msys2-x86_64-latest.sfx.exe'
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive") $archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) { if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive") Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
} else { } else {
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
@@ -591,10 +593,17 @@ if ($Minimal) {
$MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;' $MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
} }
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) { if ($DisableCurl) {
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport) $BootstrapDownloader = 'export BOOTSTRAP_HASKELL_DOWNLOADER=wget ;'
$DownloadScript = 'wget -O /dev/stdout'
} else { } else {
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport) $DownloadScript = 'curl --proto ''=https'' --tlsv1.2 -sSf'
}
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
} else {
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
} }