module Darcs.Patch.Bundle
( makeBundleN
, scanBundle
, contextPatches
, scanContextFile
, patchFilename
, minContext
) where
import Prelude ()
import Darcs.Prelude
import Data.Char ( isAlpha, toLower, isDigit, isSpace )
import qualified Data.ByteString as B ( ByteString, length, null, drop,
isPrefixOf )
import qualified Data.ByteString.Char8 as BC ( unpack, break, pack )
import Darcs.Util.Tree( Tree )
import Darcs.Util.Tree.Monad( virtualTreeIO )
import Darcs.Patch ( RepoPatch, showPatch, showContextPatch,
readPatchPartial )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Bracketed ( Bracketed, unBracketedFL )
import Darcs.Patch.Bracketed.Instances ()
import Darcs.Patch.Commute( commute )
import Darcs.Patch.Depends ( slightlyOptimizePatchset )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo,
displayPatchInfo, isTag )
import Darcs.Patch.Named.Wrapped ( WrappedNamed )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, piap, fmapFLPIAP, info,
patchInfoAndPatch, unavailable, hopefully,
generaliseRepoTypePIAP
)
import Darcs.Patch.ReadMonads ( parseStrictly )
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, Origin )
import Darcs.Patch.Show ( ShowPatchBasic, ShowPatchFor(ForStorage) )
import Darcs.Patch.Witnesses.Ordered
( RL(..), FL(..), (:>)(..), reverseFL, (+<+),
mapFL, mapFL_FL, mapRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Util.ByteString
( mmapFilePS, linesPS, unlinesPS, dropSpace, substrPS, decodeLocale )
import Darcs.Util.Hash ( sha1PS )
import Darcs.Util.Printer ( Doc, renderPS, newline, text, ($$),
vcat, vsep, renderString )
hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (WrappedNamed rt p) wX wY
-> String
hashBundle :: FL (WrappedNamed rt p) wX wY -> String
hashBundle to_be_sent :: FL (WrappedNamed rt p) wX wY
to_be_sent =
SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> SHA1
sha1PS (ByteString -> SHA1) -> ByteString -> SHA1
forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS (Doc -> ByteString) -> Doc -> ByteString
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ((forall wW wZ. WrappedNamed rt p wW wZ -> Doc)
-> FL (WrappedNamed rt p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> WrappedNamed rt p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL (WrappedNamed rt p) wX wY
to_be_sent) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
newline
makeBundleN :: (ApplyState p ~ Tree, RepoPatch p) => Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (WrappedNamed rt p) wX wY -> IO Doc
makeBundleN :: Maybe (Tree IO)
-> PatchSet rt p wStart wX
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN the_s :: Maybe (Tree IO)
the_s (PatchSet (_ :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ _) ps :: RL (PatchInfoAnd rt p) wX wX
ps) to_be_sent :: FL (WrappedNamed rt p) wX wY
to_be_sent =
Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wY wX
-> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wStart wX
-> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundle2 Maybe (Tree IO)
the_s ((RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t) RL (PatchInfoAnd rt p) wY wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
ps) FL (WrappedNamed rt p) wX wY
to_be_sent FL (WrappedNamed rt p) wX wY
to_be_sent
makeBundleN the_s :: Maybe (Tree IO)
the_s (PatchSet NilRL ps :: RL (PatchInfoAnd rt p) wX wX
ps) to_be_sent :: FL (WrappedNamed rt p) wX wY
to_be_sent =
Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wX wX
-> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wStart wX
-> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundle2 Maybe (Tree IO)
the_s RL (PatchInfoAnd rt p) wX wX
ps FL (WrappedNamed rt p) wX wY
to_be_sent FL (WrappedNamed rt p) wX wY
to_be_sent
makeBundle2 :: (ApplyState p ~ Tree, RepoPatch p) => Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wStart wX -> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY -> IO Doc
makeBundle2 :: Maybe (Tree IO)
-> RL (PatchInfoAnd rt p) wStart wX
-> FL (WrappedNamed rt p) wX wY
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundle2 the_s :: Maybe (Tree IO)
the_s common' :: RL (PatchInfoAnd rt p) wStart wX
common' to_be_sent :: FL (WrappedNamed rt p) wX wY
to_be_sent to_be_sent2 :: FL (WrappedNamed rt p) wX wY
to_be_sent2 = do
Doc
patches <- case Maybe (Tree IO)
the_s of
Just tree :: Tree IO
tree -> (Doc, Tree IO) -> Doc
forall a b. (a, b) -> a
fst ((Doc, Tree IO) -> Doc) -> IO (Doc, Tree IO) -> IO Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeIO Doc -> Tree IO -> IO (Doc, Tree IO)
forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO (ShowPatchFor -> FL (WrappedNamed rt p) wX wY -> TreeIO Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
ForStorage FL (WrappedNamed rt p) wX wY
to_be_sent) Tree IO
tree
Nothing -> Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. WrappedNamed rt p wW wZ -> Doc)
-> FL (WrappedNamed rt p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> WrappedNamed rt p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL (WrappedNamed rt p) wX wY
to_be_sent)
Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
format Doc
patches
where
format :: Doc -> Doc
format the_new :: Doc
the_new = String -> Doc
text ""
Doc -> Doc -> Doc
$$ String -> Doc
text "New patches:"
Doc -> Doc -> Doc
$$ String -> Doc
text ""
Doc -> Doc -> Doc
$$ Doc
the_new
Doc -> Doc -> Doc
$$ String -> Doc
text ""
Doc -> Doc -> Doc
$$ String -> Doc
text "Context:"
Doc -> Doc -> Doc
$$ String -> Doc
text ""
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
ForStorage) [PatchInfo]
common)
Doc -> Doc -> Doc
$$ String -> Doc
text "Patch bundle hash:"
Doc -> Doc -> Doc
$$ String -> Doc
text (FL (WrappedNamed rt p) wX wY -> String
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(PatchListFormat p, ShowPatchBasic p) =>
FL (WrappedNamed rt p) wX wY -> String
hashBundle FL (WrappedNamed rt p) wX wY
to_be_sent2)
Doc -> Doc -> Doc
$$ String -> Doc
text ""
common :: [PatchInfo]
common = (forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd rt p) wStart wX -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info RL (PatchInfoAnd rt p) wStart wX
common'
parseBundle :: forall rt p. RepoPatch p => B.ByteString
-> Either String
(Sealed ((PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin))
parseBundle :: ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
parseBundle input :: ByteString
input | ByteString -> Bool
B.null ByteString
input = String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. a -> Either a b
Left "Bad patch bundle!"
parseBundle input :: ByteString
input = case ByteString -> (String, ByteString)
sillyLex ByteString
input of
("New patches:", rest :: ByteString
rest) -> case ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any),
ByteString)
forall (p :: * -> * -> *) wX.
RepoPatch p =>
ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
getPatches ByteString
rest of
(Sealed bracketedPatches :: FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
bracketedPatches, rest' :: ByteString
rest') -> case ByteString -> (String, ByteString)
sillyLex ByteString
rest' of
("Context:", rest'' :: ByteString
rest'') -> case ByteString -> ([PatchInfo], ByteString)
getContext ByteString
rest'' of
(cont :: [PatchInfo]
cont, maybe_hash :: ByteString
maybe_hash) ->
let sealedCtxAndPs :: Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
sealedCtxAndPs = [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall wX wY a.
[PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
sealCtxAndPs [PatchInfo]
cont FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
bracketedPatches in
case ByteString -> ByteString -> Maybe Int
substrPS (String -> ByteString
BC.pack "Patch bundle hash:") ByteString
maybe_hash of
Just n :: Int
n ->
let hPs :: FL (WrappedNamed ('RepoType 'NoRebase) (Bracketed p)) Any wX
hPs = (forall wW wY.
PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wW wY)
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
-> FL (WrappedNamed ('RepoType 'NoRebase) (Bracketed p)) Any wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY.
PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
bracketedPatches
realHash :: String
realHash = FL (WrappedNamed ('RepoType 'NoRebase) (Bracketed p)) Any wX
-> String
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(PatchListFormat p, ShowPatchBasic p) =>
FL (WrappedNamed rt p) wX wY -> String
hashBundle FL (WrappedNamed ('RepoType 'NoRebase) (Bracketed p)) Any wX
hPs
getHash :: ByteString -> String
getHash = (String, ByteString) -> String
forall a b. (a, b) -> a
fst ((String, ByteString) -> String)
-> (ByteString -> (String, ByteString)) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (String, ByteString)
sillyLex (ByteString -> (String, ByteString))
-> (ByteString -> ByteString) -> ByteString -> (String, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((String, ByteString) -> ByteString)
-> (ByteString -> (String, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (String, ByteString)
sillyLex
bundleHash :: String
bundleHash = ByteString -> String
getHash (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
n ByteString
maybe_hash in
if String
realHash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bundleHash
then Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a.
Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
sealedCtxAndPs
else String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. a -> Either a b
Left String
hashFailureMessage
Nothing -> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a.
Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
sealedCtxAndPs
(a :: String
a, r :: ByteString
r) -> String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. a -> Either a b
Left (String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)))
-> String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. (a -> b) -> a -> b
$ "Malformed patch bundle: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' is not 'Context:'\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack ByteString
r
("Context:", rest :: ByteString
rest) -> case ByteString -> ([PatchInfo], ByteString)
getContext ByteString
rest of
(cont :: [PatchInfo]
cont, rest' :: ByteString
rest') -> case ByteString -> (String, ByteString)
sillyLex ByteString
rest' of
("New patches:", rest'' :: ByteString
rest'') -> case ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any),
ByteString)
forall (p :: * -> * -> *) wX.
RepoPatch p =>
ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
getPatches ByteString
rest'' of
(Sealed bracketedPatches :: FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
bracketedPatches, _) ->
Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. b -> Either a b
Right (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)))
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. (a -> b) -> a -> b
$ [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall wX wY.
[PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
sealContextWithPatches [PatchInfo]
cont FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) Any wX
bracketedPatches
(a :: String
a, _) -> String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. a -> Either a b
Left (String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)))
-> String
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. (a -> b) -> a -> b
$ "Malformed patch bundle: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' is not 'New patches:'"
("-----BEGIN PGP SIGNED MESSAGE-----",rest :: ByteString
rest) ->
ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
RepoPatch p =>
ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
parseBundle (ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)))
-> ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
filterGpgDashes ByteString
rest
(_, rest :: ByteString
rest) -> ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
RepoPatch p =>
ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
parseBundle ByteString
rest
where
hashFailureMessage :: String
hashFailureMessage = "Patch bundle failed hash!\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "This probably means that the patch has been "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "corrupted by a mailer.\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "The most likely culprit is CRLF newlines."
sealCtxAndPs :: [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
sealCtxAndPs ctx :: [PatchInfo]
ctx ps :: FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
ps = Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. b -> Either a b
Right (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)))
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
-> Either
a (Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall a b. (a -> b) -> a -> b
$ [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall wX wY.
[PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
sealContextWithPatches [PatchInfo]
ctx FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
ps
sealContextWithPatches :: [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Sealed
((PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin)
sealContextWithPatches :: [PatchInfo]
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
sealContextWithPatches context :: [PatchInfo]
context bracketedPatches :: FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
bracketedPatches =
let
notRebasing :: p -> a
notRebasing _
= String -> a
forall a. HasCallStack => String -> a
error "internal error: unreachable case (Darcs.Patch.Bundle.parseBundle.notRebasing)"
patches :: FL (PatchInfoAnd rt p) wX wY
patches = (forall wW wY.
PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> PatchInfoAnd rt p wW wY)
-> FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
-> FL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (PatchInfoAnd ('RepoType 'NoRebase) p wW wY
-> PatchInfoAnd rt p wW wY
forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfoAnd ('RepoType 'NoRebase) p wA wB
-> PatchInfoAnd rt p wA wB
generaliseRepoTypePIAP (PatchInfoAnd ('RepoType 'NoRebase) p wW wY
-> PatchInfoAnd rt p wW wY)
-> (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> PatchInfoAnd ('RepoType 'NoRebase) p wW wY)
-> PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> PatchInfoAnd rt p wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FL (Bracketed p) wW wY -> FL p wW wY)
-> ((RebaseTypeOf ('RepoType 'NoRebase) :~~: 'IsRebase)
-> Bracketed p :~: p)
-> PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wW wY
-> PatchInfoAnd ('RepoType 'NoRebase) p wW wY
forall (p :: * -> * -> *) wX wY (q :: * -> * -> *)
(rt :: RepoType).
(FL p wX wY -> FL q wX wY)
-> ((RebaseTypeOf rt :~~: 'IsRebase) -> p :~: q)
-> PatchInfoAnd rt p wX wY
-> PatchInfoAnd rt q wX wY
fmapFLPIAP FL (Bracketed p) wW wY -> FL p wW wY
forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL (RebaseTypeOf ('RepoType 'NoRebase) :~~: 'IsRebase)
-> Bracketed p :~: p
forall p a. p -> a
notRebasing)
FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wY
bracketedPatches
in
case [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse [PatchInfo]
context of
(x :: PatchInfo
x : ry :: [PatchInfo]
ry) | PatchInfo -> Bool
isTag PatchInfo
x ->
let ps :: RL (PatchInfoAnd rt p) wX wY
ps = [PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches ([PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse [PatchInfo]
ry)
t :: Tagged rt p wY wZ
t = PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wY wY
-> Tagged rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged (PatchInfo -> PatchInfoAnd rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfo -> PatchInfoAnd rt p wX wY
piUnavailable PatchInfo
x) Maybe String
forall a. Maybe a
Nothing RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL in
(:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin Any
-> RL (PatchInfoAnd rt p) Any wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet (RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (Tagged rt p) Origin Origin
-> Tagged rt p Origin Any -> RL (Tagged rt p) Origin Any
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: Tagged rt p Origin Any
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ. Tagged rt p wY wZ
t) RL (PatchInfoAnd rt p) Any wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (PatchInfoAnd rt p) wX wY
ps PatchSet rt p Origin wX
-> FL (PatchInfoAnd rt p) wX wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType). FL (PatchInfoAnd rt p) wX wY
patches
_ -> let ps :: PatchSet rt p wX wY
ps = RL (Tagged rt p) wX wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL ([PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches [PatchInfo]
context) in
(:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY
ps PatchSet rt p Origin wX
-> FL (PatchInfoAnd rt p) wX wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType). FL (PatchInfoAnd rt p) wX wY
patches
scanBundle :: forall rt p . RepoPatch p => B.ByteString
-> Either String (SealedPatchSet rt p Origin)
scanBundle :: ByteString -> Either String (SealedPatchSet rt p Origin)
scanBundle bundle :: ByteString
bundle = do
Sealed (PatchSet tagged :: RL (Tagged rt p) Origin wX
tagged recent :: RL (PatchInfoAnd rt p) wX wZ
recent :> ps :: FL (PatchInfoAnd rt p) wZ wX
ps) <- ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
forall (rt :: RepoType) (p :: * -> * -> *).
RepoPatch p =>
ByteString
-> Either
String
(Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin))
parseBundle ByteString
bundle
SealedPatchSet rt p Origin
-> Either String (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet rt p Origin
-> Either String (SealedPatchSet rt p Origin))
-> (PatchSet rt p Origin wX -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin wX
-> Either String (SealedPatchSet rt p Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (PatchSet rt p Origin wX
-> Either String (SealedPatchSet rt p Origin))
-> PatchSet rt p Origin wX
-> Either String (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wX
tagged (RL (PatchInfoAnd rt p) wX wZ
recent RL (PatchInfoAnd rt p) wX wZ
-> RL (PatchInfoAnd rt p) wZ wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ FL (PatchInfoAnd rt p) wZ wX -> RL (PatchInfoAnd rt p) wZ wX
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wZ wX
ps)
filterGpgDashes :: B.ByteString -> B.ByteString
filterGpgDashes :: ByteString -> ByteString
filterGpgDashes ps :: ByteString
ps =
[ByteString] -> ByteString
unlinesPS ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
drop_dashes ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
(ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> ByteString
BC.pack "-----END PGP SIGNED MESSAGE-----") ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
(ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ByteString -> Bool
not_context_or_newpatches ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
linesPS ByteString
ps
where
drop_dashes :: ByteString -> ByteString
drop_dashes x :: ByteString
x
| ByteString -> Int
B.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = ByteString
x
| String -> ByteString
BC.pack "- " ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
x = Int -> ByteString -> ByteString
B.drop 2 ByteString
x
| Bool
otherwise = ByteString
x
not_context_or_newpatches :: ByteString -> Bool
not_context_or_newpatches s :: ByteString
s = (ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> ByteString
BC.pack "Context:") Bool -> Bool -> Bool
&&
(ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> ByteString
BC.pack "New patches:")
unavailablePatches :: [PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches :: [PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches = (PatchInfo
-> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY)
-> RL (PatchInfoAnd rt p) wX wY
-> [PatchInfo]
-> RL (PatchInfoAnd rt p) wX wY
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wX wY)
-> PatchInfoAnd rt p wY wY
-> RL (PatchInfoAnd rt p) wX wY
-> RL (PatchInfoAnd rt p) wX wY
forall a b c. (a -> b -> c) -> b -> a -> c
flip RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
(:<:) (PatchInfoAnd rt p wY wY
-> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY)
-> (PatchInfo -> PatchInfoAnd rt p wY wY)
-> PatchInfo
-> RL (PatchInfoAnd rt p) wX wY
-> RL (PatchInfoAnd rt p) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> PatchInfoAnd rt p wY wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfo -> PatchInfoAnd rt p wX wY
piUnavailable) (RL (PatchInfoAnd rt p) Any Any -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RL (PatchInfoAnd rt p) Any Any
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL)
piUnavailable :: PatchInfo -> PatchInfoAnd rt p wX wY
piUnavailable :: PatchInfo -> PatchInfoAnd rt p wX wY
piUnavailable i :: PatchInfo
i = PatchInfo
-> Hopefully (WrappedNamed rt p) wX wY -> PatchInfoAnd rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo
-> Hopefully (WrappedNamed rt p) wA wB -> PatchInfoAnd rt p wA wB
patchInfoAndPatch PatchInfo
i (Hopefully (WrappedNamed rt p) wX wY -> PatchInfoAnd rt p wX wY)
-> (String -> Hopefully (WrappedNamed rt p) wX wY)
-> String
-> PatchInfoAnd rt p wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Hopefully (WrappedNamed rt p) wX wY
forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable (String -> PatchInfoAnd rt p wX wY)
-> String -> PatchInfoAnd rt p wX wY
forall a b. (a -> b) -> a -> b
$
"Patch not stored in patch bundle:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
i)
getContext :: B.ByteString -> ([PatchInfo],B.ByteString)
getContext :: ByteString -> ([PatchInfo], ByteString)
getContext ps :: ByteString
ps = case SM PatchInfo -> ByteString -> Maybe (PatchInfo, ByteString)
forall a. SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly SM PatchInfo
forall (m :: * -> *). ParserM m => m PatchInfo
readPatchInfo ByteString
ps of
Just (pinfo :: PatchInfo
pinfo, r' :: ByteString
r') -> case ByteString -> ([PatchInfo], ByteString)
getContext ByteString
r' of
(pis :: [PatchInfo]
pis, r'' :: ByteString
r'') -> (PatchInfo
pinfo PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: [PatchInfo]
pis, ByteString
r'')
Nothing -> ([], ByteString
ps)
(-:-) :: a wX wY -> (Sealed (FL a wY), b) -> (Sealed (FL a wX), b)
p :: a wX wY
p -:- :: a wX wY -> (Sealed (FL a wY), b) -> (Sealed (FL a wX), b)
-:- (Sealed ps :: FL a wY wX
ps, r :: b
r) = (FL a wX wX -> Sealed (FL a wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (a wX wY
p a wX wY -> FL a wY wX -> FL a wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL a wY wX
ps), b
r)
getPatches :: RepoPatch p => B.ByteString
-> (Sealed (FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX), B.ByteString)
getPatches :: ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
getPatches ps :: ByteString
ps = case SM PatchInfo -> ByteString -> Maybe (PatchInfo, ByteString)
forall a. SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly SM PatchInfo
forall (m :: * -> *). ParserM m => m PatchInfo
readPatchInfo ByteString
ps of
Nothing -> (FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wX
-> Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL, ByteString
ps)
Just (pinfo :: PatchInfo
pinfo, _) -> case ByteString
-> Maybe
(Sealed (WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wX),
ByteString)
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Maybe (Sealed (p wX), ByteString)
readPatchPartial ByteString
ps of
Nothing -> (FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wX
-> Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL, ByteString
ps)
Just (Sealed p :: WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wX wX
p, r :: ByteString
r) -> (PatchInfo
pinfo PatchInfo
-> WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wX wX
-> PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfo -> WrappedNamed rt p wA wB -> PatchInfoAnd rt p wA wB
`piap` WrappedNamed ('RepoType 'NoRebase) (Bracketed p) wX wX
p) PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p) wX wX
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
forall (a :: * -> * -> *) wX wY b.
a wX wY -> (Sealed (FL a wY), b) -> (Sealed (FL a wX), b)
-:- ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
forall (p :: * -> * -> *) wX.
RepoPatch p =>
ByteString
-> (Sealed
(FL (PatchInfoAnd ('RepoType 'NoRebase) (Bracketed p)) wX),
ByteString)
getPatches ByteString
r
sillyLex :: B.ByteString -> (String, B.ByteString)
sillyLex :: ByteString -> (String, ByteString)
sillyLex ps :: ByteString
ps = (ByteString -> String
decodeLocale ByteString
a, ByteString
b)
where
(a :: ByteString
a, b :: ByteString
b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n') (ByteString -> ByteString
dropSpace ByteString
ps)
contextPatches :: PatchSet rt p Origin wX
-> (PatchSet rt p :> RL (PatchInfoAnd rt p)) Origin wX
contextPatches :: PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
contextPatches set :: PatchSet rt p Origin wX
set = case PatchSet rt p Origin wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> PatchSet rt p wStart wX
slightlyOptimizePatchset PatchSet rt p Origin wX
set of
PatchSet (ts :: RL (Tagged rt p) Origin wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps' :: RL (PatchInfoAnd rt p) wY wY
ps') ps :: RL (PatchInfoAnd rt p) wX wX
ps ->
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wY
ts RL (PatchInfoAnd rt p) wY wY
ps' PatchSet rt p Origin wY
-> RL (PatchInfoAnd rt p) wY wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> ((RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t) RL (PatchInfoAnd rt p) wY wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
ps)
PatchSet NilRL ps :: RL (PatchInfoAnd rt p) wX wX
ps -> RL (Tagged rt p) wX wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p wX wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL PatchSet rt p wX wX
-> RL (PatchInfoAnd rt p) wX wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wX wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wX wX
ps
scanContextFile :: FilePath -> IO (PatchSet rt p Origin wX)
scanContextFile :: String -> IO (PatchSet rt p Origin wX)
scanContextFile filename :: String
filename = ByteString -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX.
ByteString -> PatchSet rt p Origin wX
scanContext (ByteString -> PatchSet rt p Origin wX)
-> IO ByteString -> IO (PatchSet rt p Origin wX)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO ByteString
mmapFilePS String
filename
where
scanContext :: B.ByteString -> PatchSet rt p Origin wX
scanContext :: ByteString -> PatchSet rt p Origin wX
scanContext input :: ByteString
input
| ByteString -> Bool
B.null ByteString
input = String -> PatchSet rt p Origin wX
forall a. HasCallStack => String -> a
error "Bad context!"
| Bool
otherwise = case ByteString -> (String, ByteString)
sillyLex ByteString
input of
("Context:",rest :: ByteString
rest) -> case ByteString -> ([PatchInfo], ByteString)
getContext ByteString
rest of
(cont :: [PatchInfo]
cont@(_ : _), _) | PatchInfo -> Bool
isTag ([PatchInfo] -> PatchInfo
forall a. [a] -> a
last [PatchInfo]
cont) ->
let ps :: RL (PatchInfoAnd rt p) wX wY
ps = [PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches ([PatchInfo] -> RL (PatchInfoAnd rt p) wX wY)
-> [PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
forall a b. (a -> b) -> a -> b
$ [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
init [PatchInfo]
cont
t :: Tagged rt p wY wZ
t = PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wY wY
-> Tagged rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged (PatchInfo -> PatchInfoAnd rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfo -> PatchInfoAnd rt p wX wY
piUnavailable (PatchInfo -> PatchInfoAnd rt p wY wZ)
-> PatchInfo -> PatchInfoAnd rt p wY wZ
forall a b. (a -> b) -> a -> b
$ [PatchInfo] -> PatchInfo
forall a. [a] -> a
last [PatchInfo]
cont) Maybe String
forall a. Maybe a
Nothing RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL in
RL (Tagged rt p) Origin Any
-> RL (PatchInfoAnd rt p) Any wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet (RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (Tagged rt p) Origin Origin
-> Tagged rt p Origin Any -> RL (Tagged rt p) Origin Any
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: Tagged rt p Origin Any
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ. Tagged rt p wY wZ
t) RL (PatchInfoAnd rt p) Any wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (PatchInfoAnd rt p) wX wY
ps
(cont :: [PatchInfo]
cont, _) -> RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL ([PatchInfo] -> RL (PatchInfoAnd rt p) Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> RL (PatchInfoAnd rt p) wX wY
unavailablePatches [PatchInfo]
cont)
("-----BEGIN PGP SIGNED MESSAGE-----",rest :: ByteString
rest) ->
ByteString -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX.
ByteString -> PatchSet rt p Origin wX
scanContext (ByteString -> PatchSet rt p Origin wX)
-> ByteString -> PatchSet rt p Origin wX
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
filterGpgDashes ByteString
rest
(_, rest :: ByteString
rest) -> ByteString -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX.
ByteString -> PatchSet rt p Origin wX
scanContext ByteString
rest
minContext :: (RepoPatch p)
=> PatchSet rt p wStart wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed ((PatchSet rt p :> FL (PatchInfoAnd rt p)) wStart)
minContext :: PatchSet rt p wStart wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart)
minContext (PatchSet behindTag :: RL (Tagged rt p) wStart wX
behindTag topCommon :: RL (PatchInfoAnd rt p) wX wB
topCommon) to_be_sent :: FL (PatchInfoAnd rt p) wB wC
to_be_sent =
case RL (PatchInfoAnd rt p) wX wB
-> FL (PatchInfoAnd rt p) wB wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB wC wD.
RepoPatch p =>
RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
go RL (PatchInfoAnd rt p) wX wB
topCommon FL (PatchInfoAnd rt p) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (PatchInfoAnd rt p) wB wC
to_be_sent of
Sealed (c :: RL (PatchInfoAnd rt p) wX wZ
c :> to_be_sent' :: FL (PatchInfoAnd rt p) wZ wX
to_be_sent') -> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wZ -> PatchSet rt p wStart wZ
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
behindTag RL (PatchInfoAnd rt p) wX wZ
c PatchSet rt p wStart wZ
-> FL (PatchInfoAnd rt p) wZ wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wZ wX
to_be_sent')
where
go :: (RepoPatch p)
=> RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed (( RL (PatchInfoAnd rt p) :> FL (PatchInfoAnd rt p) ) wA )
go :: RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
go NilRL necessary :: FL (PatchInfoAnd rt p) wB wC
necessary to_be_sent' :: FL (PatchInfoAnd rt p) wC wD
to_be_sent' = (:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wB wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wB)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL (PatchInfoAnd rt p) wB wC -> RL (PatchInfoAnd rt p) wB wC
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wB wC
necessary RL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> (:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wB wD
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wC wD
to_be_sent')
go (rest :: RL (PatchInfoAnd rt p) wA wY
rest :<: candidate :: PatchInfoAnd rt p wY wB
candidate) necessary :: FL (PatchInfoAnd rt p) wB wC
necessary to_be_sent' :: FL (PatchInfoAnd rt p) wC wD
to_be_sent' =
let fl1 :: FL (PatchInfoAnd rt p) wY wB
fl1 = (PatchInfoAnd rt p wY wB
candidate PatchInfoAnd rt p wY wB
-> FL (PatchInfoAnd rt p) wB wB -> FL (PatchInfoAnd rt p) wY wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd rt p) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) in
case (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wY wC
-> Maybe
((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wY wC)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PatchInfoAnd rt p) wY wB
fl1 FL (PatchInfoAnd rt p) wY wB
-> FL (PatchInfoAnd rt p) wB wC
-> (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wY wC
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wB wC
necessary) of
Nothing -> RL (PatchInfoAnd rt p) wA wY
-> FL (PatchInfoAnd rt p) wY wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB wC wD.
RepoPatch p =>
RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
go RL (PatchInfoAnd rt p) wA wY
rest (PatchInfoAnd rt p wY wB
candidate PatchInfoAnd rt p wY wB
-> FL (PatchInfoAnd rt p) wB wC -> FL (PatchInfoAnd rt p) wY wC
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd rt p) wB wC
necessary) FL (PatchInfoAnd rt p) wC wD
to_be_sent'
Just (necessary' :: FL (PatchInfoAnd rt p) wY wZ
necessary' :> fl1' :: FL (PatchInfoAnd rt p) wZ wC
fl1') ->
case (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wD
-> Maybe
((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wD)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PatchInfoAnd rt p) wZ wC
fl1' FL (PatchInfoAnd rt p) wZ wC
-> FL (PatchInfoAnd rt p) wC wD
-> (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wD
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wC wD
to_be_sent') of
Nothing -> RL (PatchInfoAnd rt p) wA wY
-> FL (PatchInfoAnd rt p) wY wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB wC wD.
RepoPatch p =>
RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
go RL (PatchInfoAnd rt p) wA wY
rest (PatchInfoAnd rt p wY wB
candidate PatchInfoAnd rt p wY wB
-> FL (PatchInfoAnd rt p) wB wC -> FL (PatchInfoAnd rt p) wY wC
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd rt p) wB wC
necessary) FL (PatchInfoAnd rt p) wC wD
to_be_sent'
Just (to_be_sent'' :: FL (PatchInfoAnd rt p) wZ wZ
to_be_sent'' :> _) ->
RL (PatchInfoAnd rt p) wA wY
-> FL (PatchInfoAnd rt p) wY wZ
-> FL (PatchInfoAnd rt p) wZ wZ
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
forall (p :: * -> * -> *) (rt :: RepoType) wA wB wC wD.
RepoPatch p =>
RL (PatchInfoAnd rt p) wA wB
-> FL (PatchInfoAnd rt p) wB wC
-> FL (PatchInfoAnd rt p) wC wD
-> Sealed
((:>) (RL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wA)
go RL (PatchInfoAnd rt p) wA wY
rest FL (PatchInfoAnd rt p) wY wZ
necessary' FL (PatchInfoAnd rt p) wZ wZ
to_be_sent''
patchFilename :: String -> String
patchFilename :: String -> String
patchFilename the_summary :: String
the_summary = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".dpatch"
where
name :: String
name = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
safeFileChar String
the_summary
safeFileChar :: Char -> Char
safeFileChar c :: Char
c | Char -> Bool
isAlpha Char
c = Char -> Char
toLower Char
c
| Char -> Bool
isDigit Char
c = Char
c
| Char -> Bool
isSpace Char
c = '-'
safeFileChar _ = '_'