Merge branch 'hls-hackage'
This commit is contained in:
commit
2f299ee48d
@ -440,9 +440,11 @@ tagCompleter tool add = listIOCompleter $ do
|
|||||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||||
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
||||||
|
|
||||||
|
|
||||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
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
|
dirs' <- liftIO getAllDirs
|
||||||
let loggerConfig = LoggerConfig
|
let loggerConfig = LoggerConfig
|
||||||
{ lcPrintDebug = False
|
{ lcPrintDebug = False
|
||||||
@ -471,7 +473,7 @@ versionCompleter criteria tool = listIOCompleter $ do
|
|||||||
runEnv = flip runReaderT appState
|
runEnv = flip runReaderT appState
|
||||||
|
|
||||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
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
|
toolDlCompleter :: Tool -> Completer
|
||||||
|
@ -12,6 +12,8 @@ module GHCup.OptParse.Compile where
|
|||||||
|
|
||||||
|
|
||||||
import GHCup
|
import GHCup
|
||||||
|
import qualified GHCup.GHC as GHC
|
||||||
|
import qualified GHCup.HLS as HLS
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
@ -30,7 +32,8 @@ import Control.Monad.Trans.Resource
|
|||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
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 Data.Text ( Text )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
@ -41,7 +44,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
|||||||
|
|
||||||
import URI.ByteString hiding ( uriParser )
|
import URI.ByteString hiding ( uriParser )
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask, displayException)
|
||||||
import System.FilePath (isPathSeparator)
|
import System.FilePath (isPathSeparator)
|
||||||
import Text.Read (readEither)
|
import Text.Read (readEither)
|
||||||
|
|
||||||
@ -64,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
|
|||||||
|
|
||||||
|
|
||||||
data GHCCompileOptions = GHCCompileOptions
|
data GHCCompileOptions = GHCCompileOptions
|
||||||
{ targetGhc :: Either Version GitBranch
|
{ targetGhc :: GHC.GHCVer Version
|
||||||
, bootstrapGhc :: Either Version FilePath
|
, bootstrapGhc :: Either Version FilePath
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, buildConfig :: Maybe FilePath
|
, buildConfig :: Maybe FilePath
|
||||||
@ -78,10 +81,12 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
data HLSCompileOptions = HLSCompileOptions
|
data HLSCompileOptions = HLSCompileOptions
|
||||||
{ targetHLS :: Either Version GitBranch
|
{ targetHLS :: HLS.HLSVer
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
|
, updateCabal :: Bool
|
||||||
, ovewrwiteVer :: Either Bool Version
|
, ovewrwiteVer :: Either Bool Version
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, cabalProject :: Maybe (Either FilePath URI)
|
, cabalProject :: Maybe (Either FilePath URI)
|
||||||
@ -149,10 +154,10 @@ Examples:
|
|||||||
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.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
||||||
ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
|
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
||||||
# compile from master for ghc 9.2.3 and use 'git describe' to name the binary
|
# 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
|
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
|
# 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|]
|
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
|
||||||
|
|
||||||
@ -160,7 +165,7 @@ Examples:
|
|||||||
ghcCompileOpts :: Parser GHCCompileOptions
|
ghcCompileOpts :: Parser GHCCompileOptions
|
||||||
ghcCompileOpts =
|
ghcCompileOpts =
|
||||||
GHCCompileOptions
|
GHCCompileOptions
|
||||||
<$> ((Left <$> option
|
<$> ((GHC.SourceDist <$> option
|
||||||
(eitherReader
|
(eitherReader
|
||||||
(first (const "Not a valid version") . version . T.pack)
|
(first (const "Not a valid version") . version . T.pack)
|
||||||
)
|
)
|
||||||
@ -169,7 +174,7 @@ ghcCompileOpts =
|
|||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter Nothing GHC)
|
||||||
)
|
)
|
||||||
) <|>
|
) <|>
|
||||||
(Right <$> (GitBranch <$> option
|
(GHC.GitDist <$> (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"
|
"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)"
|
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"])
|
<> 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
|
<*> option
|
||||||
(eitherReader
|
(eitherReader
|
||||||
(\x ->
|
(\x ->
|
||||||
@ -270,16 +286,17 @@ ghcCompileOpts =
|
|||||||
hlsCompileOpts :: Parser HLSCompileOptions
|
hlsCompileOpts :: Parser HLSCompileOptions
|
||||||
hlsCompileOpts =
|
hlsCompileOpts =
|
||||||
HLSCompileOptions
|
HLSCompileOptions
|
||||||
<$> ((Left <$> option
|
<$> ((HLS.HackageDist <$> option
|
||||||
(eitherReader
|
(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
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||||
"The tool version to compile"
|
"The version to compile (pulled from hackage)"
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||||
)
|
)
|
||||||
) <|>
|
)
|
||||||
(Right <$> (GitBranch <$> option
|
<|>
|
||||||
|
(HLS.GitDist <$> (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 (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)"
|
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"])
|
||||||
))
|
))
|
||||||
)))
|
))
|
||||||
|
<|>
|
||||||
|
(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
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader (readEither @Int))
|
(eitherReader (readEither @Int))
|
||||||
@ -297,6 +335,7 @@ 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"))
|
||||||
|
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
||||||
<*>
|
<*>
|
||||||
(
|
(
|
||||||
(Right <$> option
|
(Right <$> option
|
||||||
@ -468,7 +507,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
(CompileHLS HLSCompileOptions { .. }) -> do
|
(CompileHLS HLSCompileOptions { .. }) -> do
|
||||||
runCompileHLS runAppState (do
|
runCompileHLS runAppState (do
|
||||||
case targetHLS of
|
case targetHLS of
|
||||||
Left targetVer -> do
|
HLS.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo targetVer HLS dls
|
||||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
@ -476,7 +515,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
lift $ logInfo
|
lift $ logInfo
|
||||||
"...waiting for 5 seconds, you can still abort..."
|
"...waiting for 5 seconds, you can still abort..."
|
||||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
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)
|
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
|
||||||
targetVer <- liftE $ compileHLS
|
targetVer <- liftE $ compileHLS
|
||||||
targetHLS
|
targetHLS
|
||||||
@ -486,6 +525,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
cabalProject
|
cabalProject
|
||||||
cabalProjectLocal
|
cabalProjectLocal
|
||||||
|
updateCabal
|
||||||
patches
|
patches
|
||||||
cabalArgs
|
cabalArgs
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
@ -519,7 +559,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
(CompileGHC GHCCompileOptions {..}) ->
|
(CompileGHC GHCCompileOptions {..}) ->
|
||||||
runCompileGHC runAppState (do
|
runCompileGHC runAppState (do
|
||||||
case targetGhc of
|
case targetGhc of
|
||||||
Left targetVer -> do
|
GHC.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer GHC dls
|
let vi = getVersionInfo targetVer GHC dls
|
||||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
@ -527,9 +567,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
lift $ logInfo
|
lift $ logInfo
|
||||||
"...waiting for 5 seconds, you can still abort..."
|
"...waiting for 5 seconds, you can still abort..."
|
||||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||||
Right _ -> pure ()
|
_ -> pure ()
|
||||||
targetVer <- liftE $ compileGHC
|
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
|
ovewrwiteVer
|
||||||
bootstrapGhc
|
bootstrapGhc
|
||||||
jobs
|
jobs
|
||||||
|
@ -14,6 +14,8 @@ module Main where
|
|||||||
import BrickMain ( brickMain )
|
import BrickMain ( brickMain )
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
import qualified GHCup.GHC as GHC
|
||||||
|
import qualified GHCup.HLS as HLS
|
||||||
import GHCup.OptParse
|
import GHCup.OptParse
|
||||||
|
|
||||||
import GHCup.Download
|
import GHCup.Download
|
||||||
@ -338,11 +340,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist 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 = Right 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 = HLS.SourceDist tver }))
|
||||||
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||||
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||||
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
|
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
|
||||||
alreadyInstalling _ _ = pure False
|
alreadyInstalling _ _ = pure False
|
||||||
|
@ -202,7 +202,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
|
GHCup always needs to know which version the bindist corresponds to (this is not automatically
|
||||||
detected).
|
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`
|
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.
|
for a list of all available options.
|
||||||
@ -214,6 +216,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).
|
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
|
### Cross support
|
||||||
|
|
||||||
ghcup can compile and install a cross GHC for any target. However, this
|
ghcup can compile and install a cross GHC for any target. However, this
|
||||||
|
@ -33,8 +33,8 @@ module GHCup (
|
|||||||
|
|
||||||
|
|
||||||
import GHCup.Cabal
|
import GHCup.Cabal
|
||||||
import GHCup.GHC
|
import GHCup.GHC hiding ( GHCVer(..) )
|
||||||
import GHCup.HLS
|
import GHCup.HLS hiding ( HLSVer(..) )
|
||||||
import GHCup.Stack
|
import GHCup.Stack
|
||||||
import GHCup.List
|
import GHCup.List
|
||||||
import GHCup.Download
|
import GHCup.Download
|
||||||
@ -206,9 +206,8 @@ rmGhcupDirs = do
|
|||||||
| isWindows = removeDirIfEmptyOrIsSymlink binDir
|
| isWindows = removeDirIfEmptyOrIsSymlink binDir
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
isXDGStyle <- liftIO useXDG
|
isXDGStyle <- liftIO useXDG
|
||||||
if not isXDGStyle
|
when (not isXDGStyle) $
|
||||||
then removeDirIfEmptyOrIsSymlink binDir
|
removeDirIfEmptyOrIsSymlink binDir
|
||||||
else pure ()
|
|
||||||
|
|
||||||
reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
|
reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
|
||||||
reportRemainingFiles dir = do
|
reportRemainingFiles dir = do
|
||||||
|
@ -80,6 +80,12 @@ import qualified Data.Text.Encoding as E
|
|||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
|
|
||||||
|
|
||||||
|
data GHCVer v = SourceDist v
|
||||||
|
| GitDist GitBranch
|
||||||
|
| RemoteDist URI
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
--[ Tool fetching ]--
|
--[ Tool fetching ]--
|
||||||
---------------------
|
---------------------
|
||||||
@ -607,7 +613,7 @@ compileGHC :: ( MonadMask m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Either GHCTargetVersion GitBranch -- ^ version to install
|
=> GHCVer GHCTargetVersion
|
||||||
-> Maybe Version -- ^ overwrite version
|
-> Maybe Version -- ^ overwrite version
|
||||||
-> Either Version FilePath -- ^ version to bootstrap with
|
-> Either Version FilePath -- ^ version to bootstrap with
|
||||||
-> Maybe Int -- ^ jobs
|
-> Maybe Int -- ^ jobs
|
||||||
@ -650,7 +656,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
Left tver -> do
|
SourceDist tver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
@ -671,8 +677,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
pure (workdir, tmpUnpack, tver)
|
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
|
-- clone from git
|
||||||
Right GitBranch{..} -> do
|
GitDist 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
|
||||||
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
|
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
|
||||||
@ -715,14 +744,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
||||||
|
|
||||||
-- bootstrap
|
-- bootstrap
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
tver <- liftE $ getGHCVer tmpUnpack
|
||||||
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))
|
|
||||||
|
|
||||||
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 $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||||
"GHC version (from Makefile): " <> prettyVer tver <>
|
"GHC version (from Makefile): " <> prettyVer tver <>
|
||||||
@ -795,11 +817,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
pure installVer
|
pure installVer
|
||||||
|
|
||||||
where
|
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 =
|
defaultConf =
|
||||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
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")))
|
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||||
in case targetGhc of
|
in case targetGhc of
|
||||||
Left (GHCTargetVersion (Just _) _) -> cross_mk
|
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
|
||||||
_ -> default_mk
|
_ -> default_mk
|
||||||
|
|
||||||
compileHadrianBindist :: ( MonadReader env m
|
compileHadrianBindist :: ( MonadReader env m
|
||||||
@ -976,7 +1016,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
-- for cross, we need Stage1Only
|
-- for cross, we need Stage1Only
|
||||||
case targetGhc of
|
case targetGhc of
|
||||||
Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||||
(InvalidBuildConfig
|
(InvalidBuildConfig
|
||||||
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
[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)
|
import Text.PrettyPrint.HughesPJClass (prettyShow)
|
||||||
|
|
||||||
|
|
||||||
|
data HLSVer = SourceDist Version
|
||||||
|
| GitDist GitBranch
|
||||||
|
| HackageDist Version
|
||||||
|
| RemoteDist URI
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
--[ Installation ]--
|
--[ Installation ]--
|
||||||
@ -324,13 +330,14 @@ compileHLS :: ( MonadMask m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Either Version GitBranch
|
=> HLSVer
|
||||||
-> [Version]
|
-> [Version]
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Either Bool Version
|
-> Either Bool Version
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Maybe (Either FilePath URI)
|
-> Maybe (Either FilePath URI)
|
||||||
-> Maybe URI
|
-> Maybe URI
|
||||||
|
-> Bool
|
||||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
-> [Text] -- ^ additional args to cabal install
|
-> [Text] -- ^ additional args to cabal install
|
||||||
-> Excepts '[ NoDownload
|
-> Excepts '[ NoDownload
|
||||||
@ -343,15 +350,18 @@ compileHLS :: ( MonadMask m
|
|||||||
, BuildFailed
|
, BuildFailed
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] 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
|
PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
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
|
-- unpack from version tarball
|
||||||
Left tver -> do
|
SourceDist tver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
@ -369,10 +379,47 @@ 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, 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
|
-- clone from git
|
||||||
Right GitBranch{..} -> do
|
GitDist 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
|
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||||
@ -409,15 +456,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
then pure Nothing
|
then pure Nothing
|
||||||
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
||||||
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||||
(Just gpd) <- parseGenericPackageDescriptionMaybe
|
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
|
||||||
<$> 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)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
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 not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
||||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
(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
|
-- 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
|
||||||
@ -441,7 +480,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
Right v -> pure v
|
Right v -> pure v
|
||||||
|
|
||||||
liftE $ runBuildAction
|
liftE $ runBuildAction
|
||||||
workdir
|
tmpUnpack
|
||||||
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
|
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
|
||||||
let tmpInstallDir = fromGHCupPath workdir </> "out"
|
let tmpInstallDir = fromGHCupPath workdir </> "out"
|
||||||
liftIO $ createDirRecursive' tmpInstallDir
|
liftIO $ createDirRecursive' tmpInstallDir
|
||||||
@ -457,14 +496,22 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
|
|||||||
pure "cabal.project"
|
pure "cabal.project"
|
||||||
| otherwise -> pure (takeFileName cp)
|
| otherwise -> pure (takeFileName cp)
|
||||||
Just (Right uri) -> do
|
Just (Right uri) -> do
|
||||||
tmpUnpack <- lift withGHCupTmpDir
|
tmpUnpack' <- lift withGHCupTmpDir
|
||||||
cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False
|
cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
|
||||||
copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
|
copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
|
||||||
pure "cabal.project"
|
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
|
forM_ cabalProjectLocal $ \uri -> do
|
||||||
tmpUnpack <- lift withGHCupTmpDir
|
tmpUnpack' <- lift withGHCupTmpDir
|
||||||
cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False
|
cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
|
||||||
copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
|
copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
|
||||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||||
let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
|
let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
|
||||||
@ -658,3 +705,19 @@ rmHLSVer ver = do
|
|||||||
case headMay . reverse . sort $ hlsVers of
|
case headMay . reverse . sort $ hlsVers of
|
||||||
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
||||||
Nothing -> pure ()
|
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
|
||||||
|
@ -654,10 +654,3 @@ isSafeDir (IsolateDirResolved _) = False
|
|||||||
isSafeDir (GHCupDir _) = True
|
isSafeDir (GHCupDir _) = True
|
||||||
isSafeDir (GHCupBinDir _) = False
|
isSafeDir (GHCupBinDir _) = False
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1097,7 +1097,8 @@ runBuildAction bdir action = do
|
|||||||
|
|
||||||
-- | Clean up the given directory if the action fails,
|
-- | Clean up the given directory if the action fails,
|
||||||
-- depending on the Settings.
|
-- depending on the Settings.
|
||||||
cleanUpOnError :: ( MonadReader env m
|
cleanUpOnError :: forall e m a env .
|
||||||
|
( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
|
Loading…
Reference in New Issue
Block a user