%  Copyright (C) 2002-2005 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; see the file COPYING.  If not, write to
%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
%  Boston, MA 02110-1301, USA.

\chapter{DarcsRepo format}
\label{repository_format}

A repository consists of a working directory, which has within it a
directory called \verb!_darcs!. There must also be a subdirectory within
\verb!_darcs! named \verb!patches!.  The \verb!patches! directory contains
the actual patches which are in the repository.  There must also be a
\emph{pristine tree}, which may either be a directory containing a cache of
the version of the tree which has been recorded, or a stub, and may be
named either ``current'' or ``pristine''.

\emph{WARNING!} Viewing files in the pristine cache is perfectly
acceptable, but if you view them with an editor (e.g.\ vi or Emacs), that
editor may create temporary files in the pristine tree
(\verb|_darcs/pristine/| or \verb|_darcs/current/|), which will temporarily
cause your repository to be inconsistent.  So \emph{don't record any
patches while viewing files in \_darcs/current with an editor!}  A better
plan would be to restrict yourself to viewing these files with a pager such
as more or less.

Also within \verb!_darcs! is the \verb!inventory! file, which lists all the
patches that are in the repository. Moreover, it also gives the order of the
representation of the patches as they are stored. Given a source of patches,
i.e.\ any other set of repositories which have between them all the patches
contained in a given repository, that repository can be reproduced based on only the
information in the \verb!inventory! file. Under those circumstances, the
order of the patches specified in the \verb!inventory! file would be
unimportant, as this order is only needed to provide context for the
interpretation of the stored patches in this repository.

\begin{code}
module DarcsRepo ( slurp_recorded,
                    slurp_recorded_and_unrecorded,
                    createPristineDirectoryTree,
                    createPartialsPristineDirectoryTree,
                    withRecorded,
                    slurp_all_but_darcs,
                    surely_slurp_Pristine,
                    read_pending, with_new_pending,
                    write_inventory, add_to_inventory, read_repo,
                    lazily_read_repo, sync_repo,
                    get_markedup_file,
                    copy_repo_patches, am_in_repo, am_not_in_repo,
                    write_patch,
                    absolute_dir,
                    get_checkpoint, get_checkpoint_by_default,
                    write_checkpoint, write_recorded_checkpoint,
                    write_checkpoint_patch,
                    remove_from_checkpoint_inventory,
                    apply_patches,
                    apply_patches_with_feedback,
                    simple_feedback,
                    seekRepo, youNeedToBeInRepo
                  ) where

import Directory ( setCurrentDirectory, doesFileExist,
                   doesDirectoryExist )
import Workaround ( getCurrentDirectory, renameFile, createDirectoryIfMissing )
import DarcsUtils ( withCurrentDirectory, bugDoc )
import System.IO ( hPutStrLn, stderr, hFlush, stdout )
import System.IO.Unsafe ( unsafeInterleaveIO )
import Monad ( liftM, when, unless )
import Maybe ( maybeToList, isNothing,
               mapMaybe,
             )
import SignalHandler ( withSignalsBlocked )
import FastPackedString ( PackedString, packString, gzReadFilePS,
                          breakOnPS, nullPS )

import Lock ( withTempDir, withDelayedDir )
import SlurpDirectory ( Slurpy, empty_slurpy,
                        slurp, mmap_slurp, co_slurp,
                        slurp_remove,
                      )
import Patch ( Patch, is_null_patch, invert, patch2patchinfo,
               apply_to_slurpy, apply, try_to_shrink,
               flatten_to_primitives, join_patches, flatten,
               is_setpref, infopatch, is_addfile, is_adddir,
               is_hunk, is_binary, merger_equivalent, commute,
               readPatch, readPatchLazily, gzReadPatchFileLazily,
               writePatch, gzWritePatch,
               really_eq_patches,
               MarkedUpFile, LineMark(..), markup_file, empty_markedup_file,
             )
import PatchInfo ( PatchInfo, make_filename, readPatchInfo,
                   human_friendly, showPatchInfo,
                 )
import Depends ( is_tag,
               )
import Diff ( smart_diff )
import External ( gzFetchFilePS, fetchFilePS, copyFilesOrUrls, Cachable(..),
                  clonePartialsTree )
import Lock ( writeBinFile, writeDocBinFile, appendDocBinFile )
import DarcsFlags ( DarcsFlag(NoCompress, WorkDir, LookForAdds,
                              Partial, Complete, Verbose, Quiet) )
import PatchSet ( PatchSet )
import Depends ( slightly_optimize_patchset,
                 get_patches_beyond_tag, get_patches_in_tag )
import Pristine ( Pristine, identifyPristine, slurpPristine, syncPristine,
                  easyCreatePristineDirectoryTree,
                  easyCreatePartialsPristineDirectoryTree,
                )
import RepoPrefs ( filetype_function )
import FileName ( fp2fn )
import DarcsUtils ( catchall )
import DarcsURL (is_ssh_nopath )
import Printer ( errorDoc, text, (<+>), (<>), putDocLn, putDoc, Doc, ($$), empty )
#include "impossible.h"
\end{code}

\begin{code}
--am_in_repo is a function that is used for command_prereq, which moves in
--to the repository root directory and returns enough information to translate
--relative paths to compensate.
am_not_in_repo :: [DarcsFlag] -> IO (Either String FilePath)
am_not_in_repo f = do go_to_workdir True f
                      air <- amInDarcsRepo
                      if air then return (Left $ "You may not run this"
                                  ++ " command in a repository.")
                             else return $ Right ""

am_in_repo :: [DarcsFlag] -> IO (Either String FilePath)
am_in_repo fs = do go_to_workdir False fs
                   seekRepo amInDarcsRepo (Left youNeedToBeInRepo)

amInDarcsRepo :: IO Bool
amInDarcsRepo = do
  i <- doesFileExist "_darcs/inventory"
  if i then doesDirectoryExist "_darcs/patches" else return False

youNeedToBeInRepo :: String
youNeedToBeInRepo = 
  "You need to be in a repository directory to run this command."

-- | hunt upwards for the darcs repository
-- This keeps changing up one parent directory, testing at each
-- step if the current directory is a repository or not.  
-- WARNING this changes the current directory for good!
seekRepo :: IO Bool
            -- ^ monadic fn to determine if the current dir is a repo
         -> Either String FilePath 
            -- ^ what to return if we don't find a repository
         -> IO (Either String FilePath)
seekRepo matchFn onFail = helper "" where 
  helper dir = do
    air <- matchFn
    if air
       then return (Right dir)
       else do cd <- getCurrentDirectory
               setCurrentDirectory ".."
               cd' <- getCurrentDirectory
               if cd' /= cd
                  then helper $ reverse (takeWhile (/='/') $ reverse cd)///dir
                  else return onFail
