Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
f60e1d1624
|
@@ -97,23 +97,17 @@ rm -rf "${GHCUP_DIR}"
|
|||||||
eghcup --numeric-version
|
eghcup --numeric-version
|
||||||
|
|
||||||
eghcup install ghc ${GHC_VERSION}
|
eghcup install ghc ${GHC_VERSION}
|
||||||
eghcup unset ghc ${GHC_VERSION}
|
|
||||||
ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
|
ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
|
||||||
[ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
|
[ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
|
||||||
[ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
|
[ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
|
||||||
[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
|
|
||||||
eghcup set ghc ${GHC_VERSION}
|
eghcup set ghc ${GHC_VERSION}
|
||||||
eghcup install cabal ${CABAL_VERSION}
|
eghcup install cabal ${CABAL_VERSION}
|
||||||
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
||||||
eghcup unset cabal
|
eghcup unset cabal
|
||||||
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
||||||
|
|
||||||
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
|
|
||||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
|
||||||
[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
|
|
||||||
eghcup set cabal ${CABAL_VERSION}
|
eghcup set cabal ${CABAL_VERSION}
|
||||||
|
|
||||||
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
||||||
|
[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
|
||||||
|
|
||||||
if [ "${OS}" != "FREEBSD" ] ; then
|
if [ "${OS}" != "FREEBSD" ] ; then
|
||||||
if [ "${ARCH}" = "64" ] ; then
|
if [ "${ARCH}" = "64" ] ; then
|
||||||
|
|||||||
@@ -82,7 +82,7 @@ data HLSCompileOptions = HLSCompileOptions
|
|||||||
{ targetHLS :: Either Version GitBranch
|
{ targetHLS :: Either Version GitBranch
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Either Bool Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, cabalProject :: Maybe (Either FilePath URI)
|
, cabalProject :: Maybe (Either FilePath URI)
|
||||||
, cabalProjectLocal :: Maybe URI
|
, cabalProjectLocal :: Maybe URI
|
||||||
@@ -145,16 +145,14 @@ Examples:
|
|||||||
|
|
||||||
compileHLSFooter = [s|Discussion:
|
compileHLSFooter = [s|Discussion:
|
||||||
Compiles and installs the specified HLS version.
|
Compiles and installs the specified HLS version.
|
||||||
The --ghc arguments are necessary to specify which GHC version to build for/against.
|
The last argument is a list of GHC versions to compile for.
|
||||||
These need to be available in PATH prior to compilation.
|
These need to be available in PATH prior to compilation.
|
||||||
|
|
||||||
Examples:
|
Examples:
|
||||||
# compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
|
# compile 1.4.0 for ghc 8.10.5 and 8.10.7
|
||||||
ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
|
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
|
||||||
# compile from master for ghc 9.2.3 and use 'git describe' to name the binary
|
# compile from master for ghc 8.10.7, linking everything dynamically
|
||||||
ghcup compile hls -g master --git-describe-version --ghc 9.2.3
|
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
|
||||||
# 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|]
|
|
||||||
|
|
||||||
|
|
||||||
ghcCompileOpts :: Parser GHCCompileOptions
|
ghcCompileOpts :: Parser GHCCompileOptions
|
||||||
@@ -282,7 +280,7 @@ hlsCompileOpts =
|
|||||||
(Right <$> (GitBranch <$> option
|
(Right <$> (GitBranch <$> option
|
||||||
str
|
str
|
||||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||||
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
|
"The git commit/branch/ref to build from"
|
||||||
) <*>
|
) <*>
|
||||||
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
|
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"])
|
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
|
||||||
@@ -297,9 +295,8 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
|
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
|
||||||
<*>
|
<*> optional
|
||||||
(
|
(option
|
||||||
(Right <$> option
|
|
||||||
(eitherReader
|
(eitherReader
|
||||||
(first (const "Not a valid version") . version . T.pack)
|
(first (const "Not a valid version") . version . T.pack)
|
||||||
)
|
)
|
||||||
@@ -308,14 +305,6 @@ hlsCompileOpts =
|
|||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter Nothing HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
|
||||||
(Left <$> (switch
|
|
||||||
(long "git-describe-version"
|
|
||||||
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader isolateParser)
|
(eitherReader isolateParser)
|
||||||
|
|||||||
@@ -18,7 +18,6 @@ import GHCup.Prelude
|
|||||||
import GHCup.Prelude.File
|
import GHCup.Prelude.File
|
||||||
#ifdef IS_WINDOWS
|
#ifdef IS_WINDOWS
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
import GHCup.Prelude.Process.Windows ( execNoMinGW )
|
|
||||||
#endif
|
#endif
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
@@ -59,7 +58,6 @@ import qualified System.Posix.Process as SPP
|
|||||||
data RunOptions = RunOptions
|
data RunOptions = RunOptions
|
||||||
{ runAppendPATH :: Bool
|
{ runAppendPATH :: Bool
|
||||||
, runInstTool' :: Bool
|
, runInstTool' :: Bool
|
||||||
, runMinGWPath :: Bool
|
|
||||||
, runGHCVer :: Maybe ToolVersion
|
, runGHCVer :: Maybe ToolVersion
|
||||||
, runCabalVer :: Maybe ToolVersion
|
, runCabalVer :: Maybe ToolVersion
|
||||||
, runHLSVer :: Maybe ToolVersion
|
, runHLSVer :: Maybe ToolVersion
|
||||||
@@ -84,8 +82,6 @@ runOpts =
|
|||||||
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
|
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
|
||||||
<*> switch
|
<*> switch
|
||||||
(short 'i' <> long "install" <> help "Install the tool, if missing")
|
(short 'i' <> long "install" <> help "Install the tool, if missing")
|
||||||
<*> switch
|
|
||||||
(short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
|
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader toolVersionEither)
|
(eitherReader toolVersionEither)
|
||||||
@@ -253,9 +249,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
#else
|
#else
|
||||||
r' <- if runMinGWPath
|
r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
|
||||||
then runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
|
|
||||||
else runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ execNoMinGW cmd args Nothing (Just newEnv)
|
|
||||||
case r' of
|
case r' of
|
||||||
VRight _ -> pure ExitSuccess
|
VRight _ -> pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
|
|||||||
@@ -26,6 +26,7 @@ import GHCup.Prelude
|
|||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
|
import GHC.Debug.Stub
|
||||||
|
|
||||||
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
|
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
@@ -120,7 +121,7 @@ plan_json = $( do
|
|||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = withGhcDebug $ do
|
||||||
-- https://gitlab.haskell.org/ghc/ghc/issues/8118
|
-- https://gitlab.haskell.org/ghc/ghc/issues/8118
|
||||||
setLocaleEncoding utf8
|
setLocaleEncoding utf8
|
||||||
|
|
||||||
@@ -340,7 +341,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
|
||||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
|
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||||
|
|||||||
@@ -32,4 +32,7 @@ package aeson
|
|||||||
package streamly
|
package streamly
|
||||||
flags: +use-unliftio
|
flags: +use-unliftio
|
||||||
|
|
||||||
|
package *
|
||||||
|
ghc-options: -finfo-table-map -fdistinct-constructor-tables
|
||||||
|
|
||||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||||
|
|||||||
@@ -74,15 +74,12 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
|
|||||||
|
|
||||||
## Known users
|
## Known users
|
||||||
|
|
||||||
* CI:
|
* Github actions:
|
||||||
- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
|
- [actions/virtual-environments](https://github.com/actions/virtual-environments)
|
||||||
- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
|
- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
|
||||||
- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
|
|
||||||
* mirrors:
|
* mirrors:
|
||||||
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
|
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
|
||||||
* tools:
|
* tools:
|
||||||
- [vscode-haskell](https://github.com/haskell/vscode-haskell)
|
|
||||||
- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
|
|
||||||
- [vabal](https://github.com/Franciman/vabal)
|
- [vabal](https://github.com/Franciman/vabal)
|
||||||
|
|
||||||
## Known problems
|
## Known problems
|
||||||
|
|||||||
@@ -200,14 +200,6 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
|
|||||||
|
|
||||||
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
||||||
|
|
||||||
## VSCode integration
|
|
||||||
The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
|
|
||||||
|
|
||||||
1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
|
|
||||||
2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
|
|
||||||
3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
|
|
||||||
- instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
|
|
||||||
|
|
||||||
## Get help
|
## Get help
|
||||||
|
|
||||||
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
|
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
|
||||||
|
|||||||
@@ -164,10 +164,8 @@ library
|
|||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
other-modules:
|
other-modules:
|
||||||
GHCup.Prelude.File.Windows
|
GHCup.Prelude.File.Windows
|
||||||
GHCup.Prelude.Windows
|
|
||||||
-- GHCup.OptParse.Run uses this
|
|
||||||
exposed-modules:
|
|
||||||
GHCup.Prelude.Process.Windows
|
GHCup.Prelude.Process.Windows
|
||||||
|
GHCup.Prelude.Windows
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
, bzlib
|
, bzlib
|
||||||
@@ -242,6 +240,7 @@ executable ghcup
|
|||||||
, deepseq ^>=1.4
|
, deepseq ^>=1.4
|
||||||
, directory ^>=1.3.6.0
|
, directory ^>=1.3.6.0
|
||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
|
, ghc-debug-stub
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-types ^>=1.5
|
, haskus-utils-types ^>=1.5
|
||||||
, haskus-utils-variant ^>=3.2.1
|
, haskus-utils-variant ^>=3.2.1
|
||||||
|
|||||||
@@ -566,11 +566,8 @@ rmGHCVer ver = do
|
|||||||
lift $ recycleFile f
|
lift $ recycleFile f
|
||||||
when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
|
when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
isDir <- liftIO $ doesDirectoryExist dir
|
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
|
||||||
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
|
lift $ recyclePathForcibly dir'
|
||||||
when (isDir && not isSyml) $ do
|
|
||||||
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
|
|
||||||
recyclePathForcibly dir'
|
|
||||||
|
|
||||||
v' <-
|
v' <-
|
||||||
handle
|
handle
|
||||||
@@ -684,53 +681,28 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, "origin"
|
, "origin"
|
||||||
, fromString rep ]
|
, fromString rep ]
|
||||||
|
|
||||||
-- figure out if we can do a shallow clone
|
let fetch_args =
|
||||||
remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
|
[ "fetch"
|
||||||
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
|
, "--depth"
|
||||||
let shallow_clone
|
, "1"
|
||||||
| isCommitHash ref = True
|
, "--quiet"
|
||||||
| fromString ref `elem` remoteBranches = True
|
, "origin"
|
||||||
| otherwise = False
|
, fromString ref ]
|
||||||
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
|
|
||||||
|
|
||||||
-- fetch
|
|
||||||
let fetch_args
|
|
||||||
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
|
|
||||||
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
|
|
||||||
lEM $ git fetch_args
|
lEM $ git fetch_args
|
||||||
|
|
||||||
-- initial checkout
|
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
||||||
lEM $ git [ "checkout", fromString ref ]
|
|
||||||
|
|
||||||
-- gather some info
|
|
||||||
git_describe <- if shallow_clone
|
|
||||||
then pure Nothing
|
|
||||||
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
|
||||||
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
|
||||||
|
|
||||||
-- clone submodules
|
|
||||||
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
||||||
|
|
||||||
-- apply patches
|
|
||||||
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
||||||
|
|
||||||
-- bootstrap
|
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
CapturedProcess {..} <- lift $ makeOut
|
||||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||||
tver <- case _exitCode of
|
case _exitCode of
|
||||||
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
|
||||||
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
|
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
|
||||||
|
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
|
||||||
"GHC version (from Makefile): " <> prettyVer tver <>
|
|
||||||
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
|
||||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
|
||||||
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
|
||||||
|
|
||||||
pure tver
|
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
|
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
|
|||||||
@@ -327,7 +327,7 @@ compileHLS :: ( MonadMask m
|
|||||||
=> Either Version GitBranch
|
=> Either Version GitBranch
|
||||||
-> [Version]
|
-> [Version]
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Either Bool Version
|
-> Maybe Version
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Maybe (Either FilePath URI)
|
-> Maybe (Either FilePath URI)
|
||||||
-> Maybe URI
|
-> Maybe URI
|
||||||
@@ -349,7 +349,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
|
|
||||||
|
|
||||||
(workdir, tver, git_describe) <- case targetHLS of
|
(workdir, tver) <- case targetHLS of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
Left tver -> do
|
Left tver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
||||||
@@ -369,13 +369,13 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
(liftE . intoSubdir tmpUnpack)
|
(liftE . intoSubdir tmpUnpack)
|
||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
|
|
||||||
pure (workdir, tver, Nothing)
|
pure (workdir, tver)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
Right GitBranch{..} -> do
|
Right GitBranch{..} -> do
|
||||||
tmpUnpack <- lift mkGhcupTmpDir
|
tmpUnpack <- lift mkGhcupTmpDir
|
||||||
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
||||||
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||||
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
|
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
|
||||||
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||||
lEM $ git [ "init" ]
|
lEM $ git [ "init" ]
|
||||||
@@ -384,61 +384,33 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
, "origin"
|
, "origin"
|
||||||
, fromString rep ]
|
, fromString rep ]
|
||||||
|
|
||||||
-- figure out if we can do a shallow clone
|
let fetch_args =
|
||||||
remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
|
[ "fetch"
|
||||||
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
|
, "--depth"
|
||||||
let shallow_clone
|
, "1"
|
||||||
| gitDescribeRequested = False
|
, "--quiet"
|
||||||
| isCommitHash ref = True
|
, "origin"
|
||||||
| fromString ref `elem` remoteBranches = True
|
, fromString ref ]
|
||||||
| otherwise = False
|
|
||||||
|
|
||||||
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
|
|
||||||
|
|
||||||
-- fetch
|
|
||||||
let fetch_args
|
|
||||||
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
|
|
||||||
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
|
|
||||||
lEM $ git fetch_args
|
lEM $ git fetch_args
|
||||||
|
|
||||||
-- checkout
|
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
||||||
lEM $ git [ "checkout", fromString ref ]
|
(Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
|
||||||
|
pure . (\c -> Version Nothing c [] Nothing)
|
||||||
|
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
|
||||||
|
. versionNumbers
|
||||||
|
. pkgVersion
|
||||||
|
. package
|
||||||
|
. packageDescription
|
||||||
|
$ gpd
|
||||||
|
|
||||||
-- gather some info
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||||
git_describe <- if shallow_clone
|
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
|
||||||
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
|
|
||||||
|
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
pure (tmpUnpack, tver)
|
||||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
|
||||||
"HLS version (from cabal file): " <> prettyVer tver <>
|
|
||||||
(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)
|
|
||||||
|
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
-- compiled version, so the user can overwrite it
|
-- compiled version, so the user can overwrite it
|
||||||
installVer <- case ov of
|
let installVer = fromMaybe tver ov
|
||||||
Left True -> case git_describe of
|
|
||||||
-- git describe
|
|
||||||
Just h -> either (fail . displayException) pure . version $ h
|
|
||||||
-- git describe, but not building from git, lol
|
|
||||||
Nothing -> pure tver
|
|
||||||
-- default: use detected version
|
|
||||||
Left False -> pure tver
|
|
||||||
-- overwrite version with users value
|
|
||||||
Right v -> pure v
|
|
||||||
|
|
||||||
liftE $ runBuildAction
|
liftE $ runBuildAction
|
||||||
workdir
|
workdir
|
||||||
@@ -492,7 +464,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
pure ghcInstallDir
|
pure ghcInstallDir
|
||||||
|
|
||||||
forM_ artifacts $ \artifact -> do
|
forM_ artifacts $ \artifact -> do
|
||||||
logDebug $ T.pack (show artifact)
|
logInfo $ T.pack (show artifact)
|
||||||
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
|
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
|
||||||
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
|
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
|
||||||
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
|
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
|
||||||
@@ -507,10 +479,6 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
)
|
)
|
||||||
|
|
||||||
pure installVer
|
pure installVer
|
||||||
where
|
|
||||||
gitDescribeRequested = case ov of
|
|
||||||
Left b -> b
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
@@ -646,11 +614,8 @@ rmHLSVer ver = do
|
|||||||
lift $ recycleFile f
|
lift $ recycleFile f
|
||||||
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
|
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
isDir <- liftIO $ doesDirectoryExist hlsDir
|
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
|
||||||
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
|
recyclePathForcibly hlsDir'
|
||||||
when (isDir && not isSyml) $ do
|
|
||||||
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
|
|
||||||
recyclePathForcibly hlsDir'
|
|
||||||
|
|
||||||
when (Just ver == isHlsSet) $ do
|
when (Just ver == isHlsSet) $ do
|
||||||
-- set latest hls
|
-- set latest hls
|
||||||
|
|||||||
@@ -206,36 +206,10 @@ exec :: MonadIO m
|
|||||||
-> Maybe [(String, String)] -- ^ optional environment
|
-> Maybe [(String, String)] -- ^ optional environment
|
||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
exec exe args chdir env = do
|
exec exe args chdir env = do
|
||||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
|
||||||
forM_ (Map.fromList <$> env) $ \cEnv -> do
|
|
||||||
let paths = ["PATH", "Path"]
|
|
||||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
|
||||||
newPath = intercalate [searchPathSeparator] curPaths
|
|
||||||
liftIO $ setEnv "PATH" ""
|
|
||||||
liftIO $ setEnv "Path" newPath
|
|
||||||
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
|
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
|
||||||
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
||||||
pure $ toProcessError exe args exit_code
|
pure $ toProcessError exe args exit_code
|
||||||
|
|
||||||
-- | Like 'exec', except doesn't add msys2 stuff to PATH.
|
|
||||||
execNoMinGW :: MonadIO m
|
|
||||||
=> FilePath -- ^ thing to execute
|
|
||||||
-> [FilePath] -- ^ args for the thing
|
|
||||||
-> Maybe FilePath -- ^ optionally chdir into this
|
|
||||||
-> Maybe [(String, String)] -- ^ optional environment
|
|
||||||
-> m (Either ProcessError ())
|
|
||||||
execNoMinGW exe args chdir env = do
|
|
||||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
|
||||||
forM_ (Map.fromList <$> env) $ \cEnv -> do
|
|
||||||
let paths = ["PATH", "Path"]
|
|
||||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
|
||||||
newPath = intercalate [searchPathSeparator] curPaths
|
|
||||||
liftIO $ setEnv "PATH" ""
|
|
||||||
liftIO $ setEnv "Path" newPath
|
|
||||||
let cp = (proc exe args) { cwd = chdir, env = env }
|
|
||||||
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
|
||||||
pure $ toProcessError exe args exit_code
|
|
||||||
|
|
||||||
|
|
||||||
-- | Thin wrapper around `executeFile`.
|
-- | Thin wrapper around `executeFile`.
|
||||||
execShell :: MonadIO m
|
execShell :: MonadIO m
|
||||||
|
|||||||
@@ -61,7 +61,6 @@ import Control.Monad.Reader
|
|||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||||
import Data.Char ( isHexDigit )
|
|
||||||
import Data.Bifunctor ( first )
|
import Data.Bifunctor ( first )
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
@@ -1276,35 +1275,3 @@ warnAboutHlsCompatibility = do
|
|||||||
T.pack (prettyShow supportedGHC)
|
T.pack (prettyShow supportedGHC)
|
||||||
|
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------
|
|
||||||
--[ Git ]--
|
|
||||||
-----------
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
isCommitHash :: String -> Bool
|
|
||||||
isCommitHash str' = let hex = all isHexDigit str'
|
|
||||||
len = length str'
|
|
||||||
in hex && len == 40
|
|
||||||
|
|
||||||
|
|
||||||
gitOut :: (MonadReader env m, HasLog env, MonadIO m) => [String] -> FilePath -> Excepts '[ProcessError] m T.Text
|
|
||||||
gitOut args dir = do
|
|
||||||
CapturedProcess {..} <- lift $ executeOut "git" args (Just dir)
|
|
||||||
case _exitCode of
|
|
||||||
ExitSuccess -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
|
|
||||||
ExitFailure c -> do
|
|
||||||
let pe = NonZeroExit c "git" args
|
|
||||||
lift $ logDebug $ T.pack (prettyShow pe)
|
|
||||||
throwE pe
|
|
||||||
|
|
||||||
processBranches :: T.Text -> [String]
|
|
||||||
processBranches str' = let lines' = lines (T.unpack str')
|
|
||||||
words' = fmap words lines'
|
|
||||||
refs = catMaybes $ fmap (`atMay` 1) words'
|
|
||||||
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
|
|
||||||
in branches
|
|
||||||
|
|
||||||
|
|||||||
@@ -133,15 +133,6 @@ _eghcup() {
|
|||||||
fi
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
ecabal() {
|
|
||||||
edo _ecabal "$@"
|
|
||||||
}
|
|
||||||
|
|
||||||
_ecabal() {
|
|
||||||
# shellcheck disable=SC2086
|
|
||||||
"${GHCUP_BIN}/cabal" "$@"
|
|
||||||
}
|
|
||||||
|
|
||||||
_done() {
|
_done() {
|
||||||
echo
|
echo
|
||||||
echo "==============================================================================="
|
echo "==============================================================================="
|
||||||
@@ -546,7 +537,7 @@ adjust_cabal_config() {
|
|||||||
else
|
else
|
||||||
cabal_bin="$HOME/AppData/Roaming/cabal/bin"
|
cabal_bin="$HOME/AppData/Roaming/cabal/bin"
|
||||||
fi
|
fi
|
||||||
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
|
edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
|
||||||
}
|
}
|
||||||
|
|
||||||
ask_cabal_config_init() {
|
ask_cabal_config_init() {
|
||||||
@@ -697,7 +688,7 @@ find_shell
|
|||||||
echo
|
echo
|
||||||
echo "Welcome to Haskell!"
|
echo "Welcome to Haskell!"
|
||||||
echo
|
echo
|
||||||
echo "This script can download and install the following binaries:"
|
echo "This script will download and install the following binaries:"
|
||||||
echo " * ghcup - The Haskell toolchain installer"
|
echo " * ghcup - The Haskell toolchain installer"
|
||||||
echo " * ghc - The Glasgow Haskell Compiler"
|
echo " * ghc - The Glasgow Haskell Compiler"
|
||||||
echo " * cabal - The Cabal build tool for managing Haskell software"
|
echo " * cabal - The Cabal build tool for managing Haskell software"
|
||||||
|
|||||||
@@ -242,7 +242,7 @@ if ($Silent -and !($InstallDir)) {
|
|||||||
Print-Msg -color Magenta -msg (@'
|
Print-Msg -color Magenta -msg (@'
|
||||||
Welcome to Haskell!
|
Welcome to Haskell!
|
||||||
|
|
||||||
This script can download and install the following programs:
|
This script will download and install the following programs:
|
||||||
* ghcup - The Haskell toolchain installer
|
* ghcup - The Haskell toolchain installer
|
||||||
* ghc - The Glasgow Haskell Compiler
|
* ghc - The Glasgow Haskell Compiler
|
||||||
* msys2 - A linux-style toolchain environment required for many operations
|
* msys2 - A linux-style toolchain environment required for many operations
|
||||||
|
|||||||
Reference in New Issue
Block a user