Thanks, applying with some minor remarks about the haddock comments.
hunk ./src/Darcs/Patch/Bundle.hs 60
> import Storage.Hashed.Tree( Tree )
> import Storage.Hashed.Monad( virtualTreeIO )
>
> -hashBundle :: (PatchListFormat p, ShowPatchBasic p) => [PatchInfo] ->
FL (Named p) C(x y) -> String
> -hashBundle _ to_be_sent = sha1PS $ renderPS
> +-- |hashBundle creates a SHA1 string of a given a FL of named
patches. This
> +-- allows us to ensure that the patches in a received patchBundle
have not been
> +-- modified in transit.
> +hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (Named p)
C(x y) -> String
> +hashBundle to_be_sent = sha1PS $ renderPS
> $ vcat (mapFL showPatch to_be_sent) <> newline
>
> makeBundleN :: RepoPatch p => Maybe (Tree IO)
Ok.
hunk ./src/Darcs/Patch/Bundle.hs 95
> $$ text ""
> $$ (vcat $ map showPatchInfo common)
> $$ text "Patch bundle hash:"
> - $$ text (hashBundle common to_be_sent2)
> + $$ text (hashBundle to_be_sent2)
> $$ text ""
> common = mapRL info common'
>
Ok.
hunk ./src/Darcs/Patch/Bundle.hs 116
> case substrPS (BC.pack "Patch bundle hash:")
> maybe_hash of
> Just n ->
> - if hashBundle cont (mapFL_FL hopefully
patchesBraced)
> + if hashBundle (mapFL_FL hopefully patchesBraced)
> == fst (sillyLex $ snd $ sillyLex $
> B.drop n maybe_hash)
> then Right $ seal_up_patches patches cont
Ok.
Tidy up, and add most Haddocks for Darcs/Patch/Bundle.hs
--------------------------------------------------------
Owen Stephens <darcs@owenstephens.co.uk>**20110417030928
hunk ./src/Darcs/Patch/Bundle.hs 163
> Sealed ((PatchSet recent tagged):>ps) <- parseBundle bundle
> return . Sealed $ PatchSet (reverseFL ps +<+ recent) tagged
>
> --- filterGpgDashes is needed because clearsigned patches escape dashes:
> +-- |filterGpgDashes unescapes a clearsigned patch, which will have
had any
> +-- lines starting with dashes escaped with a leading "- ".
> filterGpgDashes :: B.ByteString -> B.ByteString
> filterGpgDashes ps =
> unlinesPS $ map drop_dashes $
Is it known that the patch is clearsigned when calling
filterGpgDashes, or do we call it "in case it were"? (Your haddock
implies one, and the old one the other, but both are a bit ambiguous).
hunk ./src/Darcs/Patch/Bundle.hs 177
> not_context_or_newpatches s = (s /= BC.pack "Context:") &&
> (s /= BC.pack "New patches:")
>
> +-- |unavailablePatches converts a list of PatchInfos into a RL of
PatchInfoAnd
> +-- Unavailable patches. This is used to represent the Context of a
patchBundle.
> unavailablePatches :: RepoPatch p => [PatchInfo] -> RL (PatchInfoAnd
p) C(x y)
> unavailablePatches [] = unsafeCoerceP NilRL
> unavailablePatches (x:xs) = piUnavailable x :<: unavailablePatches xs
Ok
hunk ./src/Darcs/Patch/Bundle.hs 183
>
> +-- |piUnavailable returns an Unavailable within a PatchInfoAnd given a
> +-- PatchInfo.
> piUnavailable :: RepoPatch p => PatchInfo -> PatchInfoAnd p C(x y)
> piUnavailable i = (i `patchInfoAndPatch`
> unavailable ("Patch not stored in patch
bundle:\n" ++
Ok
hunk ./src/Darcs/Patch/Bundle.hs 189
> renderString (humanFriendly i)))
> +
> +-- |getContext parses a context list, returning a tuple containing
the list,
> +-- and remaining ByteString input.
> getContext :: B.ByteString -> ([PatchInfo],B.ByteString)
> getContext ps =
> case parseStrictly readPatchInfo ps of
Ok
hunk ./src/Darcs/Patch/Bundle.hs 199
> case getContext r' of
> (pis,r'') -> (pinfo:pis, r'')
> Nothing -> ([],ps)
> +
> +-- |(-:-) is used to build up a Sealed FL of patches and tuple it,
along with
> +-- any unconsumed input.
> (-:-) :: a C(x y) -> (Sealed (FL a C(y)),b) -> (Sealed (FL a C(x)),b)
> p -:- (Sealed ps, r) = (Sealed (p:>:ps), r)
so 'r' is the unconsumed input? I think the comma should be removed to
make that clear, but then i'm no native speaker.
hunk ./src/Darcs/Patch/Bundle.hs 204
> +
> +-- |getPatches is similar to parsePatches, yet it also returns any
unconsumed
> +-- input.
> getPatches :: RepoPatch p => B.ByteString -> (Sealed (FL
(PatchInfoAnd (Bracketed p)) C(x)), B.ByteString)
> getPatches ps =
> case parseStrictly readPatchInfo ps of
soon to be replaced…
hunk ./src/Darcs/Patch/Bundle.hs 215
> case readPatchPartial ps of
> Nothing -> (Sealed NilFL, ps)
> Just (Sealed p, r) -> (pinfo `piap` p) -:- getPatches r
> +
> +-- |parsePatches attempts to parse a sequence of patches from a
ByteString,
> +-- returning the FL of as many patches-with-info as were successfully
parsed.
> parsePatches :: RepoPatch p => B.ByteString -> Sealed (FL
(PatchInfoAnd p) C(x))
> parsePatches ps =
> case parseStrictly readPatchInfo ps of
Ok.
hunk ./src/Darcs/Patch/Bundle.hs 227
> Nothing -> Sealed NilFL
> Just (Sealed p, r) -> ((pinfo `piap` p) :>:) `mapSeal` parsePatches r
>
> +-- |sillyLex takes a ByteString and breaks it upon the first newline,
having
> +-- removed any leading spaces. The before-newline part is unpacked to
a String,
> +-- and tupled up with the remaining ByteString.
> sillyLex :: B.ByteString -> (String, B.ByteString)
> sillyLex ps = (BC.unpack a, b)
> where
Ok
hunk ./src/Darcs/Patch/Bundle.hs 235
> (a, b) = BC.break (== '\n') (dropSpace ps)
>
> -{-
> -sillyLex ps = (BC.unpack $ BC.takeWhile (/='\n') ps', BC.dropWhile
(/='\n') ps')
> - where
> - ps' = dropSpace ps
> --}
> -
> -
> contextPatches :: RepoPatch p => PatchSet p C(Origin x) ->
> (PatchSet p :> (RL (PatchInfoAnd p))) C(Origin x)
> contextPatches set = case slightlyOptimizePatchset set of
Ok
hunk ./src/Darcs/Patch/Bundle.hs 258
> scanContext $ filterGpgDashes rest
> (_,rest) -> scanContext rest
>
> -
> +-- |patchFilename maps a patch description string to a safe
(lowercased, spaces
> +-- removed and ascii-only characters) patch filename.
> patchFilename :: String -> String
> patchFilename the_summary = name ++ ".dpatch"
> where name = map safeFileChar the_summary
Ok
Remove unneeded parsePatches function, slightly refactor parseBundle to
better describe intent.
-----------------------------------------------------------------------------------------------
Owen Stephens <darcs@owenstephens.co.uk>**20110417113737
hunk ./src/Darcs/Patch/Bundle.hs 55
[imports]
hunk ./src/Darcs/Patch/Bundle.hs 204
> (-:-) :: a C(x y) -> (Sealed (FL a C(y)),b) -> (Sealed (FL a C(x)),b)
> p -:- (Sealed ps, r) = (Sealed (p:>:ps), r)
>
> --- |getPatches is similar to parsePatches, yet it also returns any
unconsumed
> --- input.
> +-- |getPatches attempts to parse a sequence of patches from a ByteString,
> +-- returning the FL of as many patches-with-info as were successfully
parsed,
> +-- along with any unconsumed input.
> getPatches :: RepoPatch p => B.ByteString -> (Sealed (FL
(PatchInfoAnd (Bracketed p)) C(x)), B.ByteString)
> getPatches ps =
> case parseStrictly readPatchInfo ps of
Ok
hunk ./src/Darcs/Patch/Bundle.hs 216
> Nothing -> (Sealed NilFL, ps)
> Just (Sealed p, r) -> (pinfo `piap` p) -:- getPatches r
>
> --- |parsePatches attempts to parse a sequence of patches from a
ByteString,
> --- returning the FL of as many patches-with-info as were successfully
parsed.
> -parsePatches :: RepoPatch p => B.ByteString -> Sealed (FL
(PatchInfoAnd p) C(x))
> -parsePatches ps =
> - case parseStrictly readPatchInfo ps of
> - Nothing -> Sealed NilFL
> - Just (pinfo,_) ->
> - case readPatchPartial ps of
> - Nothing -> Sealed NilFL
> - Just (Sealed p, r) -> ((pinfo `piap` p) :>:) `mapSeal` parsePatches r
> -
> -- |sillyLex takes a ByteString and breaks it upon the first newline,
having
> -- removed any leading spaces. The before-newline part is unpacked to
a String,
> -- and tupled up with the remaining ByteString.
Removed parsePatches.
hunk ./src/Darcs/Patch/Bundle.hs 107
> case sillyLex ps of
> ("New patches:",rest) ->
> case getPatches rest of
> - (Sealed patchesBraced, rest') ->
> - let patches = mapFL_FL (fmapFL_PIAP unBracketedFL)
patchesBraced in
> + (Sealed bracketedPatches, rest') ->
> case sillyLex rest' of
> ("Context:", rest'') ->
> case getContext rest'' of
hunk ./src/Darcs/Patch/Bundle.hs 115
> case substrPS (BC.pack "Patch bundle hash:")
> maybe_hash of
> Just n ->
> - if hashBundle (mapFL_FL hopefully patchesBraced)
> + if hashBundle (mapFL_FL hopefully
bracketedPatches)
> == fst (sillyLex $ snd $ sillyLex $
> B.drop n maybe_hash)
hunk ./src/Darcs/Patch/Bundle.hs 118
> - then Right $ seal_up_patches patches cont
> + then Right $ sealContextWithPatches cont
bracketedPatches
> else Left $
> "Patch bundle failed hash!\n" ++
> "This probably means that the patch
has been "++
hunk ./src/Darcs/Patch/Bundle.hs 124
> "corrupted by a mailer.\n"++
> "The most likely culprit is CRLF
newlines."
> - Nothing -> Right $ seal_up_patches patches cont
> + Nothing -> Right $ sealContextWithPatches cont
bracketedPatches
> (a,r) -> Left $ "Malformed patch bundle: '"++a++"' is not
'Context:'"
> ++ "\n" ++ BC.unpack r
> ("Context:",rest) ->
hunk ./src/Darcs/Patch/Bundle.hs 132
> (cont, rest') ->
> case sillyLex rest' of
> ("New patches:", rest'') ->
> - case parsePatches rest'' of
> - Sealed ps'' -> Right $ seal_up_patches ps'' cont
> + case getPatches rest'' of
> + (Sealed bracketedPatches, _) -> Right $
sealContextWithPatches cont bracketedPatches
> (a,_) -> Left $ "Malformed patch bundle: '" ++ a ++
> "' is not 'New patches:'"
> ("-----BEGIN PGP SIGNED MESSAGE-----",rest) ->
hunk ./src/Darcs/Patch/Bundle.hs 139
> parseBundle $ filterGpgDashes rest
> (_,rest) -> parseBundle rest
> - where seal_up_patches :: RepoPatch p => FL (PatchInfoAnd p) C(x
y) -> [PatchInfo]
> - -> Sealed ((PatchSet p :> FL
(PatchInfoAnd p)) C(Origin))
> - seal_up_patches patches context =
> + where sealContextWithPatches :: RepoPatch p => [PatchInfo] -> FL
(PatchInfoAnd (Bracketed p)) C(x y) -> Sealed ((PatchSet p :> FL
(PatchInfoAnd p)) C(Origin))
> + sealContextWithPatches context bracketedPatches =
> + let patches = mapFL_FL (fmapFL_PIAP unBracketedFL)
bracketedPatches in
> case reverse context of
> (x:ry) | isTag x ->
> Sealed $ (PatchSet
Refactoring, ok.
|