(///) :: FilePath -> FilePath -> FilePath
""///b = b
a///"" = a
a///b = a ++ "/" ++ b

go_to_workdir :: Bool -> [DarcsFlag] -> IO () 
go_to_workdir create (WorkDir d:_) = 
  do when create $ createDirectoryIfMissing False d
     -- note that the above could always fail
     setCurrentDirectory d 
       `catchall` (fail $ "can't set directory to "++d)
go_to_workdir c (_:fs) = go_to_workdir c fs
go_to_workdir _ [] = return ()
\end{code}

There is a very special patch which may be stored in \verb!patches! which
is called `pending'.  This patch describes any changes which have not yet
been recorded, and cannot be determined by a simple diff.  For example, file
additions or renames are placed in pending until they are recorded.
Similarly, token replaces are stored in pending until they are recorded.

\begin{code}
read_pending :: String -> IO (Maybe Patch)
read_pending name = do
  pend <- gzReadFilePS name `catch`
          (\_ -> return $ packString "")
  case readPatch pend of
    Nothing -> return Nothing
    Just (p,_) -> return $ if is_null_patch p then Nothing else Just p

with_new_pending :: String -> Patch -> IO Slurpy -> IO ()
with_new_pending name origp job =
 do let p = sift_for_pending origp
        newname = name ++ ".new"
    writePatch newname p
    cur <- job
    mp <- read_pending newname
    unless (isNothing mp) $
      when (isNothing $ apply_to_slurpy (fromJust mp) cur) $ do
      let buggyname = name ++ "_buggy"
      renameFile newname buggyname
      bugDoc $ text "There was an attempt to write an invalid pending!"
            $$ text "If possible, please send the contents of"
               <+> text buggyname
            $$ text "along with a bug report."
    renameFile newname name

sift_for_pending :: Patch -> Patch
sift_for_pending patch =
  case flatten_to_primitives $ merger_equivalent patch of
  oldps ->
    if all (\p -> is_addfile p || is_adddir p) oldps
    then join_patches oldps
    else 
      case try_to_shrink $ sfp [] $ reverse oldps of
      ps | length ps < length oldps -> sift_for_pending $ join_patches ps
         | otherwise -> join_patches ps
      where sfp sofar [] = sofar
            sfp sofar (p:ps)
                | is_hunk p || is_binary p
                    = case commute (join_patches sofar, p) of
                      Just (_, sofar') -> sfp (flatten sofar') ps
                      Nothing -> sfp (p:sofar) ps
            sfp sofar (p:ps) = sfp (p:sofar) ps
\end{code}
\begin{code}
write_patch :: [DarcsFlag] -> Patch -> IO FilePath
write_patch opts p =
    case patch2patchinfo p of
    Nothing -> fail "Patch is not a named patch!"
    Just pinfo ->
       do let writeFun = if NoCompress `elem` opts
                         then writePatch
                         else gzWritePatch
              pname = "_darcs/patches/"++make_filename pinfo
          proceed <- hasChanged pname p
          when proceed $ writeFun pname p
          return pname
    where hasChanged :: FilePath -> Patch -> IO Bool
          hasChanged na pa =
             do old <- gzReadFilePS na
                       `catch` (\_ -> return $ packString "")
                case readPatch old of
                  Nothing -> return True -- new patch
                  Just (oldp,_) -> return $ not (oldp `really_eq_patches` pa)
\end{code}

\begin{code}
createPristineDirectoryTree :: Pristine -> FilePath -> IO ()
createPristineDirectoryTree pris fp
 = do done <- easyCreatePristineDirectoryTree pris fp
      unless done $ do
          patches <- get_whole_repo_patches
          createDirectoryIfMissing True fp
          withCurrentDirectory fp $
              apply_patches [] noPut noPut patches
    where noPut _ = return ()

createPartialsPristineDirectoryTree :: [FilePath] -> Pristine -> FilePath
                                    -> IO ()
createPartialsPristineDirectoryTree prefs pris fp
 = do done <- easyCreatePartialsPristineDirectoryTree prefs pris fp
      unless done $ withRecorded (withTempDir "recorded") $ \_ -> do
          clonePartialsTree "." fp prefs

withRecorded :: ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
withRecorded mk_dir f
 = do dir <- getCurrentDirectory
      mk_dir $ \d -> do
          withCurrentDirectory dir $ do
              pris <- identifyPristine
              createPristineDirectoryTree pris d
          f d

get_whole_repo_patches :: IO [(PatchInfo, Maybe Patch)]
get_whole_repo_patches = do
    patches <- read_repo "."
    maybe_chk <- get_checkpoint_by_default [] "."
    return $ case maybe_chk of
             Just chk ->
                 let chtg = fromJust (patch2patchinfo chk)
                     rest = concat $ get_patches_beyond_tag chtg patches
                 in (chtg, Just chk):reverse rest
             Nothing -> reverse $ concat patches

surely_slurp_Pristine :: Pristine -> IO Slurpy
surely_slurp_Pristine pristine = do
    mc <- slurpPristine pristine
    case mc of
        (Just slurpy) -> return slurpy
        Nothing -> do
           patches <- get_whole_repo_patches
           withDelayedDir "pristine.temp" $ \cd -> do
               apply_patches [] noPut noPut patches
               mmap_slurp cd
             where noPut _ = return ()

sync_repo :: Pristine -> IO ()
sync_repo cur = syncPristine cur

slurp_recorded :: FilePath -> IO Slurpy
slurp_recorded d = withCurrentDirectory d $
                       identifyPristine >>= surely_slurp_Pristine

slurp_all_but_darcs :: FilePath -> IO Slurpy
slurp_all_but_darcs d = do s <- slurp d
                           case slurp_remove (fp2fn "./_darcs") s of
                             Nothing -> return s
                             Just s' -> return s'
\end{code}

\begin{comment}
\end{comment}

\begin{code}
slurp_recorded_and_unrecorded :: FilePath -> IO (Slurpy, Slurpy)
slurp_recorded_and_unrecorded d = withCurrentDirectory d $ do
  cur <- identifyPristine >>= surely_slurp_Pristine
  mbpend <- read_pending "_darcs/patches/pending"
  case mbpend of
    Just pend ->
      case apply_to_slurpy pend cur of
      Nothing -> fail "Yikes, pending has conflicts!"
      Just pendslurp -> do unrec <- co_slurp pendslurp "."
                           return (cur, unrec)
    Nothing -> do unrec <- co_slurp cur "."
                  return (cur, unrec)
\end{code}

\begin{code}
--format_inventory is not exported for use outside of the DarcsRepo module
--itself.
format_inventory :: [(PatchInfo, Maybe Patch)] -> Doc
format_inventory [] = empty
format_inventory ((pinfo,_):ps) = showPatchInfo pinfo
                               $$ format_inventory ps

write_inventory :: FilePath -> PatchSet -> IO ()
-- Note that write_inventory optimizes the inventory it writes out by
-- checking on tag dependencies.
-- FIXME: There is also a problem that write_inventory always writes
-- out the entire inventory, including the parts that you haven't
-- changed...
write_inventory dir ps = withSignalsBlocked $ do
    createDirectoryIfMissing False (dir++"/_darcs/inventories")
    simply_write_inventory "inventory" dir $ slightly_optimize_patchset ps

simply_write_inventory :: String -> FilePath -> PatchSet -> IO ()
simply_write_inventory name dir [] =
    writeBinFile (dir++"/_darcs/"++name) ""
simply_write_inventory name dir [ps] = do
    writeDocBinFile (dir++"/_darcs/"++name) $ format_inventory $ reverse ps
simply_write_inventory _ _ ([]:_) =
    fail $ "Bug in simply_write_inventory, please report!"
simply_write_inventory name dir (ps:pss) = do
    tagname <- return $ make_filename $ fst $ last ps
    simply_write_inventory ("inventories/"++tagname) dir pss
    writeDocBinFile (dir++"/_darcs/"++name) $ text "Starting with tag:"
                                           $$ format_inventory (reverse ps)

add_to_inventory :: FilePath -> [PatchInfo] -> IO ()
add_to_inventory dir pinfos =
    appendDocBinFile (dir++"/_darcs/inventory") $ pidocs pinfos
    where
        pidocs [] = text ""
        pidocs (p:ps) = showPatchInfo p $$ pidocs ps
\end{code}

\begin{code}
copy_repo_patches :: [DarcsFlag] -> FilePath -> FilePath -> IO ()
copy_repo_patches opts dir out = do
  realdir <- absolute_dir dir
  patches <- read_repo "."
  mpi <- if Partial `elem` opts
         then do cps <- read_checkpoints realdir
                 case cps of
                   [] -> return Nothing
                   ((pinfo,_):_) -> return $ Just pinfo
                   -- FIXME above should get last pinfo *before* desired
                   -- tag...
         else return Nothing
  pns <- return $ map (make_filename . fst) $
         since_checkpoint mpi $ concat patches
  copyFilesOrUrls
      opts
      (realdir++"/_darcs/patches") pns (out++"/_darcs/patches") Cachable

since_checkpoint :: Maybe PatchInfo
                 -> [(PatchInfo, Maybe Patch)] -> [(PatchInfo, Maybe 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 _ [] = []

read_repo :: String -> IO PatchSet
read_repo d = do
  realdir <- absolute_dir d
  read_repo_private False realdir "inventory" `catch`
              (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                        ioError e)

lazily_read_repo :: String -> IO PatchSet
lazily_read_repo d = do
  realdir <- absolute_dir d
  read_repo_private True realdir "inventory" `catch`
              (\e -> do hPutStrLn stderr ("Invalid repository:  " ++ realdir)
                        ioError e)

read_repo_private :: Bool -> FilePath -> FilePath -> IO PatchSet
read_repo_private am_lazy d iname = do
    i <- fetchFilePS (d++"/_darcs/"++iname) Uncachable
    (rest,str) <- case breakOnPS '\n' i of
                  (swt,pistr) | swt == packString "Starting with tag:" ->
                    do r <- rr $ head $ read_patch_ids pistr
                       return (r,pistr)
                  _ -> return ([],i)
    pis <- return $ reverse $ read_patch_ids str
    isdir <- doesDirectoryExist d
    let parse f = let fn = d ++ "/_darcs/patches/" ++ make_filename f
                  in if isdir then parse_local fn
                              else parse_remote fn
    these <- read_patches parse pis
    return $ these : rest
    where rr pinfo = unsafeInterleaveIO $ read_repo_private am_lazy d $
                     "inventories/"++make_filename pinfo
          -- parse_remote should really download to a temporary file removed
          -- at exit
          parse_remote fn = do ps <- gzFetchFilePS fn Cachable
                               return $ liftM fst $
                                   if am_lazy
                                   then Just $ readPatchLazily ps
                                   else readPatch ps
          parse_local fn = if am_lazy
                           then liftM Just $ gzReadPatchFileLazily fn
                           else liftM (liftM fst . readPatch) $ gzReadFilePS fn
          read_patches :: (PatchInfo -> IO (Maybe Patch))
                       -> [PatchInfo] -> IO [(PatchInfo, Maybe Patch)]
          read_patches _ [] = return []
          read_patches parse (i:is) = do
              mp <- unsafeInterleaveIO $ parse i `catch` \_ -> return Nothing
              rest <- read_patches parse is
              return $ (i,mp) : rest

read_patch_ids :: PackedString -> [PatchInfo]
read_patch_ids inv | nullPS inv = []
read_patch_ids inv = case readPatchInfo inv of
                     Just (pinfo,r) -> pinfo : read_patch_ids r
                     Nothing -> []

absolute_dir :: FilePath -> IO FilePath
absolute_dir dir = do
  isdir <- doesDirectoryExist dir
  if not isdir
     then if is_ssh_nopath dir
            then return $ dir++"."
            else return $ if (take 1 $ reverse dir) == "/"
              then init dir
              else dir
             -- hope it's an URL
     else do
          realdir <- withCurrentDirectory dir getCurrentDirectory
                     -- This one is absolute!
          return realdir
\end{code}

\begin{code}
read_checkpoints :: String -> IO [(PatchInfo, Maybe Slurpy)]
read_checkpoints d = do
  realdir <- absolute_dir d
  pistr <- fetchFilePS (realdir++"/_darcs/checkpoints/inventory") Uncachable
           `catchall` (return $ packString "")
  pis <- return $ reverse $ read_patch_ids pistr
  slurpies <- sequence $ map (fetch_checkpoint realdir) pis
  return $ zip pis slurpies
      where fetch_checkpoint r pinfo =
                unsafeInterleaveIO $ do
                pstr <- gzFetchFilePS
                    (r++"/_darcs/checkpoints/"++make_filename pinfo) Cachable
                case fst `liftM` readPatch pstr of
                  Nothing -> return Nothing
                  Just p -> return $ apply_to_slurpy p empty_slurpy

get_checkpoint :: [DarcsFlag] -> String -> IO (Maybe Patch)
get_checkpoint opts r = if Partial `elem` opts
                        then get_check_internal r
                        else return Nothing

get_checkpoint_by_default :: [DarcsFlag] -> String -> IO (Maybe Patch)
get_checkpoint_by_default opts r = if Complete `elem` opts
                                   then return Nothing
                                   else get_check_internal r

get_check_internal :: String -> IO (Maybe Patch)
get_check_internal r = do
  pistr <- fetchFilePS (r++"/_darcs/checkpoints/inventory") Uncachable
           `catchall` (return $ packString "")
  case reverse $ read_patch_ids pistr of
    [] -> return Nothing
    (pinfo:_) -> ((fst `liftM`). readPatch) `liftM`
                 gzFetchFilePS
                     (r++"/_darcs/checkpoints/"++make_filename pinfo) Cachable

format_inv :: [PatchInfo] -> Doc
format_inv [] = empty
format_inv (pinfo:ps) = showPatchInfo pinfo
                     $$ format_inv ps

write_recorded_checkpoint :: PatchInfo -> IO ()
write_recorded_checkpoint pinfo = do
    ps <- (map (fromJust.snd).reverse.concat) `liftM` read_repo "."
    ftf <- filetype_function
    s <- slurp_recorded "."
    write_checkpoint_patch $ infopatch pinfo $ join_patches $ changepps ps ++
                 maybeToList (smart_diff [LookForAdds] ftf empty_slurpy s)
    where changeps p = filter is_setpref $ flatten_to_primitives p
          changepps ps = concat $ map changeps $ ps

write_checkpoint :: PatchInfo -> IO ()
write_checkpoint pinfo = do
    repodir <- getCurrentDirectory
    ps <- (reverse.map (fromJust.snd).concat.get_patches_in_tag pinfo)
          `liftM` read_repo "."
    ftf <- filetype_function
    with_tag pinfo $ do
      s <- mmap_slurp "."
      setCurrentDirectory repodir
      write_checkpoint_patch $ infopatch pinfo $ join_patches $ changepps ps ++
                   maybeToList (smart_diff [LookForAdds] ftf empty_slurpy s)
    where changeps p = filter is_setpref $ flatten_to_primitives p
          changepps ps = concat $ map changeps $ ps

write_checkpoint_patch :: Patch -> IO ()
write_checkpoint_patch p =
  case patch2patchinfo p of
  Just pinfo -> do
    createDirectoryIfMissing False "_darcs/checkpoints"
    gzWritePatch ("_darcs/checkpoints/"++make_filename pinfo) p
    cpi <- (map fst) `liftM` read_checkpoints "."
    writeDocBinFile "_darcs/checkpoints/inventory"
        $ format_inv $ reverse $ pinfo:cpi
  Nothing -> bug "bad patch in write_checkpoint_patch"

remove_from_checkpoint_inventory :: [Patch] -> IO ()
remove_from_checkpoint_inventory ps = do
    -- only tags can be checkpoints
    let pinfos = filter is_tag $ mapMaybe patch2patchinfo ps
    unless (null pinfos) $ do
        createDirectoryIfMissing False "_darcs/checkpoints"
        cpi <- (map fst) `liftM` read_checkpoints "."
        writeDocBinFile "_darcs/checkpoints/inventory" $
            format_inv $ reverse $ filter (`notElem` pinfos) cpi

with_tag :: PatchInfo -> (IO ()) -> IO ()
with_tag pinfo job = do
    ps <- read_repo "."
    case get_patches_beyond_tag pinfo ps of
        [extras] -> withRecorded (withTempDir "checkpoint") $ \_ -> do
                    apply_patches [] noPut noPut $ map invert_it extras
                    job
        _ -> bug "with_tag"
    where noPut _ = return ()
          invert_it (pin, Just p) = (pin, Just $ invert p)
          invert_it (pin, Nothing) = errorDoc $ text "Couldn't read patch:"
                                             $$ human_friendly pin
\end{code}

The \verb!_darcs! directory also contains a directory called
``\verb!prefs!'', which is described in Chapter~\ref{configuring}.

\begin{comment}
\section{Getting interesting info on change history}

One can query the repository for the entire markup history of a file.  This
provides a data structure which contains a history of \emph{all} the
revisions ever made on a given file.

\begin{code}
get_markedup_file :: PatchInfo -> FilePath -> IO MarkedUpFile
get_markedup_file pinfo f = do
  patches <- liftM (dropWhile (\ (pi',_)-> pi' /= pinfo)
                    . reverse . concat) $ read_repo "."
  return $ snd $ do_mark_all patches (f, empty_markedup_file)
do_mark_all :: [(PatchInfo, Maybe Patch)]
            -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
do_mark_all ((n,Just p):pps) (f, mk) =
    do_mark_all pps $ markup_file n p (f, mk)
do_mark_all ((_,Nothing):_) (f, _) =
    (f, [(packString "Error reading a patch!",None)])
do_mark_all [] (f, mk) = (f, mk)
\end{code}

\begin{code}
apply_patches_with_feedback :: [DarcsFlag]
                            ->(Int -> Int -> PatchInfo -> IO())
                            -> (Doc -> IO ())
                            -> [(PatchInfo, Maybe Patch)] -> IO ()
apply_patches_with_feedback _ _ _ [] = return ()
apply_patches_with_feedback opts feedback putInfo patches = do
    apply_cautiously patches 1
    where patch_count = length patches
          apply_cautiously ((pinfo, Nothing) : _) _ =
             do errorDoc $ text "Couldn't read patch" <+> human_friendly pinfo
          apply_cautiously ((pinfo, Just p) : more_patches) index =
             do feedback index patch_count pinfo
                apply opts p `catch` \e ->
                  do putInfo $ text "Unapplicable patch:"
                     putInfo $ human_friendly pinfo
                     ioError e
                apply_cautiously more_patches (index+1)
          apply_cautiously [] _ = return ()

apply_patches :: [DarcsFlag]
              -> (Doc -> IO ()) -> (Doc -> IO ())
              -> [(PatchInfo, Maybe Patch)] -> IO ()
apply_patches opts putVerbose putInfo patches =
    apply_patches_with_feedback opts normalFeedback putInfo patches
    where normalFeedback _ _ pinfo = putVerbose $ text "Applying patch" <+> human_friendly pinfo  

simple_feedback :: [DarcsFlag] -> Int -> Int -> PatchInfo -> IO ()
simple_feedback opts index total pinfo =
    if am_verbose
    then putDocLn $ text "Applying patch" <+> text (show index)
                 <+> text "of" <+> text (show total) <> text ":" <+> human_friendly pinfo
    else when am_informative $ do putDoc $ text "\rApplying patch" 
                                        <+> text (show index) <+> text "of" <+> text (show total) <> text "... "
                                  hFlush stdout    
                                  when (index == total) $ putDocLn $ text "done."
    where am_verbose = Verbose `elem` opts
          am_informative = not $ Quiet `elem` opts

\end{code}

\end{comment}