Skip to content
Snippets Groups Projects
Unverified Commit f8548fef authored by James Hobson's avatar James Hobson
Browse files

Added support for quilt series files when patching

parent 7fab328a
No related branches found
No related tags found
1 merge request!230Quilt patch support
...@@ -879,20 +879,27 @@ makeOut args workdir = do ...@@ -879,20 +879,27 @@ makeOut args workdir = do
executeOut mymake args workdir executeOut mymake args workdir
-- | Try to apply patches in order. Fails with 'PatchFailed' -- | Try to apply patches in order. The order is determined by
-- on first failure. -- a quilt series file (in the patch directory) if one exists,
-- else the patches are applied in lexicographical order.
-- Fails with 'PatchFailed' on first failure.
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m) applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ dir containing patches => FilePath -- ^ dir containing patches
-> FilePath -- ^ dir to apply patches in -> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m () -> Excepts '[PatchFailed] m ()
applyPatches pdir ddir = do applyPatches pdir ddir = do
patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles seriesExists <- liftIO (doesFileExist (pdir </> "series"))
pdir patches <- if seriesExists
(makeRegexOpts compExtended then
execBlank liftIO $ map (pdir </>) . lines <$> readFile (pdir </> "series")
([s|.+\.(patch|diff)$|] :: ByteString) else
) (fmap . fmap) (pdir </>) $ liftIO $ sort <$> findFiles
forM_ (sort patches) $ \patch' -> applyPatch patch' ddir pdir
(makeRegexOpts compExtended
execBlank
([s|.+\.(patch|diff)$|] :: ByteString)
)
forM_ patches $ \patch' -> applyPatch patch' ddir
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m) applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment