Allow to apply patches for compiling from source

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 _ ->

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

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
+
 
 
     -------------------------

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