Allow to build HLS from hackage
This commit is contained in:
parent
9a72fa13d5
commit
63f22b28d7
GPG Key ID:
3786C5262ECB4A3F
|
|
@ -78,8 +78,9 @@ data GHCCompileOptions = GHCCompileOptions
|
|||
, isolateDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
|
||||
data HLSCompileOptions = HLSCompileOptions
|
||||
{ targetHLS :: Either Version GitBranch
|
||||
{ targetHLS :: HLSVer
|
||||
, jobs :: Maybe Int
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Either Bool Version
|
||||
|
|
@ -149,10 +150,12 @@ 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
|
||||
# compile 1.7.0.0 from hackage for 8.10.7
|
||||
ghcup compile hls --hackage-version 1.7.0.0 --ghc 8.10.7
|
||||
# compile 1.7.0.0 from official source dist 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 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|]
|
||||
|
||||
|
|
@ -270,7 +273,7 @@ ghcCompileOpts =
|
|||
hlsCompileOpts :: Parser HLSCompileOptions
|
||||
hlsCompileOpts =
|
||||
HLSCompileOptions
|
||||
<$> ((Left <$> option
|
||||
<$> ((SourceDist <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
|
|
@ -278,8 +281,9 @@ hlsCompileOpts =
|
|||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
)
|
||||
<|>
|
||||
(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 +291,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"])
|
||||
))
|
||||
)))
|
||||
))
|
||||
<|>
|
||||
(HackageDist <$> (option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(long "hackage-version" <> metavar "HACKAGE_VERSION" <> help
|
||||
"The hackage version to compile"
|
||||
<> (completer $ versionCompleter Nothing 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))
|
||||
|
|
@ -468,7 +493,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||
(CompileHLS HLSCompileOptions { .. }) -> do
|
||||
runCompileHLS runAppState (do
|
||||
case targetHLS of
|
||||
Left targetVer -> do
|
||||
SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
|
|
@ -476,7 +501,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
|
||||
|
|
|
|||
|
|
@ -342,7 +342,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer 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 }))
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = SourceDist tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HackageDist tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
|
||||
alreadyInstalling _ _ = pure False
|
||||
|
|
|
|||
|
|
@ -324,7 +324,7 @@ compileHLS :: ( MonadMask m
|
|||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Either Version GitBranch
|
||||
=> HLSVer
|
||||
-> [Version]
|
||||
-> Maybe Int
|
||||
-> Either Bool Version
|
||||
|
|
@ -349,9 +349,9 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||
Dirs { .. } <- lift getDirs
|
||||
|
||||
|
||||
(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 +369,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 $ handleIO (\_ -> pure []) $ 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 +446,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 +454,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 +470,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 +486,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 +695,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
|
||||
|
|
|
|||
|
|
@ -657,7 +657,9 @@ isSafeDir (GHCupBinDir _) = False
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
data HLSVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| HackageDist Version
|
||||
| RemoteDist URI
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue