%  Copyright (C) 2002-2004 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\begin{code}
module PatchBundle ( hash_bundle, make_bundle, scan_bundle,
                     make_context, scan_context,
                   ) where

import DarcsArguments ( DarcsFlag( Unified ) )
import Repository ( PatchSet )
import Patch ( Patch, showPatch, showContextPatch, apply_to_slurpy,
               readPatchPS,
             )
import Printer ( simplePrinters )
import SlurpDirectory ( Slurpy )
import PatchInfo ( PatchInfo, readPatchInfoPS )
import FastPackedString ( PackedString, unpackPS, packString, concatPS,
                          lengthPS, takePS, dropPS, linesPS, unlinesPS,
                          dropWhitePS, takeWhilePS, dropWhilePS,
                          nullPS,
                        )
import SHA1( sha1PS )
#include "impossible.h"

hash_bundle :: [PatchInfo] -> [Patch] -> String
hash_bundle _ to_be_sent =
    sha1PS $ concatPS $ concatMap (showPatch simplePrinters) to_be_sent

make_bundle :: [DarcsFlag] -> Slurpy -> [PatchInfo] -> [Patch] -> String
make_bundle opts the_s common to_be_sent =
    "\nNew patches:\n\n"++ (unlines the_new) ++
    "\n\nContext:\n\n"++ (unlines $ map show $ common) ++
    "\nPatch bundle hash:\n" ++ hash_bundle common to_be_sent ++ "\n"
      where the_new = if Unified `elem` opts
                      then showC the_s to_be_sent
                      else map show to_be_sent
            showC _ [] = []
            showC s (p:ps) =
                showContextPatch simplePrinters s p :
                showC (fromJust $ apply_to_slurpy p s) ps
\end{code}

\begin{code}
scan_bundle :: PackedString -> PatchSet
scan_bundle ps
  | nullPS ps = error "Bad patch bundle!"
  | otherwise =
    case silly_lex ps of
    ("New patches:",rest) ->
        case get_patches rest of
        (patches, rest') ->
            case silly_lex rest' of
            ("Context:", rest'') ->
                case get_context rest'' of
                (cont,maybe_hash) ->
                    case silly_lex maybe_hash of
                    ("Patch bundle hash:",h) ->
                        if hash_bundle cont (map (fromJust.snd) patches)
                               == fst (silly_lex h)
                        then [reverse patches ++ (zip cont nothings)]
                        else error $
                                 "Patch bundle failed hash!\n" ++
                                 "This probably means that the patch has been "++
                                 "corrupted by a mailer.\n"++
                                 "The most likely culprit is CRLF newlines."
                    _ -> [reverse patches ++ (zip cont nothings)]
            (a,_) -> error $ "Malformed patch bundle: '"++a++"' is not 'Context:'"
    ("Context:",rest) ->
        case get_context rest of
        (cont, rest') ->
            case silly_lex rest' of
            ("New patches:", rest'') -> [reverse (parse_patches rest'') ++
                                         (zip cont nothings)]
            (a,_) -> error $ "Malformed patch bundle: '" ++ a ++
                     "' is not 'New patches:'"
    ("-----BEGIN PGP SIGNED MESSAGE-----",rest) ->
            scan_bundle $ filter_gpg_dashes rest
    (_,rest) -> scan_bundle rest

-- filter_gpg_dashes is needed because clearsigned patches escape dashes:
filter_gpg_dashes :: PackedString -> PackedString
filter_gpg_dashes ps =
    unlinesPS $ map drop_dashes $
    takeWhile (/= packString "-----END PGP SIGNED MESSAGE-----") $
    dropWhile not_context_or_newpatches $ linesPS ps
    where drop_dashes x = if lengthPS x < 2 then x
                          else if takePS 2 x == packString "- "
                               then dropPS 2 x
                               else x
          not_context_or_newpatches s = (s /= packString "Context:") &&
                                        (s /= packString "New patches:")
nothings :: [Maybe a]
nothings = Nothing : nothings
get_context :: PackedString -> ([PatchInfo],PackedString)
get_context ps =
    case readPatchInfoPS ps of
    Just (pinfo,r') ->
        case get_context r' of
        (pis,r'') -> (pinfo:pis, r'')
    Nothing -> ([],ps)
(-:-) :: a -> ([a],b) -> ([a],b)
p -:- (ps, r) = (p:ps, r)
get_patches :: PackedString -> ([(PatchInfo, Maybe Patch)], PackedString)
get_patches ps =
    case readPatchInfoPS ps of
    Nothing -> ([], ps)
    Just (pinfo,_) ->
        case readPatchPS ps of
        Nothing -> ([], ps)
        Just (p, r) -> (pinfo, Just p) -:- get_patches r
parse_patches :: PackedString -> [(PatchInfo, Maybe Patch)]
parse_patches ps =
  case readPatchInfoPS ps of
  Nothing -> []
  Just (pinfo,_) ->
    case readPatchPS ps of
    Nothing -> []
    Just (p, r) -> (pinfo,Just p) : parse_patches r

silly_lex :: PackedString -> (String, PackedString)
silly_lex ps = (unpackPS $ takeWhilePS (/='\n') $ dropWhitePS ps,
                dropWhilePS (/='\n') $ dropWhitePS ps)
\end{code}

\begin{code}
make_context :: [PatchInfo] -> String
make_context common =
    "\nContext:\n\n"++ (unlines $ map show $ common) ++ "\n"
\end{code}

\begin{code}
scan_context :: PackedString -> PatchSet
scan_context ps
  | nullPS ps = error "Bad context!"
  | otherwise =
    case silly_lex ps of
    ("Context:",rest) ->
        case get_context rest of
        (cont, _) -> [zip cont nothings]
    ("-----BEGIN PGP SIGNED MESSAGE-----",rest) ->
            scan_context $ filter_gpg_dashes rest
    (_,rest) -> scan_context rest
\end{code}