Compare commits

..

12 Commits

Author SHA1 Message Date
6766501858 Merge branch 'hls-compile-improve' 2021-09-20 23:27:15 +02:00
d5b41683ca Improve HLS compile 2021-09-20 22:24:20 +02:00
ff8dbe111d Fix spelling 2021-09-20 20:01:24 +02:00
28d4071fac Bump version 2021-09-20 19:55:11 +02:00
31a523755f Remove solus support 2021-09-20 19:42:06 +02:00
3d1d8f1af7 Improve optparse hls stuff 2021-09-20 14:43:43 +02:00
167f6d0683 Merge branch 'freebsd-ci' 2021-09-20 12:09:54 +02:00
8580487b61 Add retries 2021-09-20 11:30:58 +02:00
a8b1c33280 Add FreeBSD12 CI back 2021-09-20 11:25:40 +02:00
fca2a4134b Merge branch 'hls-compile' 2021-09-19 22:38:51 +02:00
f90741f4d3 Implement compiling HLS from source 2021-09-19 22:04:32 +02:00
ba4b45f7fb Merge branch 'unset' 2021-09-19 16:25:30 +02:00
14 changed files with 521 additions and 2606 deletions

View File

@@ -49,6 +49,7 @@ variables:
OS: "LINUX" OS: "LINUX"
ARCH: "ARM" ARCH: "ARM"
CABAL_DIR: "$CI_PROJECT_DIR/cabal" CABAL_DIR: "$CI_PROJECT_DIR/cabal"
retry: 2
.linux:aarch64: .linux:aarch64:
image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
@@ -75,7 +76,7 @@ variables:
ARCH: "ARM64" ARCH: "ARM64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal" CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.freebsd: .freebsd13:
tags: tags:
- x86_64-freebsd13 - x86_64-freebsd13
variables: variables:
@@ -83,6 +84,14 @@ variables:
ARCH: "64" ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal" CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.freebsd12:
tags:
- x86_64-freebsd
variables:
OS: "FREEBSD"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.windows: .windows:
tags: tags:
- new-x86_64-windows - new-x86_64-windows
@@ -90,6 +99,7 @@ variables:
OS: "WINDOWS" OS: "WINDOWS"
ARCH: "64" ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal" CABAL_DIR: "$CI_PROJECT_DIR/cabal"
retry: 2
.root_cleanup: .root_cleanup:
after_script: after_script:
@@ -99,7 +109,7 @@ variables:
script: script:
- bash ./.gitlab/script/ghcup_version.sh - bash ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.6"
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week
paths: paths:
@@ -173,10 +183,18 @@ variables:
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1 runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1 runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
.test_ghcup_version:freebsd: .test_ghcup_version:freebsd12:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .freebsd - .freebsd12
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
.test_ghcup_version:freebsd13:
extends:
- .test_ghcup_version
- .freebsd13
- .root_cleanup - .root_cleanup
before_script: before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
@@ -207,7 +225,7 @@ variables:
only: only:
- tags - tags
variables: variables:
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.6"
######## stack test ######## ######## stack test ########
@@ -263,6 +281,23 @@ test:linux:
CABAL_VERSION: "3.4.0.0" CABAL_VERSION: "3.4.0.0"
needs: [] needs: []
test:linux:hls:
stage: test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.7"
HLS_TARGET_VERSION: "1.4.0"
CABAL_VERSION: "3.6.0.0"
needs: []
when: manual
allow_failure: true
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
script:
- ./.gitlab/script/ghcup_hls.sh
test:linux:cross-armv7: test:linux:cross-armv7:
stage: test stage: test
extends: extends:
@@ -355,9 +390,19 @@ test:mac:aarch64:
######## freebsd test ######## ######## freebsd test ########
test:freebsd: test:freebsd12:
stage: test stage: test
extends: .test_ghcup_version:freebsd extends: .test_ghcup_version:freebsd12
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
allow_failure: true # freebsd runners are unreliable
when: manual
needs: []
test:freebsd13:
stage: test
extends: .test_ghcup_version:freebsd13
variables: variables:
GHC_VERSION: "8.10.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0" CABAL_VERSION: "3.4.0.0"
@@ -491,11 +536,26 @@ release:darwin:aarch64:
######## freebsd release ######## ######## freebsd release ########
release:freebsd: release:freebsd12:
stage: release stage: release
needs: ["test:freebsd"] needs: ["test:freebsd12"]
extends: extends:
- .freebsd - .freebsd12
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.10.6"
CABAL_VERSION: "3.4.0.0"
allow_failure: true
release:freebsd13:
stage: release
needs: ["test:freebsd13"]
extends:
- .freebsd13
- .release_ghcup - .release_ghcup
- .root_cleanup - .root_cleanup
before_script: before_script:

