Compare commits
11 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
a9630d0802
|
|||
|
c5c6c431b5
|
|||
|
71d78d2d72
|
|||
|
ccecda2eff
|
|||
|
3a5f8d6139
|
|||
|
74e0f39bc2
|
|||
|
274978a8a7
|
|||
|
8eea9bd6a5
|
|||
|
626a2dd020
|
|||
|
6b6ce221e0
|
|||
|
d038c361c0
|
@@ -89,6 +89,18 @@ toolVersionArgument criteria tool =
|
|||||||
mv _ = "VERSION|TAG"
|
mv _ = "VERSION|TAG"
|
||||||
|
|
||||||
|
|
||||||
|
toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||||
|
toolVersionOption criteria tool =
|
||||||
|
option (eitherReader toolVersionEither)
|
||||||
|
( sh tool
|
||||||
|
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||||
|
<> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
where
|
||||||
|
sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG"
|
||||||
|
sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG"
|
||||||
|
sh _ = long "version" <> metavar "VERSION|TAG"
|
||||||
|
|
||||||
|
|
||||||
versionParser :: Parser GHCTargetVersion
|
versionParser :: Parser GHCTargetVersion
|
||||||
versionParser = option
|
versionParser = option
|
||||||
(eitherReader tVersionEither)
|
(eitherReader tVersionEither)
|
||||||
@@ -196,8 +208,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
|||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
bindistParser :: String -> Either String URI
|
uriParser :: String -> Either String URI
|
||||||
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||||
|
|
||||||
|
|
||||||
absolutePathParser :: FilePath -> Either String FilePath
|
absolutePathParser :: FilePath -> Either String FilePath
|
||||||
@@ -246,18 +258,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
|||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
|
||||||
toolVersionParser :: Parser ToolVersion
|
|
||||||
toolVersionParser = verP' <|> toolP
|
|
||||||
where
|
|
||||||
verP' = ToolVersion <$> versionParser
|
|
||||||
toolP =
|
|
||||||
ToolTag
|
|
||||||
<$> option
|
|
||||||
(eitherReader tagEither)
|
|
||||||
(short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
keepOnParser :: String -> Either String KeepDirs
|
keepOnParser :: String -> Either String KeepDirs
|
||||||
keepOnParser s' | t == T.pack "always" = Right Always
|
keepOnParser s' | t == T.pack "always" = Right Always
|
||||||
|
|||||||
@@ -40,6 +40,7 @@ import Prelude hiding ( appendFile )
|
|||||||
import System.Exit
|
import System.Exit
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
|
|
||||||
|
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)
|
||||||
import System.FilePath (isPathSeparator)
|
import System.FilePath (isPathSeparator)
|
||||||
@@ -68,7 +69,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, bootstrapGhc :: Either Version FilePath
|
, bootstrapGhc :: Either Version FilePath
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, buildConfig :: Maybe FilePath
|
, buildConfig :: Maybe FilePath
|
||||||
, patchDir :: Maybe FilePath
|
, patches :: Maybe (Either FilePath [URI])
|
||||||
, crossTarget :: Maybe Text
|
, crossTarget :: Maybe Text
|
||||||
, addConfArgs :: [Text]
|
, addConfArgs :: [Text]
|
||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
@@ -84,10 +85,11 @@ data HLSCompileOptions = HLSCompileOptions
|
|||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, cabalProject :: Maybe FilePath
|
, cabalProject :: Maybe (Either FilePath URI)
|
||||||
, cabalProjectLocal :: Maybe FilePath
|
, cabalProjectLocal :: Maybe URI
|
||||||
, patchDir :: Maybe FilePath
|
, patches :: Maybe (Either FilePath [URI])
|
||||||
, targetGHCs :: [ToolVersion]
|
, targetGHCs :: [ToolVersion]
|
||||||
|
, cabalArgs :: [Text]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -148,7 +150,10 @@ Examples:
|
|||||||
These need to be available in PATH prior to compilation.
|
These need to be available in PATH prior to compilation.
|
||||||
|
|
||||||
Examples:
|
Examples:
|
||||||
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
|
# compile 1.4.0 for ghc 8.10.5 and 8.10.7
|
||||||
|
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
|
||||||
|
# compile from master for ghc 8.10.7, linking everything dynamically
|
||||||
|
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
|
||||||
|
|
||||||
|
|
||||||
ghcCompileOpts :: Parser GHCCompileOptions
|
ghcCompileOpts :: Parser GHCCompileOptions
|
||||||
@@ -195,13 +200,23 @@ ghcCompileOpts =
|
|||||||
"Absolute path to build config file"
|
"Absolute path to build config file"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> (optional
|
||||||
(option
|
(
|
||||||
str
|
(fmap Right $ many $ option
|
||||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
(eitherReader uriParser)
|
||||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
(long "patch" <> metavar "PATCH_URI" <> help
|
||||||
|
"URI to a patch (https/http/file)"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<|>
|
||||||
|
(fmap Left $ option
|
||||||
|
str
|
||||||
|
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||||
|
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
str
|
str
|
||||||
@@ -296,26 +311,37 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
str
|
((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
|
||||||
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
(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."
|
"If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader absolutePathParser)
|
(eitherReader uriParser)
|
||||||
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
(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."
|
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> (optional
|
||||||
(option
|
(
|
||||||
(eitherReader absolutePathParser)
|
(fmap Right $ many $ option
|
||||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
(eitherReader uriParser)
|
||||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
(long "patch" <> metavar "PATCH_URI" <> help
|
||||||
|
"URI to a patch (https/http/file)"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<|>
|
||||||
|
(fmap Left $ option
|
||||||
|
str
|
||||||
|
(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))
|
)
|
||||||
|
<*> some (toolVersionOption Nothing (Just GHC))
|
||||||
|
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -430,7 +456,8 @@ compile compileCommand settings runAppState runLogger = do
|
|||||||
isolateDir
|
isolateDir
|
||||||
cabalProject
|
cabalProject
|
||||||
cabalProjectLocal
|
cabalProjectLocal
|
||||||
patchDir
|
patches
|
||||||
|
cabalArgs
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo targetVer HLS dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
@@ -477,7 +504,7 @@ compile compileCommand settings runAppState runLogger = do
|
|||||||
bootstrapGhc
|
bootstrapGhc
|
||||||
jobs
|
jobs
|
||||||
buildConfig
|
buildConfig
|
||||||
patchDir
|
patches
|
||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
hadrian
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ import Options.Applicative.Help.Pretty ( text )
|
|||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import URI.ByteString
|
import URI.ByteString hiding ( uriParser )
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
@@ -187,7 +187,7 @@ installOpts tool =
|
|||||||
<*> ( ( (,)
|
<*> ( ( (,)
|
||||||
<$> optional
|
<$> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader bindistParser)
|
(eitherReader uriParser)
|
||||||
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
||||||
"Install the specified version from this bindist"
|
"Install the specified version from this bindist"
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -110,7 +110,7 @@ library
|
|||||||
, disk-free-space ^>=0.1.0.1
|
, disk-free-space ^>=0.1.0.1
|
||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, haskus-utils-types ^>=1.5
|
, haskus-utils-types ^>=1.5
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant ^>=3.2.1
|
||||||
, libarchive ^>=3.0.3.0
|
, libarchive ^>=3.0.3.0
|
||||||
, lzma-static ^>=5.2.5.3
|
, lzma-static ^>=5.2.5.3
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
@@ -227,7 +227,7 @@ executable ghcup
|
|||||||
, directory ^>=1.3.6.0
|
, directory ^>=1.3.6.0
|
||||||
, filepath ^>=1.4.2.1
|
, filepath ^>=1.4.2.1
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-variant >=3.0 && <3.2
|
, haskus-utils-variant ^>=3.2.1
|
||||||
, libarchive ^>=3.0.3.0
|
, libarchive ^>=3.0.3.0
|
||||||
, megaparsec >=8.0.0 && <9.1
|
, megaparsec >=8.0.0 && <9.1
|
||||||
, mtl ^>=2.2
|
, mtl ^>=2.2
|
||||||
|
|||||||
91
lib/GHCup.hs
91
lib/GHCup.hs
@@ -62,7 +62,7 @@ import Data.String ( fromString )
|
|||||||
import Data.Text ( Text )
|
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 hiding ( patch )
|
||||||
import Distribution.Types.Version hiding ( Version )
|
import Distribution.Types.Version hiding ( Version )
|
||||||
import Distribution.Types.PackageId
|
import Distribution.Types.PackageId
|
||||||
import Distribution.Types.PackageDescription
|
import Distribution.Types.PackageDescription
|
||||||
@@ -84,6 +84,7 @@ import System.IO.Error
|
|||||||
import System.IO.Temp
|
import System.IO.Temp
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
|
import URI.ByteString
|
||||||
|
|
||||||
import qualified Crypto.Hash.SHA256 as SHA256
|
import qualified Crypto.Hash.SHA256 as SHA256
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
@@ -750,9 +751,10 @@ compileHLS :: ( MonadMask m
|
|||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Maybe Version
|
-> Maybe Version
|
||||||
-> Maybe FilePath
|
-> Maybe FilePath
|
||||||
-> Maybe FilePath
|
-> Maybe (Either FilePath URI)
|
||||||
-> Maybe FilePath
|
-> Maybe URI
|
||||||
-> Maybe FilePath
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
|
-> [Text] -- ^ additional args to cabal install
|
||||||
-> Excepts '[ NoDownload
|
-> Excepts '[ NoDownload
|
||||||
, GPGError
|
, GPGError
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
@@ -763,11 +765,12 @@ compileHLS :: ( MonadMask m
|
|||||||
, BuildFailed
|
, BuildFailed
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do
|
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal 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
|
||||||
|
|
||||||
|
|
||||||
(workdir, tver) <- case targetHLS of
|
(workdir, tver) <- case targetHLS of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
Left tver -> do
|
Left tver -> do
|
||||||
@@ -834,48 +837,51 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
|||||||
liftE $ runBuildAction
|
liftE $ runBuildAction
|
||||||
workdir
|
workdir
|
||||||
Nothing
|
Nothing
|
||||||
(reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
|
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
|
||||||
let installDir = workdir </> "out"
|
let installDir = workdir </> "out"
|
||||||
liftIO $ createDirRecursive' installDir
|
liftIO $ createDirRecursive' installDir
|
||||||
|
|
||||||
-- apply patches
|
-- apply patches
|
||||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
liftE $ applyAnyPatch patches workdir
|
||||||
|
|
||||||
-- set up project files
|
-- set up project files
|
||||||
cp <- case cabalProject of
|
cp <- case cabalProject of
|
||||||
Just cp
|
Just (Left cp)
|
||||||
| isAbsolute cp -> do
|
| isAbsolute cp -> do
|
||||||
copyFileE cp (workdir </> "cabal.project")
|
copyFileE cp (workdir </> "cabal.project")
|
||||||
pure "cabal.project"
|
pure "cabal.project"
|
||||||
| otherwise -> pure (takeFileName cp)
|
| otherwise -> pure (takeFileName cp)
|
||||||
|
Just (Right uri) -> do
|
||||||
|
tmpUnpack <- lift withGHCupTmpDir
|
||||||
|
cp <- liftE $ download uri Nothing Nothing tmpUnpack (Just "cabal.project") False
|
||||||
|
copyFileE cp (workdir </> "cabal.project")
|
||||||
|
pure "cabal.project"
|
||||||
Nothing -> pure "cabal.project"
|
Nothing -> pure "cabal.project"
|
||||||
forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local")
|
forM_ cabalProjectLocal $ \uri -> do
|
||||||
|
tmpUnpack <- lift withGHCupTmpDir
|
||||||
let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"]
|
cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
|
||||||
|
copyFileE cpl (workdir </> cp <.> "local")
|
||||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||||
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
|
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
|
||||||
liftIO $ createDirRecursive' ghcInstallDir
|
liftIO $ createDirRecursive' installDir
|
||||||
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
|
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
|
||||||
liftE $ lEM @_ @'[ProcessError] $
|
liftE $ lEM @_ @'[ProcessError] $
|
||||||
execLogged "cabal" ( [ "v2-build"
|
execLogged "cabal" ( [ "v2-install"
|
||||||
, "-w"
|
, "-w"
|
||||||
, "ghc-" <> T.unpack (prettyVer ghc)
|
, "ghc-" <> T.unpack (prettyVer ghc)
|
||||||
|
, "--install-method=copy"
|
||||||
] ++
|
] ++
|
||||||
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
|
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
|
||||||
[ "--project-file=" <> cp
|
[ "--overwrite-policy=always"
|
||||||
] ++ targets
|
, "--disable-profiling"
|
||||||
|
, "--disable-tests"
|
||||||
|
, "--installdir=" <> ghcInstallDir
|
||||||
|
, "--project-file=" <> cp
|
||||||
|
] ++ fmap T.unpack cabalArgs ++ [
|
||||||
|
"exe:haskell-language-server"
|
||||||
|
, "exe:haskell-language-server-wrapper"]
|
||||||
)
|
)
|
||||||
(Just workdir) "cabal" Nothing
|
(Just workdir) "cabal" Nothing
|
||||||
forM_ targets $ \target -> do
|
|
||||||
let cabal = "cabal"
|
|
||||||
args = ["list-bin", target]
|
|
||||||
CapturedProcess{..} <- lift $ executeOut cabal args (Just workdir)
|
|
||||||
case _exitCode of
|
|
||||||
ExitFailure i -> throwE (NonZeroExit i cabal args)
|
|
||||||
_ -> pure ()
|
|
||||||
let cbin = stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
|
||||||
copyFileE cbin (ghcInstallDir </> takeFileName cbin)
|
|
||||||
pure ghcInstallDir
|
pure ghcInstallDir
|
||||||
|
|
||||||
forM_ artifacts $ \artifact -> do
|
forM_ artifacts $ \artifact -> do
|
||||||
@@ -1102,7 +1108,7 @@ setGHC ver sghc = do
|
|||||||
pure $ Just (file <> "-" <> verS)
|
pure $ Just (file <> "-" <> verS)
|
||||||
|
|
||||||
-- create symlink
|
-- create symlink
|
||||||
forM mTargetFile $ \targetFile -> do
|
forM_ mTargetFile $ \targetFile -> do
|
||||||
let fullF = binDir </> targetFile <> exeExt
|
let fullF = binDir </> targetFile <> exeExt
|
||||||
fileWithExt = file <> exeExt
|
fileWithExt = file <> exeExt
|
||||||
destL <- lift $ ghcLinkDestination fileWithExt ver
|
destL <- lift $ ghcLinkDestination fileWithExt ver
|
||||||
@@ -2090,7 +2096,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> 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
|
||||||
-> Maybe FilePath -- ^ patch directory
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Bool
|
||||||
@@ -2119,7 +2125,7 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
|
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
@@ -2143,7 +2149,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
workdir <- maybe (pure tmpUnpack)
|
workdir <- maybe (pure tmpUnpack)
|
||||||
(liftE . intoSubdir tmpUnpack)
|
(liftE . intoSubdir tmpUnpack)
|
||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
liftE $ applyAnyPatch patches workdir
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, tver)
|
pure (workdir, tmpUnpack, tver)
|
||||||
|
|
||||||
@@ -2151,7 +2157,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
Right GitBranch{..} -> do
|
Right GitBranch{..} -> do
|
||||||
tmpUnpack <- lift mkGhcupTmpDir
|
tmpUnpack <- lift mkGhcupTmpDir
|
||||||
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
|
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
|
||||||
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH] DownloadFailed $ do
|
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, 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" ]
|
||||||
@@ -2171,7 +2177,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
|
|
||||||
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
||||||
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
||||||
forM_ patchdir (\dir -> liftE $ applyPatches dir tmpUnpack)
|
liftE $ applyAnyPatch patches tmpUnpack
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap"
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
CapturedProcess {..} <- lift $ makeOut
|
||||||
@@ -2505,6 +2511,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
execWithGhcEnv :: ( MonadReader env m
|
execWithGhcEnv :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
=> FilePath -- ^ thing to execute
|
=> FilePath -- ^ thing to execute
|
||||||
@@ -2845,3 +2852,25 @@ rmTmp = do
|
|||||||
let p = tmpdir </> f
|
let p = tmpdir </> f
|
||||||
logDebug $ "rm -rf " <> T.pack p
|
logDebug $ "rm -rf " <> T.pack p
|
||||||
rmPathForcibly p
|
rmPathForcibly p
|
||||||
|
|
||||||
|
|
||||||
|
applyAnyPatch :: ( MonadReader env m
|
||||||
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
|
, HasSettings env
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadCatch m
|
||||||
|
, MonadResource m
|
||||||
|
, MonadThrow m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadIO m)
|
||||||
|
=> Maybe (Either FilePath [URI])
|
||||||
|
-> FilePath
|
||||||
|
-> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
|
||||||
|
applyAnyPatch Nothing _ = pure ()
|
||||||
|
applyAnyPatch (Just (Left pdir)) workdir = liftE $ applyPatches pdir workdir
|
||||||
|
applyAnyPatch (Just (Right uris)) workdir = do
|
||||||
|
tmpUnpack <- lift withGHCupTmpDir
|
||||||
|
forM_ uris $ \uri -> do
|
||||||
|
patch <- liftE $ download uri Nothing Nothing tmpUnpack Nothing False
|
||||||
|
liftE $ applyPatch patch workdir
|
||||||
|
|||||||
@@ -67,7 +67,7 @@ import Data.List
|
|||||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions hiding ( patch )
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
@@ -856,6 +856,7 @@ make :: ( MonadThrow m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
)
|
)
|
||||||
=> [String]
|
=> [String]
|
||||||
@@ -891,15 +892,22 @@ applyPatches pdir ddir = do
|
|||||||
execBlank
|
execBlank
|
||||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||||
)
|
)
|
||||||
forM_ (sort patches) $ \patch' -> do
|
forM_ (sort patches) $ \patch' -> applyPatch patch' ddir
|
||||||
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
|
||||||
fmap (either (const Nothing) Just)
|
|
||||||
(exec
|
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||||
"patch"
|
=> FilePath -- ^ Patch
|
||||||
["-p1", "-i", patch']
|
-> FilePath -- ^ dir to apply patches in
|
||||||
(Just ddir)
|
-> Excepts '[PatchFailed] m ()
|
||||||
Nothing)
|
applyPatch patch ddir = do
|
||||||
!? PatchFailed
|
lift $ logInfo $ "Applying patch " <> T.pack patch
|
||||||
|
fmap (either (const Nothing) Just)
|
||||||
|
(exec
|
||||||
|
"patch"
|
||||||
|
["-p1", "-s", "-f", "-i", patch]
|
||||||
|
(Just ddir)
|
||||||
|
Nothing)
|
||||||
|
!? PatchFailed
|
||||||
|
|
||||||
|
|
||||||
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
|
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
|
||||||
|
|||||||
@@ -73,6 +73,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
|||||||
|
|
||||||
execLogged :: ( MonadReader env m
|
execLogged :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
|
, HasLog env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
@@ -85,6 +86,7 @@ execLogged :: ( MonadReader env m
|
|||||||
execLogged exe args chdir lfile env = do
|
execLogged exe args chdir lfile env = do
|
||||||
Settings {..} <- getSettings
|
Settings {..} <- getSettings
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
|
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||||
let logfile = logsDir </> lfile <> ".log"
|
let logfile = logsDir </> lfile <> ".log"
|
||||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||||
closeFd
|
closeFd
|
||||||
|
|||||||
@@ -18,6 +18,7 @@ module GHCup.Utils.File.Windows where
|
|||||||
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
|
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
|
||||||
import GHCup.Utils.Dirs
|
import GHCup.Utils.Dirs
|
||||||
import GHCup.Utils.File.Common
|
import GHCup.Utils.File.Common
|
||||||
|
import GHCup.Utils.Logger
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
|
|
||||||
@@ -40,6 +41,7 @@ import qualified Control.Exception as EX
|
|||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -149,6 +151,7 @@ executeOut path args chdir = do
|
|||||||
|
|
||||||
execLogged :: ( MonadReader env m
|
execLogged :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
@@ -160,6 +163,7 @@ execLogged :: ( MonadReader env m
|
|||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
execLogged exe args chdir lfile env = do
|
execLogged exe args chdir lfile env = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
|
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||||
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
|
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
|
||||||
stderrLogfile = logsDir </> lfile <> ".stderr.log"
|
stderrLogfile = logsDir </> lfile <> ".stderr.log"
|
||||||
cp <- createProcessWithMingwPath ((proc exe args)
|
cp <- createProcessWithMingwPath ((proc exe args)
|
||||||
|
|||||||
@@ -16,7 +16,6 @@ extra-deps:
|
|||||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
||||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||||
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
|
||||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||||
@@ -40,6 +39,11 @@ extra-deps:
|
|||||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||||
- yaml-streamly-0.12.0
|
- yaml-streamly-0.12.0
|
||||||
|
|
||||||
|
- git: https://github.com/hasufell/packages.git
|
||||||
|
commit: cc0b4688f8bb374fa92f17c856949de795b56291
|
||||||
|
subdirs:
|
||||||
|
- haskus-utils-variant
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
http-io-streams:
|
http-io-streams:
|
||||||
brotli: false
|
brotli: false
|
||||||
|
|||||||
Reference in New Issue
Block a user