Compare commits
37 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
3b6bb0df46
|
|||
|
60299b6bb8
|
|||
|
4d20f4e07c
|
|||
|
5f6b5f845d
|
|||
|
b0fecce0d1
|
|||
|
|
27c06ddde7 | ||
|
3154d2839b
|
|||
|
|
511d8d5ed8 | ||
|
fe22405ee1
|
|||
|
ea828cd13a
|
|||
|
00fa70b9de
|
|||
|
823275363c
|
|||
|
2f299ee48d
|
|||
|
284fe1b3b6
|
|||
|
35bda8d67a
|
|||
|
7a2a5074fa
|
|||
|
ce239ab88e
|
|||
|
f3c703d655
|
|||
|
b6ff5bc764
|
|||
|
b8aeb1f935
|
|||
|
9673d28d3e
|
|||
|
99a51d67a1
|
|||
|
b0ef0590a2
|
|||
|
|
ca5c5550ab | ||
|
|
3d49f79beb | ||
|
|
e9740d13fc | ||
|
|
2bd5a8fe1a | ||
|
|
0acccae523 | ||
|
974112016e
|
|||
|
9fb2889696
|
|||
|
63f22b28d7
|
|||
|
|
9ceb66ef21 | ||
|
|
7cbe38b011 | ||
|
|
3bbc1edb19 | ||
|
|
b8dac2d7cd | ||
|
|
0e1fd68d93 | ||
|
|
c7eceb2330 |
27
CHANGELOG.md
27
CHANGELOG.md
@@ -1,5 +1,32 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.18.0 -- 2022-07-30
|
||||
|
||||
* Fix tui set wrt [#266](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/266) by Arjun Kathuria
|
||||
- Ask the user to install the tool via prompt when setting an non-installed version
|
||||
* improvements to safe (un-)installations
|
||||
- bindists that don't support `make DESTDIR=/some/tmp/dir install` are now unsupported
|
||||
- installed GHC files are now recorded to avoid use of `removePathForcibly`
|
||||
- internally uses a newtype wrapper for user-input paths and restrict destructive operations to validated paths
|
||||
* use of `TMPDIR` is dropped... now uses an internal tmp dir `~/.ghcup/tmp`
|
||||
* improvements to error handling and warnings
|
||||
* Require --isolate to have an absolute directory, fixes #367
|
||||
* Fix mingw PATH handling wrt #371
|
||||
* Add --mingw-path switch to `ghcup run`
|
||||
* Fix `ghcup run` on windows, fixes #375
|
||||
* Allow passing bindist configure args wrt #377
|
||||
* Improve `ghcup compile hls`
|
||||
- short hashes now work
|
||||
- print the long hash in addition to the detected cabal version of HLS
|
||||
- add `--git-describe-version` switch as an alternative to `--overwrite-version`
|
||||
- Allow to build HLS from hackage (now is the default)
|
||||
- Allow to run 'cabal update' automatically before the HLS build
|
||||
- Fix parser and completer for 'ghcup compile hls --version'
|
||||
* Improve `ghcup compile ghc`
|
||||
- short hashes now work
|
||||
- print the long hash in addition to the detected cabal version of HLS
|
||||
- Allow to build from arbitrary GHC source dists
|
||||
|
||||
## 0.1.17.10 -- 2022-05-12
|
||||
|
||||
* windows hotfix (hackage-only release)
|
||||
|
||||
@@ -17,6 +17,7 @@ import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
@@ -52,6 +53,8 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString
|
||||
|
||||
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 Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
@@ -98,7 +101,7 @@ keyHandlers KeyBindings {..} =
|
||||
[ (bQuit, const "Quit" , halt)
|
||||
, (bInstall, const "Install" , withIOAction install')
|
||||
, (bUninstall, const "Uninstall", withIOAction del')
|
||||
, (bSet, const "Set" , withIOAction ((liftIO .) . set'))
|
||||
, (bSet, const "Set" , withIOAction set')
|
||||
, (bChangelog, const "ChangeLog", withIOAction changelog')
|
||||
, ( bShowAllVersions
|
||||
, \BrickSettings {..} ->
|
||||
@@ -486,9 +489,12 @@ install' _ (_, ListResult {..}) = do
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
|
||||
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
||||
set' _ (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
set' bs input@(_, ListResult {..}) = do
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
let run =
|
||||
flip runReaderT settings
|
||||
@@ -504,7 +510,28 @@ set' _ (_, ListResult {..}) = do
|
||||
)
|
||||
>>= \case
|
||||
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)
|
||||
|
||||
@@ -58,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
changelogP :: Parser ChangeLogOptions
|
||||
changelogP =
|
||||
(\x y -> ChangeLogOptions x y)
|
||||
@@ -71,15 +71,16 @@ changelogP =
|
||||
"cabal" -> Right Cabal
|
||||
"ghcup" -> Right GHCup
|
||||
"stack" -> Right Stack
|
||||
"hls" -> Right HLS
|
||||
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)"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional (toolVersionArgument Nothing Nothing)
|
||||
<*> optional (toolVersionTagArgument Nothing Nothing)
|
||||
|
||||
|
||||
|
||||
@@ -116,7 +117,8 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||
ver' = maybe
|
||||
(Right Latest)
|
||||
(\case
|
||||
ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
|
||||
GHCVersion tv -> Left (_tvVersion tv)
|
||||
ToolVersion tv -> Left tv
|
||||
ToolTag t -> Right t
|
||||
)
|
||||
clToolVer
|
||||
|
||||
@@ -70,20 +70,24 @@ import Control.Exception (evaluate)
|
||||
--[ Types ]--
|
||||
-------------
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
data ToolVersion = GHCVersion GHCTargetVersion
|
||||
| ToolVersion Version
|
||||
| ToolTag Tag
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetToolVersion GHCTargetVersion
|
||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||
| SetToolVersion Version
|
||||
| SetToolTag Tag
|
||||
| SetRecommended
|
||||
| SetNext
|
||||
|
||||
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
|
||||
|
||||
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
||||
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
||||
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
||||
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
||||
toSetToolVer Nothing = SetRecommended
|
||||
@@ -96,10 +100,9 @@ toSetToolVer Nothing = SetRecommended
|
||||
--------------
|
||||
|
||||
|
||||
-- | same as toolVersionParser, except as an argument.
|
||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument criteria tool =
|
||||
argument (eitherReader toolVersionEither)
|
||||
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionTagArgument criteria tool =
|
||||
argument (eitherReader (parser tool))
|
||||
(metavar (mv tool)
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
@@ -108,20 +111,19 @@ toolVersionArgument criteria tool =
|
||||
mv (Just HLS) = "HLS_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' criteria tool = argument
|
||||
(eitherReader (first show . version . T.pack))
|
||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
|
||||
-- https://github.com/pcapriotti/optparse-applicative/issues/148
|
||||
@@ -230,9 +232,15 @@ isolateParser f = case isValid f && isAbsolute f of
|
||||
True -> Right $ normalise f
|
||||
False -> Left "Please enter a valid filepath for isolate dir."
|
||||
|
||||
toolVersionEither :: String -> Either String ToolVersion
|
||||
toolVersionEither s' =
|
||||
second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
|
||||
-- this accepts cross prefix
|
||||
ghcVersionTagEither :: String -> Either String ToolVersion
|
||||
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 s' = case fmap toLower s' of
|
||||
@@ -244,10 +252,14 @@ tagEither s' = case fmap toLower s' of
|
||||
other -> Left $ "Unknown tag " <> other
|
||||
|
||||
|
||||
tVersionEither :: String -> Either String GHCTargetVersion
|
||||
tVersionEither =
|
||||
ghcVersionEither :: String -> Either String GHCTargetVersion
|
||||
ghcVersionEither =
|
||||
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 s' | t == T.pack "ghc" = Right GHC
|
||||
@@ -440,9 +452,11 @@ tagCompleter tool add = listIOCompleter $ do
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
||||
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool = listIOCompleter $ do
|
||||
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
|
||||
|
||||
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
|
||||
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
@@ -471,7 +485,7 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
runEnv = flip runReaderT appState
|
||||
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
||||
|
||||
|
||||
toolDlCompleter :: Tool -> Completer
|
||||
@@ -663,7 +677,7 @@ fromVersion' SetRecommended tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getRecommended dls tool
|
||||
?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
fromVersion' (SetGHCVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
@@ -675,6 +689,18 @@ fromVersion' (SetToolVersion v) tool = do
|
||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion (_tvTarget v) v', Just 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
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
|
||||
@@ -12,6 +12,8 @@ module GHCup.OptParse.Compile where
|
||||
|
||||
|
||||
import GHCup
|
||||
import qualified GHCup.GHC as GHC
|
||||
import qualified GHCup.HLS as HLS
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
@@ -30,7 +32,8 @@ import Control.Monad.Trans.Resource
|
||||
import Data.Bifunctor
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions ( Version, prettyVer, version )
|
||||
import Data.Versions ( Version, prettyVer, version, pvp )
|
||||
import qualified Data.Versions as V
|
||||
import Data.Text ( Text )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
@@ -41,7 +44,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import Control.Exception.Safe (MonadMask, displayException)
|
||||
import System.FilePath (isPathSeparator)
|
||||
import Text.Read (readEither)
|
||||
|
||||
@@ -64,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
|
||||
|
||||
|
||||
data GHCCompileOptions = GHCCompileOptions
|
||||
{ targetGhc :: Either Version GitBranch
|
||||
{ targetGhc :: GHC.GHCVer Version
|
||||
, bootstrapGhc :: Either Version FilePath
|
||||
, jobs :: Maybe Int
|
||||
, buildConfig :: Maybe FilePath
|
||||
@@ -78,10 +81,12 @@ data GHCCompileOptions = GHCCompileOptions
|
||||
, isolateDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
|
||||
data HLSCompileOptions = HLSCompileOptions
|
||||
{ targetHLS :: Either Version GitBranch
|
||||
{ targetHLS :: HLS.HLSVer
|
||||
, jobs :: Maybe Int
|
||||
, setCompile :: Bool
|
||||
, updateCabal :: Bool
|
||||
, ovewrwiteVer :: Either Bool Version
|
||||
, isolateDir :: Maybe FilePath
|
||||
, cabalProject :: Maybe (Either FilePath URI)
|
||||
@@ -149,10 +154,10 @@ Examples:
|
||||
These need to be available in PATH prior to compilation.
|
||||
|
||||
Examples:
|
||||
# compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
|
||||
ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
|
||||
# compile from master for ghc 9.2.3 and use 'git describe' to name the binary
|
||||
ghcup compile hls -g master --git-describe-version --ghc 9.2.3
|
||||
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
||||
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
||||
# compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
|
||||
ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
|
||||
# compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
|
||||
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
|
||||
|
||||
@@ -160,7 +165,7 @@ Examples:
|
||||
ghcCompileOpts :: Parser GHCCompileOptions
|
||||
ghcCompileOpts =
|
||||
GHCCompileOptions
|
||||
<$> ((Left <$> option
|
||||
<$> ((GHC.SourceDist <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
@@ -169,7 +174,7 @@ ghcCompileOpts =
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
(GHC.GitDist <$> (GitBranch <$> option
|
||||
str
|
||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||
"The git commit/branch/ref to build from"
|
||||
@@ -178,7 +183,18 @@ ghcCompileOpts =
|
||||
short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
|
||||
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
|
||||
))
|
||||
)))
|
||||
))
|
||||
<|>
|
||||
(
|
||||
GHC.RemoteDist <$> (option
|
||||
(eitherReader uriParser)
|
||||
(long "remote-source-dist" <> metavar "URI" <> help
|
||||
"URI (https/http/file) to a GHC source distribution"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> option
|
||||
(eitherReader
|
||||
(\x ->
|
||||
@@ -270,16 +286,17 @@ ghcCompileOpts =
|
||||
hlsCompileOpts :: Parser HLSCompileOptions
|
||||
hlsCompileOpts =
|
||||
HLSCompileOptions
|
||||
<$> ((Left <$> option
|
||||
<$> ((HLS.HackageDist <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
"The version to compile (pulled from hackage)"
|
||||
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
)
|
||||
<|>
|
||||
(HLS.GitDist <$> (GitBranch <$> option
|
||||
str
|
||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
|
||||
@@ -287,7 +304,28 @@ hlsCompileOpts =
|
||||
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
|
||||
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
|
||||
))
|
||||
)))
|
||||
))
|
||||
<|>
|
||||
(HLS.SourceDist <$> (option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(long "source-dist" <> metavar "VERSION" <> help
|
||||
"The version to compile (pulled from packaged git sources)"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
))
|
||||
<|>
|
||||
(
|
||||
HLS.RemoteDist <$> (option
|
||||
(eitherReader uriParser)
|
||||
(long "remote-source-dist" <> metavar "URI" <> help
|
||||
"URI (https/http/file) to a HLS source distribution"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader (readEither @Int))
|
||||
@@ -297,6 +335,7 @@ hlsCompileOpts =
|
||||
)
|
||||
)
|
||||
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
|
||||
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
||||
<*>
|
||||
(
|
||||
(Right <$> option
|
||||
@@ -362,7 +401,7 @@ hlsCompileOpts =
|
||||
)
|
||||
)
|
||||
<*> 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)"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> completer (versionCompleter Nothing GHC))
|
||||
@@ -468,7 +507,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
(CompileHLS HLSCompileOptions { .. }) -> do
|
||||
runCompileHLS runAppState (do
|
||||
case targetHLS of
|
||||
Left targetVer -> do
|
||||
HLS.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
@@ -476,7 +515,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
_ -> pure ()
|
||||
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
|
||||
targetVer <- liftE $ compileHLS
|
||||
targetHLS
|
||||
@@ -486,6 +525,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
updateCabal
|
||||
patches
|
||||
cabalArgs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
@@ -519,7 +559,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
(CompileGHC GHCCompileOptions {..}) ->
|
||||
runCompileGHC runAppState (do
|
||||
case targetGhc of
|
||||
Left targetVer -> do
|
||||
GHC.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
@@ -527,9 +567,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
_ -> pure ()
|
||||
targetVer <- liftE $ compileGHC
|
||||
(first (GHCTargetVersion crossTarget) targetGhc)
|
||||
((\case
|
||||
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
|
||||
GHC.GitDist g -> GHC.GitDist g
|
||||
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
|
||||
ovewrwiteVer
|
||||
bootstrapGhc
|
||||
jobs
|
||||
|
||||
@@ -196,7 +196,7 @@ installOpts tool =
|
||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionArgument Nothing tool)
|
||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
||||
)
|
||||
<|> pure (Nothing, Nothing)
|
||||
)
|
||||
|
||||
@@ -74,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
prefetchP :: Parser PrefetchCommand
|
||||
prefetchP = subparser
|
||||
( command
|
||||
"ghc"
|
||||
(info
|
||||
(info
|
||||
(PrefetchGHC
|
||||
<$> (PrefetchGHCOptions
|
||||
<$> ( 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 (toolVersionArgument Nothing (Just GHC)) )
|
||||
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
|
||||
( progDesc "Download GHC assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"cabal"
|
||||
(info
|
||||
(info
|
||||
(PrefetchCabal
|
||||
<$> 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")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"hls"
|
||||
(info
|
||||
(info
|
||||
(PrefetchHLS
|
||||
<$> 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")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"stack"
|
||||
(info
|
||||
(info
|
||||
(PrefetchStack
|
||||
<$> 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")
|
||||
)
|
||||
<>
|
||||
|
||||
@@ -71,7 +71,7 @@ data RmOptions = RmOptions
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
rmParser :: Parser (Either RmCommand RmOptions)
|
||||
rmParser =
|
||||
(Left <$> subparser
|
||||
@@ -103,7 +103,7 @@ rmParser =
|
||||
|
||||
|
||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
|
||||
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -5,6 +5,7 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module GHCup.OptParse.Run where
|
||||
|
||||
|
||||
@@ -46,6 +47,7 @@ import qualified Data.Text as T
|
||||
#ifndef IS_WINDOWS
|
||||
import qualified System.Posix.Process as SPP
|
||||
#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)")
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(eitherReader ghcVersionTagEither)
|
||||
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
@@ -96,7 +98,7 @@ runOpts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||
<> completer (tagCompleter Cabal [])
|
||||
<> (completer $ versionCompleter Nothing Cabal)
|
||||
@@ -104,7 +106,7 @@ runOpts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||
<> completer (tagCompleter HLS [])
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
@@ -112,7 +114,7 @@ runOpts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||
<> completer (tagCompleter Stack [])
|
||||
<> (completer $ versionCompleter Nothing Stack)
|
||||
@@ -217,7 +219,7 @@ runRUN appState action' = do
|
||||
|
||||
|
||||
|
||||
run :: forall m.
|
||||
run :: forall m .
|
||||
( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
@@ -233,12 +235,16 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
r <- if not runQuick
|
||||
then runRUN runAppState $ do
|
||||
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
|
||||
pure tmp
|
||||
else runLeanRUN leanAppstate $ do
|
||||
toolchain <- resolveToolchain
|
||||
tmp <- liftIO $ createTmpDir toolchain
|
||||
tmp <- lift $ createTmpDir toolchain
|
||||
liftE $ installToolChain toolchain tmp
|
||||
pure tmp
|
||||
case r of
|
||||
@@ -268,17 +274,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
|
||||
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
|
||||
resolveToolchainFull :: ( MonadFail m
|
||||
, MonadThrow m
|
||||
@@ -296,29 +291,33 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
pure v
|
||||
cabalVer <- forM runCabalVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Cabal
|
||||
pure v
|
||||
pure (_tvVersion v)
|
||||
hlsVer <- forM runHLSVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) HLS
|
||||
pure v
|
||||
pure (_tvVersion v)
|
||||
stackVer <- forM runStackVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Stack
|
||||
pure v
|
||||
pure (_tvVersion v)
|
||||
pure Toolchain{..}
|
||||
|
||||
resolveToolchain = do
|
||||
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
|
||||
_ -> fail "Internal error"
|
||||
cabalVer <- case runCabalVer of
|
||||
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
hlsVer <- case runHLSVer of
|
||||
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
stackVer <- case runStackVer of
|
||||
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
@@ -353,35 +352,43 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
, MergeFileTreeError
|
||||
] (ResourceT (ReaderT AppState m)) ()
|
||||
installToolChainFull Toolchain{..} tmp = do
|
||||
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
|
||||
isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
|
||||
case mt of
|
||||
Just (GHC, v) -> do
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
GHCupInternal
|
||||
False
|
||||
[]
|
||||
setTool GHC v tmp
|
||||
Just (Cabal, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
|
||||
(_tvVersion v)
|
||||
GHCupInternal
|
||||
False
|
||||
setTool Cabal v tmp
|
||||
Just (Stack, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
|
||||
(_tvVersion v)
|
||||
GHCupInternal
|
||||
False
|
||||
setTool Stack v tmp
|
||||
Just (HLS, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
|
||||
(_tvVersion v)
|
||||
GHCupInternal
|
||||
False
|
||||
setTool HLS v tmp
|
||||
_ -> pure ()
|
||||
case ghcVer of
|
||||
Just v -> do
|
||||
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
GHCupInternal
|
||||
False
|
||||
[]
|
||||
setGHC' v tmp
|
||||
_ -> pure ()
|
||||
case cabalVer of
|
||||
Just v -> do
|
||||
isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
|
||||
v
|
||||
GHCupInternal
|
||||
False
|
||||
setCabal' v tmp
|
||||
_ -> pure ()
|
||||
case stackVer of
|
||||
Just v -> do
|
||||
isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
|
||||
v
|
||||
GHCupInternal
|
||||
False
|
||||
setStack' v tmp
|
||||
_ -> 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
|
||||
, MonadThrow m
|
||||
@@ -392,46 +399,47 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
-> FilePath
|
||||
-> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
|
||||
installToolChain Toolchain{..} tmp = do
|
||||
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
|
||||
case mt of
|
||||
Just (GHC, v) -> setTool GHC v tmp
|
||||
Just (Cabal, v) -> setTool Cabal v tmp
|
||||
Just (Stack, v) -> setTool Stack v tmp
|
||||
Just (HLS, v) -> setTool HLS v tmp
|
||||
_ -> pure ()
|
||||
case ghcVer of
|
||||
Just v -> setGHC' v tmp
|
||||
_ -> pure ()
|
||||
case cabalVer of
|
||||
Just v -> setCabal' v tmp
|
||||
_ -> pure ()
|
||||
case stackVer of
|
||||
Just v -> setStack' v tmp
|
||||
_ -> pure ()
|
||||
case hlsVer of
|
||||
Just v -> setHLS' v tmp
|
||||
_ -> pure ()
|
||||
|
||||
setTool tool v tmp =
|
||||
case tool of
|
||||
GHC -> do
|
||||
setGHC' v tmp = do
|
||||
void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
|
||||
void $ liftE $ setGHC v SetGHCOnly (Just tmp)
|
||||
Cabal -> do
|
||||
bin <- liftE $ whereIsTool Cabal v
|
||||
setCabal' v tmp = do
|
||||
bin <- liftE $ whereIsTool Cabal (mkTVer v)
|
||||
cbin <- liftIO $ canonicalizePath bin
|
||||
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
|
||||
Stack -> do
|
||||
bin <- liftE $ whereIsTool Stack v
|
||||
setStack' v tmp = do
|
||||
bin <- liftE $ whereIsTool Stack (mkTVer v)
|
||||
cbin <- liftIO $ canonicalizePath bin
|
||||
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
|
||||
HLS -> do
|
||||
setHLS' v tmp = do
|
||||
Dirs {..} <- getDirs
|
||||
let v' = _tvVersion v
|
||||
legacy <- isLegacyHLS v'
|
||||
legacy <- isLegacyHLS v
|
||||
if legacy
|
||||
then do
|
||||
-- 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)
|
||||
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 ->
|
||||
lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
|
||||
liftE $ setHLS v SetHLSOnly (Just tmp)
|
||||
else do
|
||||
liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
|
||||
GHCup -> pure ()
|
||||
|
||||
liftE $ setHLS v SetHLS_XYZ (Just tmp)
|
||||
liftE $ setHLS v SetHLSOnly (Just tmp)
|
||||
|
||||
addToPath path = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
@@ -443,16 +451,38 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
|
||||
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
|
||||
liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
|
||||
createTmpDir :: ( MonadUnliftIO m
|
||||
, 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
|
||||
tmp <- getTemporaryDirectory
|
||||
pure $ tmp
|
||||
Dirs { tmpDir } <- getDirs
|
||||
pure $ fromGHCupPath tmpDir
|
||||
</> ("ghcup-" <> intercalate "_"
|
||||
( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer
|
||||
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
|
||||
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . tVerToText) hlsVer
|
||||
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
|
||||
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
|
||||
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . prettyVer) hlsVer
|
||||
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
|
||||
)
|
||||
)
|
||||
|
||||
@@ -466,7 +496,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
|
||||
data Toolchain = Toolchain
|
||||
{ ghcVer :: Maybe GHCTargetVersion
|
||||
, cabalVer :: Maybe GHCTargetVersion
|
||||
, hlsVer :: Maybe GHCTargetVersion
|
||||
, stackVer :: Maybe GHCTargetVersion
|
||||
}
|
||||
, cabalVer :: Maybe Version
|
||||
, hlsVer :: Maybe Version
|
||||
, stackVer :: Maybe Version
|
||||
} deriving Show
|
||||
|
||||
@@ -74,7 +74,7 @@ data SetOptions = SetOptions
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
setParser :: Parser (Either SetCommand SetOptions)
|
||||
setParser =
|
||||
(Left <$> subparser
|
||||
@@ -82,7 +82,7 @@ setParser =
|
||||
"ghc"
|
||||
( SetGHC
|
||||
<$> info
|
||||
(setOpts (Just GHC) <**> helper)
|
||||
(setOpts GHC <**> helper)
|
||||
( progDesc "Set GHC version"
|
||||
<> footerDoc (Just $ text setGHCFooter)
|
||||
)
|
||||
@@ -91,7 +91,7 @@ setParser =
|
||||
"cabal"
|
||||
( SetCabal
|
||||
<$> info
|
||||
(setOpts (Just Cabal) <**> helper)
|
||||
(setOpts Cabal <**> helper)
|
||||
( progDesc "Set Cabal version"
|
||||
<> footerDoc (Just $ text setCabalFooter)
|
||||
)
|
||||
@@ -100,7 +100,7 @@ setParser =
|
||||
"hls"
|
||||
( SetHLS
|
||||
<$> info
|
||||
(setOpts (Just HLS) <**> helper)
|
||||
(setOpts HLS <**> helper)
|
||||
( progDesc "Set haskell-language-server version"
|
||||
<> footerDoc (Just $ text setHLSFooter)
|
||||
)
|
||||
@@ -109,14 +109,14 @@ setParser =
|
||||
"stack"
|
||||
( SetStack
|
||||
<$> info
|
||||
(setOpts (Just Stack) <**> helper)
|
||||
(setOpts Stack <**> helper)
|
||||
( progDesc "Set stack version"
|
||||
<> footerDoc (Just $ text setStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> setOpts Nothing)
|
||||
<|> (Right <$> setOpts GHC)
|
||||
where
|
||||
setGHCFooter :: String
|
||||
setGHCFooter = [s|Discussion:
|
||||
@@ -137,22 +137,25 @@ setParser =
|
||||
Sets the the current haskell-language-server version.|]
|
||||
|
||||
|
||||
setOpts :: Maybe Tool -> Parser SetOptions
|
||||
setOpts :: Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$>
|
||||
(fromMaybe SetRecommended <$>
|
||||
optional (setVersionArgument (Just ListInstalled) tool))
|
||||
|
||||
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
|
||||
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
|
||||
setVersionArgument criteria tool =
|
||||
argument (eitherReader setEither)
|
||||
(metavar "VERSION|TAG|next"
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) ["next"])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
<> completer (tagCompleter tool ["next"])
|
||||
<> (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
setEither s' =
|
||||
parseSet 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
|
||||
"next" -> Right SetNext
|
||||
other -> Left $ "Unknown tag/version " <> other
|
||||
@@ -261,9 +264,9 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
(Right sopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||
setGHC' sopts
|
||||
(Left (SetGHC sopts)) -> setGHC' sopts
|
||||
(Left (SetGHC sopts)) -> setGHC' sopts
|
||||
(Left (SetCabal sopts)) -> setCabal' sopts
|
||||
(Left (SetHLS sopts)) -> setHLS' sopts
|
||||
(Left (SetHLS sopts)) -> setHLS' sopts
|
||||
(Left (SetStack sopts)) -> setStack' sopts
|
||||
|
||||
where
|
||||
@@ -271,7 +274,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setGHC' SetOptions{ sToolVer } =
|
||||
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
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly Nothing
|
||||
@@ -291,17 +294,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setCabal' SetOptions{ sToolVer } =
|
||||
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
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
VRight v -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
"Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
@@ -311,17 +314,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setHLS' SetOptions{ sToolVer } =
|
||||
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
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
VRight v -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
"HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
@@ -332,17 +335,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setStack' SetOptions{ sToolVer } =
|
||||
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
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||
liftE $ setStack (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
VRight v -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
"Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
|
||||
@@ -75,14 +75,14 @@ data WhereisOptions = WhereisOptions {
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
whereisP :: Parser WhereisCommand
|
||||
whereisP = subparser
|
||||
(commandGroup "Tools locations:" <>
|
||||
(commandGroup "Tools locations:" <>
|
||||
command
|
||||
"ghc"
|
||||
(WhereisTool GHC <$> info
|
||||
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
||||
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
|
||||
( progDesc "Get GHC location"
|
||||
<> footerDoc (Just $ text whereisGHCFooter ))
|
||||
)
|
||||
@@ -90,7 +90,7 @@ whereisP = subparser
|
||||
command
|
||||
"cabal"
|
||||
(WhereisTool Cabal <$> info
|
||||
( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
|
||||
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
|
||||
( progDesc "Get cabal location"
|
||||
<> footerDoc (Just $ text whereisCabalFooter ))
|
||||
)
|
||||
@@ -98,7 +98,7 @@ whereisP = subparser
|
||||
command
|
||||
"hls"
|
||||
(WhereisTool HLS <$> info
|
||||
( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
|
||||
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
|
||||
( progDesc "Get HLS location"
|
||||
<> footerDoc (Just $ text whereisHLSFooter ))
|
||||
)
|
||||
@@ -106,7 +106,7 @@ whereisP = subparser
|
||||
command
|
||||
"stack"
|
||||
(WhereisTool Stack <$> info
|
||||
( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
|
||||
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
|
||||
( progDesc "Get stack location"
|
||||
<> footerDoc (Just $ text whereisStackFooter ))
|
||||
)
|
||||
@@ -268,7 +268,7 @@ whereis :: ( Monad m
|
||||
whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
Dirs{ .. } <- runReaderT getDirs leanAppstate
|
||||
case (whereisCommand, whereisOptions) of
|
||||
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
|
||||
(WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
|
||||
runLeanWhereIs leanAppstate (do
|
||||
loc <- liftE $ whereIsTool tool v
|
||||
if directory
|
||||
@@ -282,6 +282,20 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
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
|
||||
runWhereIs runAppState (do
|
||||
|
||||
@@ -14,6 +14,8 @@ module Main where
|
||||
import BrickMain ( brickMain )
|
||||
#endif
|
||||
|
||||
import qualified GHCup.GHC as GHC
|
||||
import qualified GHCup.HLS as HLS
|
||||
import GHCup.OptParse
|
||||
|
||||
import GHCup.Download
|
||||
@@ -236,7 +238,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
| Just False <- optVerbose -> pure ()
|
||||
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||
newTools <- lift checkForUpdates
|
||||
newTools <- lift checkForUpdates
|
||||
forM_ newTools $ \newTool@(t, l) -> do
|
||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
||||
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
||||
@@ -277,7 +279,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runAppState action' = do
|
||||
s' <- liftIO appState
|
||||
runReaderT action' s'
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
-- Run command --
|
||||
@@ -337,14 +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 (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
|
||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion over) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
|
||||
alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
|
||||
alreadyInstalling _ _ = pure False
|
||||
|
||||
cmp' :: ( HasLog env
|
||||
|
||||
106
docs/guide.md
106
docs/guide.md
@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
|
||||
|
||||
## 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
|
||||
ghcup tui
|
||||
@@ -186,6 +186,51 @@ url-source:
|
||||
|
||||
# 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
|
||||
|
||||
There are a couple of good use cases to install custom bindists:
|
||||
@@ -202,7 +247,9 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
|
||||
GHCup always needs to know which version the bindist corresponds to (this is not automatically
|
||||
detected).
|
||||
|
||||
## Compiling GHC from source
|
||||
## Compiling from source
|
||||
|
||||
### GHC
|
||||
|
||||
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
|
||||
for a list of all available options.
|
||||
@@ -214,6 +261,47 @@ Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/gh
|
||||
|
||||
Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
|
||||
|
||||
### HLS
|
||||
|
||||
There are 3 main ways to compile HLS from source.
|
||||
|
||||
1. from hackage (should have up to date version bounds)
|
||||
- `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3`
|
||||
2. from git (allows to build latest sources and PRs)
|
||||
- `ghcup compile hls --git-ref master --ghc 9.2.3`
|
||||
- `ghcup compile hls --git-ref a32db0b --ghc 9.2.3`
|
||||
- `ghcup compile hls --git-ref 1.7.0.0 --ghc 9.2.3`
|
||||
3. from source distribution that's packaged during release from the corresponding git sources
|
||||
- `ghcup compile hls --source-dist 1.7.0.0 --ghc 9.2.3`
|
||||
|
||||
All these use `cabal v2-install` under the hood, so all build components are cached.
|
||||
You can pass arbitrary arguments to cabal, e.g. set the index state like so:
|
||||
|
||||
```sh
|
||||
ghcup compile hls --git-ref master --ghc 9.2.3 -- --index-state=2022-06-12T00:00:00Z --allow-newer
|
||||
```
|
||||
|
||||
You can pass `--ghc <ver>` multiple times to install for many GHCs at once.
|
||||
|
||||
When building from git sources, ghcup will auto-detect the HLS version that the git commit corresponds to
|
||||
from the `haskell-language-server.cabal` file. This version might not have been updated since the last release.
|
||||
If you want to avoid overwriting the existing installed HLS version, you can instruct ghcup to use `git describe`
|
||||
to set the HLS version instead:
|
||||
|
||||
```sh
|
||||
ghcup compile hls --git-ref master --ghc 9.2.3 --git-describe-version
|
||||
```
|
||||
|
||||
You can also set the version explicitly:
|
||||
|
||||
```sh
|
||||
ghcup compile hls --git-ref master --ghc 9.2.3 --overwrite-version 1.7.0.0-p1
|
||||
```
|
||||
|
||||
To instruct cabal to run `cabal update` before building, run `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3 --cabal-update`
|
||||
|
||||
As always, check `ghcup compile hls --help`.
|
||||
|
||||
### Cross support
|
||||
|
||||
ghcup can compile and install a cross GHC for any target. However, this
|
||||
@@ -258,7 +346,9 @@ Examples:
|
||||
|
||||
## 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
|
||||
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:\"
|
||||
@@ -270,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
|
||||
```
|
||||
|
||||
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:
|
||||
|
||||
* [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)
|
||||
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.
|
||||
|
||||
### github workflows
|
||||
|
||||
@@ -353,5 +441,5 @@ There are two known workarounds:
|
||||
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
|
||||
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
|
||||
```
|
||||
|
||||
@@ -69,6 +69,7 @@ library
|
||||
GHCup.Prelude.Process
|
||||
GHCup.Prelude.String.QQ
|
||||
GHCup.Prelude.Version.QQ
|
||||
GHCup.Prompts
|
||||
GHCup.Requirements
|
||||
GHCup.Stack
|
||||
GHCup.Types
|
||||
|
||||
@@ -33,8 +33,8 @@ module GHCup (
|
||||
|
||||
|
||||
import GHCup.Cabal
|
||||
import GHCup.GHC
|
||||
import GHCup.HLS
|
||||
import GHCup.GHC hiding ( GHCVer(..) )
|
||||
import GHCup.HLS hiding ( HLSVer(..) )
|
||||
import GHCup.Stack
|
||||
import GHCup.List
|
||||
import GHCup.Download
|
||||
@@ -206,9 +206,8 @@ rmGhcupDirs = do
|
||||
| isWindows = removeDirIfEmptyOrIsSymlink binDir
|
||||
| otherwise = do
|
||||
isXDGStyle <- liftIO useXDG
|
||||
if not isXDGStyle
|
||||
then removeDirIfEmptyOrIsSymlink binDir
|
||||
else pure ()
|
||||
when (not isXDGStyle) $
|
||||
removeDirIfEmptyOrIsSymlink binDir
|
||||
|
||||
reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
|
||||
reportRemainingFiles dir = do
|
||||
|
||||
@@ -137,7 +137,7 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
|
||||
|
||||
instance Pretty AlreadyInstalled where
|
||||
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 "'")
|
||||
|
||||
|
||||
|
||||
@@ -80,6 +80,12 @@ import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
data GHCVer v = SourceDist v
|
||||
| GitDist GitBranch
|
||||
| RemoteDist URI
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
--[ Tool fetching ]--
|
||||
---------------------
|
||||
@@ -295,8 +301,9 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
||||
| otherwise = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
|
||||
let alpineArgs
|
||||
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
||||
let ldOverride
|
||||
| ver >= [vver|8.2.2|]
|
||||
, _rPlatform `elem` [Linux Alpine, Darwin]
|
||||
= ["--disable-ld-override"]
|
||||
| otherwise
|
||||
= []
|
||||
@@ -304,7 +311,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
||||
: (alpineArgs <> (T.unpack <$> addConfArgs))
|
||||
: (ldOverride <> (T.unpack <$> addConfArgs))
|
||||
)
|
||||
(Just $ fromGHCupPath path)
|
||||
"ghc-configure"
|
||||
@@ -607,7 +614,7 @@ compileGHC :: ( MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Either GHCTargetVersion GitBranch -- ^ version to install
|
||||
=> GHCVer GHCTargetVersion
|
||||
-> Maybe Version -- ^ overwrite version
|
||||
-> Either Version FilePath -- ^ version to bootstrap with
|
||||
-> Maybe Int -- ^ jobs
|
||||
@@ -650,7 +657,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
SourceDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||
|
||||
-- download source tarball
|
||||
@@ -671,8 +678,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
pure (workdir, tmpUnpack, tver)
|
||||
|
||||
RemoteDist uri -> do
|
||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||
|
||||
-- download source tarball
|
||||
tmpDownload <- lift withGHCupTmpDir
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
|
||||
(bf, tver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] tmpUnpack $ do
|
||||
liftE $ unpackToDir (fromGHCupPath tmpUnpack) tar
|
||||
let regex = [s|^(.*/)*boot$|] :: B.ByteString
|
||||
[bootFile] <- liftIO $ findFilesDeep
|
||||
tmpUnpack
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
regex
|
||||
)
|
||||
tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
|
||||
pure (bootFile, tver)
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||
|
||||
pure (workdir, tmpUnpack, mkTVer tver)
|
||||
|
||||
-- clone from git
|
||||
Right GitBranch{..} -> do
|
||||
GitDist GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
||||
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
|
||||
@@ -715,14 +745,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
||||
|
||||
-- bootstrap
|
||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||
tver <- case _exitCode of
|
||||
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
|
||||
|
||||
tver <- liftE $ getGHCVer tmpUnpack
|
||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||
"GHC version (from Makefile): " <> prettyVer tver <>
|
||||
@@ -795,11 +818,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
pure installVer
|
||||
|
||||
where
|
||||
getGHCVer :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
)
|
||||
=> GHCupPath
|
||||
-> Excepts '[ProcessError] m Version
|
||||
getGHCVer tmpUnpack = do
|
||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||
case _exitCode of
|
||||
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
||||
|
||||
defaultConf =
|
||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||
in case targetGhc of
|
||||
Left (GHCTargetVersion (Just _) _) -> cross_mk
|
||||
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
|
||||
_ -> default_mk
|
||||
|
||||
compileHadrianBindist :: ( MonadReader env m
|
||||
@@ -976,7 +1017,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
-- for cross, we need Stage1Only
|
||||
case targetGhc of
|
||||
Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||
(InvalidBuildConfig
|
||||
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
||||
)
|
||||
|
||||
107
lib/GHCup/HLS.hs
107
lib/GHCup/HLS.hs
@@ -71,6 +71,12 @@ import qualified Text.Megaparsec as MP
|
||||
import Text.PrettyPrint.HughesPJClass (prettyShow)
|
||||
|
||||
|
||||
data HLSVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| HackageDist Version
|
||||
| RemoteDist URI
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ Installation ]--
|
||||
@@ -324,13 +330,14 @@ compileHLS :: ( MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Either Version GitBranch
|
||||
=> HLSVer
|
||||
-> [Version]
|
||||
-> Maybe Int
|
||||
-> Either Bool Version
|
||||
-> InstallDir
|
||||
-> Maybe (Either FilePath URI)
|
||||
-> Maybe URI
|
||||
-> Bool
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
-> [Text] -- ^ additional args to cabal install
|
||||
-> Excepts '[ NoDownload
|
||||
@@ -343,15 +350,18 @@ compileHLS :: ( MonadMask m
|
||||
, BuildFailed
|
||||
, NotInstalled
|
||||
] m Version
|
||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
|
||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
Dirs { .. } <- lift getDirs
|
||||
|
||||
when updateCabal $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
lift $ logInfo "Updating cabal DB"
|
||||
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
|
||||
|
||||
(workdir, tver, git_describe) <- case targetHLS of
|
||||
(workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
SourceDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
||||
|
||||
-- download source tarball
|
||||
@@ -369,10 +379,47 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
||||
(liftE . intoSubdir tmpUnpack)
|
||||
(view dlSubdir dlInfo)
|
||||
|
||||
pure (workdir, tver, Nothing)
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
HackageDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
|
||||
|
||||
-- download source tarball
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let hls = "haskell-language-server-" <> T.unpack (prettyVer tver)
|
||||
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
-- unpack
|
||||
lEM $ exec "cabal" ["unpack", hls] (Just $ fromGHCupPath tmpUnpack) Nothing
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack hls
|
||||
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
RemoteDist uri -> do
|
||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||
|
||||
-- download source tarball
|
||||
tmpDownload <- lift withGHCupTmpDir
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
|
||||
(cf, tver) <- liftE $ cleanUpOnError tmpUnpack $ do
|
||||
unpackToDir (fromGHCupPath tmpUnpack) tar
|
||||
let regex = [s|^(.*/)*haskell-language-server\.cabal$|] :: B.ByteString
|
||||
[cabalFile] <- liftIO $ findFilesDeep
|
||||
tmpUnpack
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
regex
|
||||
)
|
||||
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> cabalFile)
|
||||
pure (cabalFile, tver)
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
|
||||
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
-- clone from git
|
||||
Right GitBranch{..} -> do
|
||||
GitDist GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
||||
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
@@ -409,15 +456,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
||||
then pure Nothing
|
||||
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
||||
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||
(Just gpd) <- parseGenericPackageDescriptionMaybe
|
||||
<$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
|
||||
let tver = (\c -> Version Nothing c [] Nothing)
|
||||
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
|
||||
. versionNumbers
|
||||
. pkgVersion
|
||||
. package
|
||||
. packageDescription
|
||||
$ gpd
|
||||
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
|
||||
|
||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||
@@ -425,7 +464,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
||||
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
||||
|
||||
pure (tmpUnpack, tver, git_describe)
|
||||
pure (tmpUnpack, tmpUnpack, tver, git_describe)
|
||||
|
||||
-- the version that's installed may differ from the
|
||||
-- compiled version, so the user can overwrite it
|
||||
@@ -441,7 +480,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
||||
Right v -> pure v
|
||||
|
||||
liftE $ runBuildAction
|
||||
workdir
|
||||
tmpUnpack
|
||||
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
|
||||
let tmpInstallDir = fromGHCupPath workdir </> "out"
|
||||
liftIO $ createDirRecursive' tmpInstallDir
|
||||
@@ -457,14 +496,22 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
||||
pure "cabal.project"
|
||||
| otherwise -> pure (takeFileName cp)
|
||||
Just (Right uri) -> do
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False
|
||||
tmpUnpack' <- lift withGHCupTmpDir
|
||||
cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
|
||||
copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
|
||||
pure "cabal.project"
|
||||
Nothing -> pure "cabal.project"
|
||||
Nothing
|
||||
| HackageDist _ <- targetHLS -> do
|
||||
liftIO $ B.writeFile (fromGHCupPath workdir </> "cabal.project") "packages: ./"
|
||||
pure "cabal.project"
|
||||
| RemoteDist _ <- targetHLS -> do
|
||||
let cabalFile = fromGHCupPath workdir </> "cabal.project"
|
||||
liftIO $ whenM (not <$> doesFileExist cabalFile) $ B.writeFile cabalFile "packages: ./"
|
||||
pure "cabal.project"
|
||||
| otherwise -> pure "cabal.project"
|
||||
forM_ cabalProjectLocal $ \uri -> do
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False
|
||||
tmpUnpack' <- lift withGHCupTmpDir
|
||||
cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
|
||||
copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
|
||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||
let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
|
||||
@@ -658,3 +705,19 @@ rmHLSVer ver = do
|
||||
case headMay . reverse . sort $ hlsVers of
|
||||
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
||||
Nothing -> pure ()
|
||||
|
||||
|
||||
getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
|
||||
getCabalVersion fp = do
|
||||
contents <- liftIO $ B.readFile fp
|
||||
gpd <- case parseGenericPackageDescriptionMaybe contents of
|
||||
Nothing -> fail $ "could not parse cabal file: " <> fp
|
||||
Just r -> pure r
|
||||
let tver = (\c -> Version Nothing c [] Nothing)
|
||||
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
|
||||
. versionNumbers
|
||||
. pkgVersion
|
||||
. package
|
||||
. packageDescription
|
||||
$ gpd
|
||||
pure tver
|
||||
|
||||
28
lib/GHCup/Prompts.hs
Normal file
28
lib/GHCup/Prompts.hs
Normal 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
|
||||
@@ -407,6 +407,9 @@ data AppState = AppState
|
||||
|
||||
instance NFData AppState
|
||||
|
||||
fromAppState :: AppState -> LeanAppState
|
||||
fromAppState AppState {..} = LeanAppState {..}
|
||||
|
||||
data LeanAppState = LeanAppState
|
||||
{ settings :: Settings
|
||||
, dirs :: Dirs
|
||||
@@ -654,10 +657,7 @@ isSafeDir (IsolateDirResolved _) = False
|
||||
isSafeDir (GHCupDir _) = True
|
||||
isSafeDir (GHCupBinDir _) = False
|
||||
|
||||
type PromptQuestion = Text
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
data PromptResponse = PromptYes | PromptNo
|
||||
deriving (Show, Eq)
|
||||
|
||||
@@ -1097,7 +1097,8 @@ runBuildAction bdir action = do
|
||||
|
||||
-- | Clean up the given directory if the action fails,
|
||||
-- depending on the Settings.
|
||||
cleanUpOnError :: ( MonadReader env m
|
||||
cleanUpOnError :: forall e m a env .
|
||||
( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
|
||||
@@ -140,8 +140,12 @@ ecabal() {
|
||||
}
|
||||
|
||||
_ecabal() {
|
||||
# shellcheck disable=SC2086
|
||||
"${GHCUP_BIN}/cabal" "$@"
|
||||
if [ -n "${CABAL_BIN}" ] ; then
|
||||
"${CABAL_BIN}" "$@"
|
||||
else
|
||||
# shellcheck disable=SC2086
|
||||
"${GHCUP_BIN}/cabal" "$@"
|
||||
fi
|
||||
}
|
||||
|
||||
_done() {
|
||||
@@ -655,7 +659,7 @@ ask_hls() {
|
||||
warn "Do you want to install haskell-language-server (HLS)?"
|
||||
warn "HLS is a language-server that provides IDE-like functionality"
|
||||
warn "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
|
||||
warn "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
|
||||
warn "Also see https://haskell-language-server.readthedocs.io/en/stable/"
|
||||
warn ""
|
||||
warn "[Y] Yes [N] No [?] Help (default is \"N\")."
|
||||
warn ""
|
||||
@@ -817,7 +821,7 @@ else # don't install ghc and cabal
|
||||
# we'll remove it afterwards
|
||||
tmp_dir="$(mktemp -d)"
|
||||
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"
|
||||
unset tmp_dir
|
||||
;;
|
||||
|
||||
Reference in New Issue
Block a user