%  Copyright (C) 2002-2004 David Roundy
%  Copyright (C) 2005 Juliusz Chroboczek
%
%  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.

\begin{code}
module Darcs.Repository ( Repository, maybeIdentifyRepository, identifyRepository,
                    findRepository, amInRepository, amNotInRepository,
                    slurp_pending,
                    slurp_recorded, slurp_recorded_and_unrecorded,
                    withRecorded,
                    get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,
                    read_repo, sync_repo, absolute_dir,
                    unsafe_fast_read_repo,
                    prefsUrl,
                    read_pending, add_to_pending,
                    withRepoLock,
#ifdef HAVEWX
                    takeRepoGuiLock, releaseRepoGuiLock, withRepoGuiLockCanFail,
#endif
                    tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
                    finalizeRepositoryChanges,
                    copyRepository, copy_oldrepo_patches,
                    unrevertUrl,
                    applyToWorking, applyToPristine, patchSetToPatches,
                    createPristineDirectoryTree,
                    optimizeInventory,
                    getMarkedupFile,
                    PatchSet
                  ) where

import Darcs.Repository.Internal
    (Repository(..), RepoType(..),
     maybeIdentifyRepository, identifyRepository,
     findRepository, amInRepository, amNotInRepository,
     slurp_pending,
     slurp_recorded, slurp_recorded_and_unrecorded,
     withRecorded,
     get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,
     read_repo, sync_repo, absolute_dir,
     unsafe_fast_read_repo,
     prefsUrl,
     read_pending, add_to_pending,
     withRepoLock,
#ifdef HAVEWX
     takeRepoGuiLock, releaseRepoGuiLock, withRepoGuiLockCanFail,
#endif
     tentativelyAddPatch, tentativelyRemovePatches, tentativelyAddToPending,
     finalizeRepositoryChanges,
     unrevertUrl,
     applyToWorking, applyToPristine, patchSetToPatches,
     createPristineDirectoryTree,
     optimizeInventory,
     getMarkedupFile,
    )
import Darcs.Repository.Prefs ( unionCaches )
import Darcs.Patch.Set ( PatchSet )

import Control.Monad ( unless, when )

import qualified Darcs.Repository.DarcsRepo as DarcsRepo
import qualified Darcs.Repository.HashedRepo as HashedRepo

import Darcs.Repository.Checkpoint ( identify_checkpoint, write_checkpoint_patch, get_checkpoint )
import Darcs.Repository.ApplyPatches ( apply_patches_with_feedback, simple_feedback )
import Darcs.Patch ( patch2patchinfo, apply )
import Darcs.Repository.Pristine ( identifyPristine, createPristineFromWorking )
import Darcs.Repository.Format ( RepoProperty ( Darcs1_0, HashedInventory ),
                                 format_has_together, format_has )
import Darcs.Patch.Depends ( get_patches_beyond_tag )
import Darcs.Utils ( withCurrentDirectory )

#include "impossible.h"

import Darcs.Flags ( DarcsFlag( Verbose, Quiet, Partial ) )
import Printer ( text, putDocLn )
\end{code}

\begin{code}
copyRepository :: Repository -> IO ()
copyRepository fromrepository@(Repo _ opts _ _)
    | Partial `elem` opts =
        do isPartial <- copyPartialRepository fromrepository
           unless (isPartial == IsPartial) $ copyFullRepository fromrepository
    | otherwise = copyFullRepository fromrepository

data PorNP = NotPartial | IsPartial
             deriving ( Eq )

data RepoSort = Hashed | HashedAndOld | Old