51
.gitlab/script/ghcup_hls.sh Executable file
View File

@@ -0,0 +1,51 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
CI_PROJECT_DIR=$(pwd)
ecabal() {
cabal "$@"
}
eghcup() {
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
ecabal build -w ghc-${GHC_VERSION}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
### cleanup
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
cabal --version
eghcup debug-info
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
# nuke
eghcup nuke
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]

View File

@@ -187,6 +187,7 @@ data RmOptions = RmOptions
data CompileCommand = CompileGHC GHCCompileOptions data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions
data ConfigCommand = ShowConfig | SetConfig String String | InitConfig data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
@@ -205,6 +206,18 @@ data GHCCompileOptions = GHCCompileOptions
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
} }
data HLSCompileOptions = HLSCompileOptions
{ targetHLS :: Either Version GitBranch
, jobs :: Maybe Int
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, isolateDir :: Maybe FilePath
, cabalProject :: Maybe FilePath
, cabalProjectLocal :: Maybe FilePath
, patchDir :: Maybe FilePath
, targetGHCs :: [ToolVersion]
}
data UpgradeOpts = UpgradeInplace data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath | UpgradeAt FilePath
| UpgradeGHCupDir | UpgradeGHCupDir
@@ -895,6 +908,15 @@ compileP = subparser
<> footerDoc (Just $ text compileFooter) <> footerDoc (Just $ text compileFooter)
) )
) )
<> command
"hls"
( CompileHLS
<$> info
(hlsCompileOpts <**> helper)
( progDesc "Compile HLS from source"
<> footerDoc (Just $ text compileHLSFooter)
)
)
) )
where where
compileFooter = [s|Discussion: compileFooter = [s|Discussion:
@@ -919,6 +941,14 @@ Examples:
# build cross compiler # build cross compiler
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|] ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
compileHLSFooter = [s|Discussion:
Compiles and installs the specified HLS version.
The last argument is a list of GHC versions to compile for.
These need to be available in PATH prior to compilation.
Examples:
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
configP :: Parser ConfigCommand configP :: Parser ConfigCommand
configP = subparser configP = subparser
( command "init" initP ( command "init" initP
@@ -1188,6 +1218,78 @@ ghcCompileOpts =
) )
) )
hlsCompileOpts :: Parser HLSCompileOptions
hlsCompileOpts =
HLSCompileOptions
<$> ((Left <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
)
) <|>
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"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 GHC upstream)"))
)))
<*> optional
(option
(eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make"
)
)
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
<*> optional
(option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
)
)
<*> optional
(option
str
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
)
)
<*> optional
(option
(eitherReader absolutePathParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
"Absolute path to a cabal.project.local to be used for the build. Will be copied over."
)
)
<*> optional
(option
(eitherReader absolutePathParser)
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
)
)
<*> some (toolVersionArgument Nothing (Just GHC))
toolVersionParser :: Parser ToolVersion toolVersionParser :: Parser ToolVersion
toolVersionParser = verP' <|> toolP toolVersionParser = verP' <|> toolP
@@ -1203,9 +1305,13 @@ toolVersionParser = verP' <|> toolP
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionArgument criteria tool = toolVersionArgument criteria tool =
argument (eitherReader toolVersionEither) argument (eitherReader toolVersionEither)
(metavar "VERSION|TAG" (metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) []) <> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool) <> foldMap (completer . versionCompleter criteria) tool)
where
mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG"
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
@@ -1414,6 +1520,11 @@ isolateParser f = case isValid f of
True -> Right $ normalise f True -> Right $ normalise f
False -> Left "Please enter a valid filepath for isolate dir." False -> Left "Please enter a valid filepath for isolate dir."
absolutePathParser :: FilePath -> Either String FilePath
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right $ normalise f
False -> Left "Please enter a valid absolute filepath."
toSettings :: Options -> IO (Settings, KeyBindings) toSettings :: Options -> IO (Settings, KeyBindings)
toSettings options = do toSettings options = do
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -1789,6 +1900,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, ArchiveResult , ArchiveResult
] ]
let runCompileHLS =
runAppState
. runResourceT
. runE
@'[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
, DirNotEmpty
, ArchiveResult
]
let let
runLeanWhereIs = runLeanWhereIs =
-- Don't use runLeanAppState here, which is disabled on windows. -- Don't use runLeanAppState here, which is disabled on windows.
@@ -2224,6 +2358,53 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
runLogger $ logError $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 8 pure $ ExitFailure 8
Compile (CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS (do
case targetHLS of
Left targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
Right _ -> pure ()
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ compileHLS
targetHLS
ghcs
jobs
ovewrwiteVer
isolateDir
cabalProject
cabalProjectLocal
patchDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
when setCompile $ void $ liftE $
setHLS targetVer
pure (vi, targetVer)
)
>>= \case
VRight (vi, tv) -> do
runLogger $ logInfo
"HLS successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
putStr (T.unpack $ prettyVer tv)
pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9
Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ logError "Hadrian cross compile support is not yet implemented!" runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9 pure $ ExitFailure 9

View File

@@ -2388,6 +2388,10 @@ ghcupDownloads:
- Latest - Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viSourceDL:
dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
dlSubdir: haskell-language-server-1.4.0
dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
viArch: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,19 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.17 -- 2021-09-20
* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
* Implement compiling HLS from source wrt [#201](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/201)
* Implement experimental GPG verification of the metadata file (see README) wrt [#263](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/236)
* Add `ghcup unset` command wrt [#145](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/145)
* Add `ghcup whereis bindir` etc wrt [#221](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/221)
* Greatly reduce dependency footprint wrt [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/212)
* Add `ghcup --plan-json`
* Improve `--patchdir` option for GHC compilation wrt [#226](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/226)
* Try to improve logging and failure modes, especially during downloads
* Add descriptive warnings when HLS and GHC versions are incompatible
* Improve curl header parsing wrt [#213](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/213)
## 0.1.16.2 -- 2021-08-12 ## 0.1.16.2 -- 2021-08-12
* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria * Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.16.2 version: 0.1.17
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -24,7 +24,6 @@ extra-doc-files:
data/metadata/ghcup-0.0.4.yaml data/metadata/ghcup-0.0.4.yaml
data/metadata/ghcup-0.0.5.yaml data/metadata/ghcup-0.0.5.yaml
data/metadata/ghcup-0.0.6.yaml data/metadata/ghcup-0.0.6.yaml
data/metadata/ghcup-0.0.7.yaml
extra-source-files: extra-source-files:
data/build_mk/default data/build_mk/default
@@ -100,6 +99,7 @@ library
, base16-bytestring >=0.1.1.6 && <1.1 , base16-bytestring >=0.1.1.6 && <1.1
, binary ^>=0.8.6.0 , binary ^>=0.8.6.0
, bytestring ^>=0.10 , bytestring ^>=0.10
, Cabal
, case-insensitive ^>=1.2.1.0 , case-insensitive ^>=1.2.1.0
, casing ^>=0.1.4.1 , casing ^>=0.1.4.1
, concurrent-output ^>=1.10.11 , concurrent-output ^>=1.10.11

View File

@@ -63,6 +63,11 @@ import Data.Text ( Text )
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Format.ISO8601 import Data.Time.Format.ISO8601
import Data.Versions import Data.Versions
import Distribution.Types.Version hiding ( Version )
import Distribution.Types.PackageId
import Distribution.Types.PackageDescription
import Distribution.Types.GenericPackageDescription
import Distribution.PackageDescription.Parsec
import GHC.IO.Exception import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH import Language.Haskell.TH
@@ -83,6 +88,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix import Text.Regex.Posix
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
@@ -264,6 +270,7 @@ installPackedGHC :: ( MonadMask m
, HasLog env , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m
) )
=> FilePath -- ^ Path to the packed GHC bindist => FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
@@ -621,10 +628,7 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
Nothing -> do Nothing -> do
liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
-- create symlink if this is the latest version in a regular install liftE $ installHLSPostInst isoFilepath ver
hlsVers <- lift $ fmap rights getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-- | Install an unpacked hls distribution. -- | Install an unpacked hls distribution.
@@ -678,6 +682,21 @@ installHLSUnpacked path inst mver' forceInstall = do
lift $ chmod_755 destWrapperPath lift $ chmod_755 destWrapperPath
installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
=> Maybe FilePath
-> Version
-> Excepts '[NotInstalled] m ()
installHLSPostInst isoFilepath ver =
case isoFilepath of
Just _ -> pure ()
Nothing -> do
-- create symlink if this is the latest version in a regular install
hlsVers <- lift $ fmap rights getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m installHLSBin :: ( MonadMask m
@@ -716,6 +735,171 @@ installHLSBin ver isoFilepath forceInstall = do
installHLSBindist dlinfo ver isoFilepath forceInstall installHLSBindist dlinfo ver isoFilepath forceInstall
compileHLS :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[ NoDownload
, GPGError
, DownloadFailed
, DigestError
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, BuildFailed
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do
PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
(workdir, tver) <- case targetHLS of
-- unpack from version tarball
Left tver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
-- download source tarball
dlInfo <-
preview (ix HLS % ix tver % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tver)
-- clone from git
Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
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)"
lEM $ git [ "init" ]
lEM $ git [ "remote"
, "add"
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
(Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (tmpUnpack </> "haskell-language-server.cabal"))
pure . (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
pure (tmpUnpack, tver)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
let installVer = fromMaybe tver ov
liftE $ runBuildAction
workdir
Nothing
(reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
let installDir = workdir </> "out"
liftIO $ createDirRecursive' installDir
-- apply patches
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
-- set up project files
cp <- case cabalProject of
Just cp
| isAbsolute cp -> do
handleIO (throwE . CopyError . show) $ liftIO $ copyFile cp (workdir </> "cabal.project")
pure "cabal.project"
| otherwise -> pure (takeFileName cp)
Nothing -> pure "cabal.project"
forM_ cabalProjectLocal $ \cpl -> handleIO (throwE . CopyError . show) $ liftIO $ copyFile cpl (workdir </> cp <.> "local")
artifacts <- forM (sort ghcs) $ \ghc -> do
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
liftIO $ createDirRecursive' installDir
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
liftE $ lEM @_ @'[ProcessError] $
execLogged "cabal" ( [ "v2-install"
, "-w"
, "ghc-" <> T.unpack (prettyVer ghc)
, "--install-method=copy"
] ++
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
[ "--overwrite-policy=always"
, "--disable-profiling"
, "--disable-tests"
, "--enable-split-sections"
, "--enable-executable-stripping"
, "--enable-executable-static"
, "--installdir=" <> ghcInstallDir
, "--project-file=" <> cp
, "exe:haskell-language-server"
, "exe:haskell-language-server-wrapper"]
)
(Just workdir) "cabal" Nothing
pure ghcInstallDir
forM_ artifacts $ \artifact -> do
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(installDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
(installDir </> "haskell-language-server-wrapper" <.> exeExt)
liftIO $ rmPathForcibly artifact
case isolateDir of
Just isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked installDir isoDir Nothing True
Nothing -> do
liftE $ installHLSUnpacked installDir binDir (Just installVer) True
)
liftE $ installHLSPostInst isolateDir installVer
pure installVer
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
-- creates a default @stack -> stack-x.y.z.q@ symlink for -- creates a default @stack -> stack-x.y.z.q@ symlink for
-- the latest installed version. -- the latest installed version.

View File

@@ -636,7 +636,7 @@ checkDigest eDigest file = do
lift $ logInfo $ "verifying digest of: " <> T.pack p' lift $ logInfo $ "verifying digest of: " <> T.pack p'
c <- liftIO $ L.readFile file c <- liftIO $ L.readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
-- | Get additional curl args from env. This is an undocumented option. -- | Get additional curl args from env. This is an undocumented option.

View File

@@ -188,12 +188,14 @@ instance Pretty TarDirDoesNotExist where
text "Tar directory does not exist:" <+> pPrint dir text "Tar directory does not exist:" <+> pPrint dir
-- | File digest verification failed. -- | File digest verification failed.
data DigestError = DigestError Text Text data DigestError = DigestError FilePath Text Text
deriving Show deriving Show
instance Pretty DigestError where instance Pretty DigestError where
pPrint (DigestError currentDigest expectedDigest) = pPrint (DigestError fp currentDigest expectedDigest) =
text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest text "Digest error for" <+> text (fp <> ": expected")
<+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
"\nConsider removing the file in case it's cached and try again."
-- | File digest verification failed. -- | File digest verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs) data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)

View File

@@ -138,7 +138,6 @@ getLinuxDistro = do
| hasWord name ["exherbo"] -> Exherbo | hasWord name ["exherbo"] -> Exherbo
| hasWord name ["gentoo"] -> Gentoo | hasWord name ["gentoo"] -> Gentoo
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
| hasWord name ["solus"] -> Solus
| otherwise -> UnknownLinux | otherwise -> UnknownLinux
pure (distro, parsedVer) pure (distro, parsedVer)
where where

View File

@@ -223,7 +223,6 @@ data LinuxDistro = Debian
| RedHat | RedHat
| Alpine | Alpine
| AmazonLinux | AmazonLinux
| Solus
-- rolling -- rolling
| Gentoo | Gentoo
| Exherbo | Exherbo
@@ -243,7 +242,6 @@ distroToString CentOS = "centos"
distroToString RedHat = "redhat" distroToString RedHat = "redhat"
distroToString Alpine = "alpine" distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon" distroToString AmazonLinux = "amazon"
distroToString Solus = "solus"
distroToString Gentoo = "gentoo" distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo" distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown" distroToString UnknownLinux = "unknown"

View File

@@ -842,6 +842,8 @@ runBuildAction :: ( Pretty (V e)
, MonadMask m , MonadMask m
, HasLog env , HasLog env
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m
, MonadCatch m
) )
=> FilePath -- ^ build directory (cleaned up depending on Settings) => FilePath -- ^ build directory (cleaned up depending on Settings)
-> Maybe FilePath -- ^ dir to *always* clean up on exception -> Maybe FilePath -- ^ dir to *always* clean up on exception
@@ -1039,7 +1041,7 @@ ensureGlobalTools = do
shimDownload <- liftE $ lE @_ @'[NoDownload] shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _) -> do void $ (\(DigestError _ _ _) -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..." lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe")) lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe") lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")

View File

@@ -28,7 +28,7 @@ import qualified Data.Text as T
-- Note that when updating this, CI requires that the file exsists AND the same file exists at -- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added. -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP