diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index a2210c3..627f424 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -111,6 +111,7 @@ data CompileOptions = CompileOptions , bootstrapGhc :: Either Version (Path Abs) , jobs :: Maybe Int , buildConfig :: Maybe (Path Abs) + , patchDir :: Maybe (Path Abs) } data UpgradeOpts = UpgradeInplace @@ -342,6 +343,19 @@ compileOpts = "Absolute path to build config file" ) ) + <*> optional + (option + (eitherReader + (\x -> + bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help + "Absolute path to patch directory (applied in order, uses -p1)" + ) + ) versionParser :: Parser Version @@ -564,6 +578,7 @@ main = do , DigestError , GHCupSetError , NoDownload + , PatchFailed , UnknownArchive , DownloadFailed ] @@ -577,6 +592,7 @@ main = do , NoDownload , DigestError , BuildFailed + , PatchFailed , DownloadFailed ] @@ -698,7 +714,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues void $ (runCompileGHC $ do liftE - $ compileGHC dls targetVer bootstrapGhc jobs buildConfig + $ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir ) >>= \case VRight _ -> @@ -719,7 +735,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues Compile (CompileCabal CompileOptions {..}) -> void $ (runCompileCabal $ do - liftE $ compileCabal dls targetVer bootstrapGhc jobs + liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir ) >>= \case VRight _ -> diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 1c0ab24..8f32580 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -435,6 +435,7 @@ compileGHC :: ( MonadMask m -> Either Version (Path Abs) -- ^ version to bootstrap with -> Maybe Int -- ^ jobs -> Maybe (Path Abs) -- ^ build config + -> Maybe (Path Abs) -> Excepts '[ AlreadyInstalled , BuildFailed @@ -442,11 +443,12 @@ compileGHC :: ( MonadMask m , DownloadFailed , GHCupSetError , NoDownload + , PatchFailed , UnknownArchive ] m () -compileGHC dls tver bstrap jobs mbuildConfig = do +compileGHC dls tver bstrap jobs mbuildConfig patchdir = do lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|] whenM (liftIO $ toolAlreadyInstalled GHC tver) (throwE $ AlreadyInstalled GHC tver) @@ -497,12 +499,18 @@ GhcWithLlvmCodeGen = YES|] -> Path Abs -> Path Abs -> Excepts - '[NoDownload , FileDoesNotExistError , ProcessError] + '[ NoDownload + , FileDoesNotExistError + , PatchFailed + , ProcessError + ] m () compile bghc ghcdir workdir = do lift $ $(logInfo) [i|configuring build|] + forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir + -- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD) newEnv <- addToCurrentEnv [("LD", "ld.bfd")] @@ -563,16 +571,18 @@ compileCabal :: ( MonadReader Settings m -> Version -- ^ version to install -> Either Version (Path Abs) -- ^ version to bootstrap with -> Maybe Int + -> Maybe (Path Abs) -> Excepts '[ BuildFailed , DigestError , DownloadFailed , NoDownload + , PatchFailed , UnknownArchive ] m () -compileCabal dls tver bghc jobs = do +compileCabal dls tver bghc jobs patchdir = do lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|] -- download source tarball @@ -595,10 +605,12 @@ compileCabal dls tver bghc jobs = do where compile :: (MonadThrow m, MonadLogger m, MonadIO m) => Path Abs - -> Excepts '[ProcessError] m () + -> Excepts '[ProcessError , PatchFailed] m () compile workdir = do lift $ $(logInfo) [i|Building (this may take a while)...|] + forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir + ghcEnv <- case bghc of Right path -> do -- recover the version from /foo/ghc-6.5.4 diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index a479ed5..d0d590e 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -88,6 +88,10 @@ data NoLocationHeader = NoLocationHeader data TooManyRedirs = TooManyRedirs deriving Show +-- | A patch could not be applied. +data PatchFailed = PatchFailed + deriving Show + ------------------------- diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 69992b0..592db4b 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -334,3 +334,23 @@ make args workdir = do has_gmake <- isJust <$> searchPath spaths [rel|gmake|] let mymake = if has_gmake then "gmake" else "make" execLogged mymake True args [rel|ghc-make|] workdir Nothing + + +-- | Try to apply patches in order. Fails with 'PatchFailed' +-- on first failure. +applyPatches :: (MonadLogger m, MonadIO m) + => Path Abs -- ^ dir containing patches + -> Path Abs -- ^ dir to apply patches in + -> Excepts '[PatchFailed] m () +applyPatches pdir ddir = do + patches <- liftIO $ getDirsFiles pdir + forM_ (sort patches) $ \patch' -> do + lift $ $(logInfo) [i|Applying patch #{patch'}|] + (fmap (either (const Nothing) Just) $ liftIO $ exec + "patch" + True + ["-p1", "-i", toFilePath patch'] + (Just ddir) + Nothing + ) + !? PatchFailed