copyInventory :: Repository -> IO ()
copyInventory fromrepo@(Repo fromdir opts rf (DarcsRepository _ cremote)) = do
  torepo@(Repo todir _ rf2 (DarcsRepository _ c)) <- identifyRepository opts "."
  let copyHashedHashed = HashedRepo.copy_repo (c `unionCaches` cremote) opts fromdir todir
      copyAnythingToOld r = withCurrentDirectory todir $ read_repo r >>=
                            DarcsRepo.write_inventory_and_patches opts
      copyAnythingToHashed r = withCurrentDirectory todir $
                               read_repo r >>= HashedRepo.write_inventory
      repoSort rfx | format_has_together [HashedInventory] rfx = Hashed
                   | format_has_together [Darcs1_0,HashedInventory] rfx = HashedAndOld
                   | otherwise = Old
  case repoSort rf2 of
    Hashed ->
        if format_has HashedInventory rf
        then copyHashedHashed
        else withCurrentDirectory todir $ read_repo fromrepo >>= HashedRepo.write_inventory
    HashedAndOld ->
        if format_has HashedInventory rf
        then do copyHashedHashed
                copyAnythingToOld torepo
        else do copyAnythingToHashed fromrepo
                copyAnythingToOld torepo
    Old -> case repoSort rf of
           Hashed -> copyAnythingToOld fromrepo
           _ -> copy_oldrepo_patches opts fromdir todir
copyInventory (Repo _ _ _ GitRepository) =
    bug "TODO: need to implement copying of git repositories."

copy_oldrepo_patches :: [DarcsFlag] -> FilePath -> FilePath -> IO ()
copy_oldrepo_patches opts dir out = do
  patches <- DarcsRepo.read_repo "."
  mpi <- if Partial `elem` opts
         then identify_checkpoint opts dir -- FIXME this should get last pinfo *before*
                                           -- desired tag...
         else return Nothing
  DarcsRepo.copy_patches opts dir out $ map fst $ since_checkpoint mpi $ concat patches
      where --since_checkpoint :: Maybe PatchInfo
            --     -> [(PatchInfo, Hopefully Patch)] -> [(PatchInfo, Hopefully Patch)]
            since_checkpoint Nothing ps = ps
            since_checkpoint (Just ch) ((pinfo, mp):ps)
                | ch == pinfo = [(pinfo, mp)]
                | otherwise = (pinfo, mp) : since_checkpoint (Just ch) ps
            since_checkpoint _ [] = []

copyPartialRepository :: Repository -> IO PorNP
copyPartialRepository fromrepository@(Repo repodir opts _ _) = do
  mch <- get_checkpoint opts repodir
  case mch of
    Nothing -> do putStrLn "No checkpoint."
                  return NotPartial
    Just ch ->
      do copyInventory fromrepository
         withRepoLock opts $ \torepository -> do
           write_checkpoint_patch ch
           local_patches <- unsafe_fast_read_repo torepository
           let pi_ch = fromJust $ patch2patchinfo ch
               needed_patches = reverse $ concat $
                                get_patches_beyond_tag pi_ch local_patches
           apply opts ch `catch`
                             \e -> fail ("Bad checkpoint!\n" ++ show e)
           apply_patches_with_feedback opts feedback putInfo needed_patches
           putVerbose $ text "Writing the pristine"
           pristine <- identifyPristine
           createPristineFromWorking pristine
           return IsPartial
      where am_verbose = Verbose `elem` opts
            am_informative = not $ Quiet `elem` opts
            putVerbose s = when am_verbose $ putDocLn s
            putInfo s = when am_informative $ putDocLn s
            feedback = simple_feedback opts "Applying"

copyFullRepository :: Repository -> IO ()
copyFullRepository fromrepository@(Repo _ opts _ _) = do
  copyInventory fromrepository  
  withRepoLock opts $ \torepository ->
        do local_patches <- unsafe_fast_read_repo torepository
           apply_patches_with_feedback opts feedback putInfo $
                                       reverse $ concat $ local_patches
           putVerbose $ text "Writing the pristine"
           pristine <- identifyPristine
           createPristineFromWorking pristine
      where putVerbose = when (Verbose `elem` opts) . putDocLn
            putInfo = when (not $ Quiet `elem` opts) . putDocLn
            feedback = simple_feedback opts "Applying"
\end{code}
