    -- Copyright (C) 2002-2004,2007-2008 David Roundy
    -- Copyright (C) 2005 Juliusz Chroboczek
    -- Copyright (C) 2009 Petr Rockai
    --
    -- 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; see the file COPYING.  If not, write to
    -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    -- Boston, MA 02110-1301, USA.

    #include "gadts.h"

    module Darcs.Repository.Merge where

    import Darcs.Resolution ( standard_resolution, external_resolution )
    import Darcs.External ( backupByCopying )
    import Control.Monad ( when )

    import Darcs.Patch ( Effect )
    import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully )
    import Darcs.Flags
        ( DarcsFlag( AllowConflicts ), want_external_merge )
    import Darcs.Witnesses.Ordered
        ( FL(..), (:\/:)(..), (:/\:)(..), (+>+), mapFL_FL )
    import Darcs.Patch
        ( RepoPatch, Prim, merge, joinPatches, listTouchedFiles
        , patchcontents, anonymous, fromPrims, effect )
    import Progress( debugMessage )
    import Darcs.ProgressPatches( progressFL )
    import Darcs.Witnesses.Sealed( Sealed(Sealed), seal )
    import Darcs.Repository.InternalTypes( Repository(..) )

    import Darcs.Repository.State( unrecordedChanges, readUnrecorded )

    import Darcs.Repository.Internal
        ( announce_merge_conflicts, check_unrecorded_conflicts
        , MakeChanges(..), setTentativePending
        , tentativelyAddPatch_, applyToTentativePristine, UpdatePristine(..) )

    tentativelyMergePatches_ :: forall p C(r u t y x). RepoPatch p
                             => MakeChanges
                             -> Repository p C(r u t) -> String -> [DarcsFlag]
                             -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
                             -> IO (Sealed (FL Prim C(u)))
    tentativelyMergePatches_ mc r cmd opts usi themi =
      do let us = mapFL_FL hopefully usi
             them = mapFL_FL hopefully themi
         _ :/\: pc <- return $ merge (progressFL "Merging them" them :\/: progressFL "Merging us" us)
         pend <- unrecordedChanges opts r []
         anonpend <- anonymous (fromPrims pend)
         pend' :/\: pw <- return $ merge (pc :\/: anonpend :>: NilFL)
         let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $ mapFL_FL patchcontents pw
         Sealed standard_resolved_pw <- return $ standard_resolution pwprim
         debugMessage "Checking for conflicts..."
         mapM_ backupByCopying $ listTouchedFiles standard_resolved_pw
         debugMessage "Announcing conflicts..."
         have_conflicts <- announce_merge_conflicts cmd opts standard_resolved_pw
         debugMessage "Checking for unrecorded conflicts..."
         have_unrecorded_conflicts <- check_unrecorded_conflicts opts pc
         debugMessage "Reading working directory..."
         working <- readUnrecorded r
         debugMessage "Working out conflicts in actual working directory..."
         Sealed pw_resolution <-
              case (want_external_merge opts, have_conflicts || have_unrecorded_conflicts) of
              (Nothing,_) -> return $ if AllowConflicts `elem` opts
                                      then seal NilFL
                                      else seal standard_resolved_pw
              (_,False) -> return $ seal standard_resolved_pw
              (Just c, True) -> external_resolution working c
                                                        (effect us +>+ pend)
                                                        (effect them) pwprim
         debugMessage "Applying patches to the local directories..."
         when (mc == MakeChanges) $
              do let doChanges :: FL (PatchInfoAnd p) C(x r) -> IO ()
                     doChanges NilFL = applyps r themi
                     doChanges _     = applyps r (mapFL_FL n2pia pc)
                 doChanges usi
                 setTentativePending r (effect pend' +>+ pw_resolution)
         return $ seal (effect pwprim +>+ pw_resolution)
      where mapAdd :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> [IO ()]
            mapAdd _ NilFL = []
            mapAdd r'@(Repo dir df rf dr) (a:>:as) =
                   -- we construct a new Repository object on the recursive case so that the
                   -- recordedstate of the repository can match the fact that we just wrote a patch
                   tentativelyAddPatch_ DontUpdatePristine r' opts a : mapAdd (Repo dir df rf dr) as
            applyps :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j) -> IO ()
            applyps repo ps = do debugMessage "Adding patches to inventory..."
                                 sequence_ $ mapAdd repo ps
                                 debugMessage "Applying patches to pristine..."
                                 applyToTentativePristine repo ps

    tentativelyMergePatches :: RepoPatch p
                            => Repository p C(r u t) -> String -> [DarcsFlag]
                            -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
                            -> IO (Sealed (FL Prim C(u)))
    tentativelyMergePatches = tentativelyMergePatches_ MakeChanges

    considerMergeToWorking :: RepoPatch p
                           => Repository p C(r u t) -> String -> [DarcsFlag]
                           -> FL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x y)
                           -> IO (Sealed (FL Prim C(u)))
    considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges