Compare commits
1 Commits
Author | SHA1 | Date | |
---|---|---|---|
a3867484cc |
@ -41,6 +41,7 @@ import Data.Aeson ( decodeStrict', Value )
|
|||||||
import Data.Aeson.Encode.Pretty ( encodePretty )
|
import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
|
import Data.Versions (version)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import GHC.IO.Encoding
|
import GHC.IO.Encoding
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@ -341,12 +342,14 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||||
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{ overwriteVer = Just [S over] })) (GHC, ver)
|
||||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
| Right over' <- version (T.pack over) = cmp' GHC (Just $ GHCVersion (mkTVer over')) ver
|
||||||
|
| otherwise = pure False
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
|
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ overwriteVer = Just [S over] })) (HLS, ver)
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion over) ver
|
| Right over' <- version (T.pack over) = cmp' HLS (Just $ ToolVersion over') ver
|
||||||
|
| otherwise = pure False
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
|
||||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
|
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
|
||||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
|
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
|
||||||
|
@ -17,7 +17,6 @@ import GHCup.Platform
|
|||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import GHCup.Utils.URI
|
|
||||||
import GHCup.Prelude
|
import GHCup.Prelude
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
@ -78,7 +77,6 @@ import qualified Cabal.Config as CC
|
|||||||
--[ Types ]--
|
--[ Types ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
|
|
||||||
-- a superset of ToolVersion
|
-- a superset of ToolVersion
|
||||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||||
| SetToolVersion Version
|
| SetToolVersion Version
|
||||||
@ -314,6 +312,29 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
overWriteVersionParser :: String -> Either String [VersionPattern]
|
||||||
|
overWriteVersionParser = first (const "Not a valid version pattern") . MP.parse (MP.many versionPattern <* MP.eof) "" . T.pack
|
||||||
|
where
|
||||||
|
versionPattern :: MP.Parsec Void Text VersionPattern
|
||||||
|
versionPattern = do
|
||||||
|
str' <- T.unpack <$> MP.takeWhileP Nothing (/= '%')
|
||||||
|
if str' /= mempty
|
||||||
|
then pure (S str')
|
||||||
|
else fmap (const CabalVer) v_cabal
|
||||||
|
<|> fmap (const GitBranchName) b_name
|
||||||
|
<|> fmap (const GitHashShort) s_hash
|
||||||
|
<|> fmap (const GitHashLong) l_hash
|
||||||
|
<|> fmap (const GitDescribe) g_desc
|
||||||
|
<|> ((\a b -> S (a : T.unpack b)) <$> MP.satisfy (const True) <*> MP.takeWhileP Nothing (== '%')) -- invalid pattern, e.g. "%k"
|
||||||
|
where
|
||||||
|
v_cabal = MP.chunk "%v"
|
||||||
|
b_name = MP.chunk "%b"
|
||||||
|
s_hash = MP.chunk "%h"
|
||||||
|
l_hash = MP.chunk "%H"
|
||||||
|
g_desc = MP.chunk "%g"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
--[ Completers ]--
|
--[ Completers ]--
|
||||||
------------------
|
------------------
|
||||||
|
@ -36,7 +36,7 @@ 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 )
|
||||||
import Options.Applicative.Help.Pretty ( text )
|
import Options.Applicative.Help.Pretty ( text, vsep )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
|
||||||
@ -74,7 +74,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, crossTarget :: Maybe Text
|
, crossTarget :: Maybe Text
|
||||||
, addConfArgs :: [Text]
|
, addConfArgs :: [Text]
|
||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Maybe Version
|
, overwriteVer :: Maybe [VersionPattern]
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, buildSystem :: Maybe BuildSystem
|
, buildSystem :: Maybe BuildSystem
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
@ -86,7 +86,7 @@ data HLSCompileOptions = HLSCompileOptions
|
|||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, updateCabal :: Bool
|
, updateCabal :: Bool
|
||||||
, ovewrwiteVer :: Either Bool Version
|
, overwriteVer :: Maybe [VersionPattern]
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, cabalProject :: Maybe (Either FilePath URI)
|
, cabalProject :: Maybe (Either FilePath URI)
|
||||||
, cabalProjectLocal :: Maybe URI
|
, cabalProjectLocal :: Maybe URI
|
||||||
@ -155,8 +155,8 @@ Examples:
|
|||||||
Examples:
|
Examples:
|
||||||
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
||||||
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
||||||
# compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
|
# compile from master for ghc 9.2.3, appending the short git commit hash to the version and ignore the pinned index state
|
||||||
ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
|
ghcup compile hls -g master -o '%v-%h' --ghc 9.2.3 -- --index-state=@(date '+%s')
|
||||||
# compile a specific commit for ghc 9.2.3 and set a specific version for the binary name
|
# compile a specific commit for ghc 9.2.3 and set a specific 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|]
|
||||||
|
|
||||||
@ -253,11 +253,16 @@ ghcCompileOpts =
|
|||||||
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
|
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader
|
(eitherReader overWriteVersionParser
|
||||||
(first (const "Not a valid version") . version . T.pack)
|
|
||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
||||||
"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'"
|
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
||||||
|
, text "%v version"
|
||||||
|
, text "%b branch name"
|
||||||
|
, text "%h short commit hash"
|
||||||
|
, text "%H long commit hash"
|
||||||
|
, text "%g 'git describe' output"
|
||||||
|
])
|
||||||
<> (completer $ versionCompleter [] GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -343,19 +348,25 @@ hlsCompileOpts =
|
|||||||
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
||||||
<*>
|
<*>
|
||||||
(
|
(
|
||||||
(Right <$> option
|
optional (option
|
||||||
(eitherReader
|
(eitherReader overWriteVersionParser
|
||||||
(first (const "Not a valid version") . version . T.pack)
|
|
||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
||||||
"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'"
|
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
||||||
|
, text "%v version from cabal file"
|
||||||
|
, text "%b branch name"
|
||||||
|
, text "%h short commit hash"
|
||||||
|
, text "%H long commit hash"
|
||||||
|
, text "%g 'git describe' output"
|
||||||
|
])
|
||||||
<> (completer $ versionCompleter [] HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
<|>
|
||||||
(Left <$> (switch
|
((\b -> if b then Just [GitDescribe] else Nothing) <$> (switch
|
||||||
(long "git-describe-version"
|
(long "git-describe-version"
|
||||||
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
|
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
|
||||||
|
<> internal
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -529,7 +540,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
targetHLS
|
targetHLS
|
||||||
ghcs
|
ghcs
|
||||||
jobs
|
jobs
|
||||||
ovewrwiteVer
|
overwriteVer
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
cabalProject
|
cabalProject
|
||||||
cabalProjectLocal
|
cabalProjectLocal
|
||||||
@ -576,7 +587,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
targetVer <- liftE $ compileGHC
|
targetVer <- liftE $ compileGHC
|
||||||
targetGhc
|
targetGhc
|
||||||
crossTarget
|
crossTarget
|
||||||
ovewrwiteVer
|
overwriteVer
|
||||||
bootstrapGhc
|
bootstrapGhc
|
||||||
jobs
|
jobs
|
||||||
buildConfig
|
buildConfig
|
||||||
|
@ -807,7 +807,7 @@ compileGHC :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> GHCVer
|
=> GHCVer
|
||||||
-> Maybe Text -- ^ cross target
|
-> Maybe Text -- ^ cross target
|
||||||
-> Maybe Version -- ^ overwrite version
|
-> Maybe [VersionPattern]
|
||||||
-> Either Version FilePath -- ^ version to bootstrap with
|
-> Either Version FilePath -- ^ version to bootstrap with
|
||||||
-> Maybe Int -- ^ jobs
|
-> Maybe Int -- ^ jobs
|
||||||
-> Maybe FilePath -- ^ build config
|
-> Maybe FilePath -- ^ build config
|
||||||
@ -843,12 +843,12 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||||
= do
|
= do
|
||||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver, ov) <- case targetGhc of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
SourceDist ver -> do
|
SourceDist ver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||||
@ -870,7 +870,11 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern (Just ver) "" "" "" "" vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
|
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver), ov)
|
||||||
|
|
||||||
RemoteDist uri -> do
|
RemoteDist uri -> do
|
||||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||||
@ -894,13 +898,17 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern tver "" "" "" "" vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
|
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
GitDist 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, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
|
(tver, ov) <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
|
||||||
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.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" ]
|
||||||
@ -932,6 +940,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
then pure Nothing
|
then pure Nothing
|
||||||
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
||||||
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||||
|
branch <- liftE $ gitOut ["rev-parse", "--abbrev-ref", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||||
|
|
||||||
-- clone submodules
|
-- clone submodules
|
||||||
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
||||||
@ -949,9 +958,19 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
||||||
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
pure tver
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern
|
||||||
|
tver
|
||||||
|
(take 7 $ T.unpack chash)
|
||||||
|
(T.unpack chash)
|
||||||
|
(maybe "" T.unpack git_describe)
|
||||||
|
(T.unpack branch)
|
||||||
|
vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
pure (tver, ov)
|
||||||
|
|
||||||
|
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
|
||||||
-- 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 <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||||
@ -1091,7 +1110,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
compileHadrianBindist tver workdir ghcdir = do
|
compileHadrianBindist tver workdir ghcdir = do
|
||||||
liftE $ configureBindist tver workdir ghcdir
|
liftE $ configureBindist tver workdir ghcdir
|
||||||
|
|
||||||
lift $ logInfo "Building (this may take a while)..."
|
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
|
||||||
hadrian_build <- liftE $ findHadrianFile workdir
|
hadrian_build <- liftE $ findHadrianFile workdir
|
||||||
lEM $ execLogged hadrian_build
|
lEM $ execLogged hadrian_build
|
||||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||||
@ -1163,7 +1182,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
|
|
||||||
liftE $ checkBuildConfig (build_mk workdir)
|
liftE $ checkBuildConfig (build_mk workdir)
|
||||||
|
|
||||||
lift $ logInfo "Building (this may take a while)..."
|
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
|
||||||
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
||||||
|
|
||||||
if | isCross tver -> do
|
if | isCross tver -> do
|
||||||
|
@ -335,7 +335,7 @@ compileHLS :: ( MonadMask m
|
|||||||
=> HLSVer
|
=> HLSVer
|
||||||
-> [Version]
|
-> [Version]
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Either Bool Version
|
-> Maybe [VersionPattern]
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Maybe (Either FilePath URI)
|
-> Maybe (Either FilePath URI)
|
||||||
-> Maybe URI
|
-> Maybe URI
|
||||||
@ -353,7 +353,7 @@ compileHLS :: ( MonadMask m
|
|||||||
, BuildFailed
|
, BuildFailed
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
@ -362,7 +362,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
lift $ logInfo "Updating cabal DB"
|
lift $ logInfo "Updating cabal DB"
|
||||||
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
|
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
|
(workdir, tmpUnpack, tver, ov) <- case targetHLS of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
SourceDist tver -> do
|
SourceDist tver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
||||||
@ -382,7 +382,11 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
(liftE . intoSubdir tmpUnpack)
|
(liftE . intoSubdir tmpUnpack)
|
||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, tver, Nothing)
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
|
pure (workdir, tmpUnpack, tver, ov)
|
||||||
|
|
||||||
HackageDist tver -> do
|
HackageDist tver -> do
|
||||||
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
|
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
|
||||||
@ -396,7 +400,11 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack hls
|
let workdir = appendGHCupPath tmpUnpack hls
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, tver, Nothing)
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
|
pure (workdir, tmpUnpack, tver, ov)
|
||||||
|
|
||||||
RemoteDist uri -> do
|
RemoteDist uri -> do
|
||||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||||
@ -419,7 +427,11 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
|
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, tver, Nothing)
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
|
pure (workdir, tmpUnpack, tver, ov)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
GitDist GitBranch{..} -> do
|
GitDist GitBranch{..} -> do
|
||||||
@ -459,28 +471,31 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
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)
|
||||||
|
branch <- gitOut ["rev-parse", "--abbrev-ref", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||||
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
|
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
|
||||||
|
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||||
|
|
||||||
|
ov <- case vps of
|
||||||
|
Just vps' -> fmap Just $ expandVersionPattern
|
||||||
|
(Just tver)
|
||||||
|
(take 7 $ T.unpack chash)
|
||||||
|
(T.unpack chash)
|
||||||
|
(maybe "" T.unpack git_describe)
|
||||||
|
(T.unpack branch)
|
||||||
|
vps'
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
|
||||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||||
"HLS version (from cabal file): " <> prettyVer tver <>
|
"HLS version (from cabal file): " <> prettyVer tver <>
|
||||||
|
"\n branch: " <> branch <>
|
||||||
(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, tmpUnpack, tver, ov)
|
||||||
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
|
||||||
installVer <- case ov of
|
installVer <- maybe (pure tver) pure 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
|
||||||
tmpUnpack
|
tmpUnpack
|
||||||
@ -558,9 +573,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
|
|
||||||
pure installVer
|
pure installVer
|
||||||
where
|
where
|
||||||
gitDescribeRequested = case ov of
|
gitDescribeRequested = maybe False (GitDescribe `elem`) vps
|
||||||
Left b -> b
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
@ -777,3 +777,13 @@ instance Pretty ToolVersion where
|
|||||||
data BuildSystem = Hadrian
|
data BuildSystem = Hadrian
|
||||||
| Make
|
| Make
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
|
data VersionPattern = CabalVer
|
||||||
|
| GitHashShort
|
||||||
|
| GitHashLong
|
||||||
|
| GitDescribe
|
||||||
|
| GitBranchName
|
||||||
|
| S String
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
@ -1275,3 +1275,29 @@ processBranches str' = let lines' = lines (T.unpack str')
|
|||||||
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
|
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
|
||||||
in branches
|
in branches
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
------------------
|
||||||
|
--[ Versioning ]--
|
||||||
|
------------------
|
||||||
|
|
||||||
|
|
||||||
|
expandVersionPattern :: MonadFail m
|
||||||
|
=> Maybe Version -- ^ cabal ver
|
||||||
|
-> String -- ^ git hash (short), if any
|
||||||
|
-> String -- ^ git hash (long), if any
|
||||||
|
-> String -- ^ git describe output, if any
|
||||||
|
-> String -- ^ git branch name, if any
|
||||||
|
-> [VersionPattern]
|
||||||
|
-> m Version
|
||||||
|
expandVersionPattern cabalVer gitHashS gitHashL gitDescribe gitBranch
|
||||||
|
= either (fail . displayException) pure . version . T.pack . go
|
||||||
|
where
|
||||||
|
go [] = ""
|
||||||
|
go (CabalVer:xs) = T.unpack (maybe "" prettyVer cabalVer) <> go xs
|
||||||
|
go (GitHashShort:xs) = gitHashS <> go xs
|
||||||
|
go (GitHashLong:xs) = gitHashL <> go xs
|
||||||
|
go (GitDescribe:xs) = gitDescribe <> go xs
|
||||||
|
go (GitBranchName:xs) = gitBranch <> go xs
|
||||||
|
go (S str:xs) = str <> go xs
|
||||||
|
|
||||||
|
@ -47,7 +47,7 @@ mkDefaultHLSCompileOptions target ghcs =
|
|||||||
Nothing
|
Nothing
|
||||||
True
|
True
|
||||||
False
|
False
|
||||||
(Left False)
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
@ -91,8 +91,8 @@ compileGhcCheckList = mapSecond CompileGHC
|
|||||||
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
|
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
|
||||||
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
|
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
|
||||||
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
|
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
|
||||||
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
|
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.overwriteVer = Just [S "9.4.5-p1"]})
|
||||||
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
|
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.overwriteVer = Just [S "9.4.5-p1"]})
|
||||||
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
|
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
|
||||||
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
|
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
|
||||||
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
|
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
|
||||||
@ -158,9 +158,9 @@ compileHlsCheckList = mapSecond CompileHLS
|
|||||||
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
|
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
|
||||||
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
|
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
|
||||||
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
|
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
|
||||||
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
|
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.overwriteVer = Just [S "2.0.0.0-p1"]})
|
||||||
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
|
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.overwriteVer = Just [S "2.0.0.0-p1"]})
|
||||||
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
|
, (baseCmd <> "--git-describe-version", baseOptions{HLS.overwriteVer = Just [GitDescribe]})
|
||||||
#ifdef IS_WINDOWS
|
#ifdef IS_WINDOWS
|
||||||
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||||
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||||
|
Loading…
Reference in New Issue
Block a user