1 %  Copyright (C) 2002-2005 David Roundy
    2 %
    3 %  This program is free software; you can redistribute it and/or modify
    4 %  it under the terms of the GNU General Public License as published by
    5 %  the Free Software Foundation; either version 2, or (at your option)
    6 %  any later version.
    7 %
    8 %  This program is distributed in the hope that it will be useful,
    9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 %  GNU General Public License for more details.
   12 %
   13 %  You should have received a copy of the GNU General Public License
   14 %  along with this program; see the file COPYING.  If not, write to
   15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 %  Boston, MA 02110-1301, USA.
   17 
   18 
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 #include "gadts.h"
   24 
   25 module Darcs.Patch.Apply ( apply_to_filepaths, apply_to_slurpy,
   26                            forceTokReplace,
   27                            markup_file, empty_markedup_file,
   28                            patchChanges,
   29                            applyToPop,
   30                            LineMark(..), MarkedUpFile,
   31                            force_replace_slurpy )
   32     where
   33 
   34 import Prelude hiding ( catch, pi )
   35 import Darcs.Flags ( DarcsFlag( SetScriptsExecutable ) )
   36 
   37 import qualified Data.ByteString.Char8 as BC (split, break, pack, singleton)
   38 
   39 import qualified Data.ByteString       as B (ByteString, null, empty, concat, isPrefixOf)
   40 import ByteStringUtils ( linesPS, unlinesPS, break_after_nth_newline, break_before_nth_newline, )
   41 
   42 import Darcs.Patch.FileName ( fn2ps, fn2fp, fp2fn,
   43                               movedirfilename )
   44 import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..) )
   45 import Data.List ( intersperse )
   46 import Data.Maybe ( catMaybes )
   47 import Darcs.Patch.Patchy ( Apply, apply, applyAndTryToFixFL, applyAndTryToFix,
   48                             mapMaybeSnd )
   49 import Darcs.Patch.Commute ()
   50 import Darcs.Patch.Core ( Patch(..), Named(..) )
   51 import Darcs.Patch.Prim ( Prim(..), Effect(effect),
   52                           DirPatchType(..), FilePatchType(..),
   53                           try_tok_internal )
   54 import Darcs.Patch.Info ( PatchInfo )
   55 import Control.Monad ( when )
   56 import Darcs.SlurpDirectory ( FileContents, Slurpy, withSlurpy, slurp_modfile )
   57 import RegChars ( regChars )
   58 import Darcs.Repository.Prefs ( change_prefval )
   59 import Darcs.Global ( darcsdir )
   60 import Darcs.IO ( WriteableDirectory(..), ReadableDirectory(..) )
   61 import Darcs.FilePathMonad ( withFilePaths )
   62 #include "impossible.h"
   63 import Darcs.Ordered ( FL(..), (:>)(..),
   64                              mapFL, mapFL_FL, spanFL, foldlFL )
   65 \end{code}
   66 
   67 
   68 
   69 \section{Introduction}
   70 
   71 A patch describes a change to the tree.  It could be either a primitive
   72 patch (such as a file add/remove, a directory rename, or a hunk replacement
   73 within a file), or a composite patch describing many such changes.  Every
   74 patch type must satisfy the conditions described in this appendix.  The
   75 theory of patches is independent of the data which the patches manipulate,
   76 which is what makes it both powerful and useful, as it provides a framework
   77 upon which one can build a revision control system in a sane manner.
   78 
   79 Although in a sense, the defining property of any patch is that it can be
   80 applied to a certain tree, and thus make a certain change, this change does
   81 not wholly define the patch.  A patch is defined by a
   82 \emph{representation}, together with a set of rules for how it behaves
   83 (which it has in common with its patch type).  The \emph{representation} of
   84 a patch defines what change that particular patch makes, and must be
   85 defined in the context of a specific tree.  The theory of patches is a
   86 theory of the many ways one can change the representation of a patch to
   87 place it in the context of a different tree.  The patch itself is not
   88 changed, since it describes a single change, which must be the same
   89 regardless of its representation\footnote{For those comfortable with
   90 quantum mechanics, think of a patch as a quantum mechanical operator, and
   91 the representation as the basis set.  The analogy breaks down pretty
   92 quickly, however, since an operator could be described in any complete
   93 basis set, while a patch modifying the file {\tt foo} can only be described
   94 in the rather small set of contexts which have a file {\tt foo} to be
   95 modified.}.
   96 
   97 So how does one define a tree, or the context of a patch? The simplest way
   98 to define a tree is as the result of a series of patches applied to the
   99 empty tree\footnote{This is very similar to the second-quantized picture,
  100 in which any state is seen as the result of a number of creation operators
  101 acting on the vacuum, and provides a similar set of simplifications---in
  102 particular, the exclusion principle is very elegantly enforced by the
  103 properties of the anti-hermitian fermion creation operators.}.  Thus, the
  104 context of a patch consists of the set of patches that precede it.
  105 
  106 \section{Applying patches}
  107 
  108 
  109 \begin{code}
  110 apply_to_filepaths :: Apply p => p C(x y) -> [FilePath] -> [FilePath]
  111 apply_to_filepaths pa fs = withFilePaths fs (apply [] pa)
  112 
  113 apply_to_slurpy :: (Apply p, Monad m) => p C(x y) -> Slurpy -> m Slurpy
  114 apply_to_slurpy p s = case withSlurpy s (apply [] p) of
  115                           Left err -> fail err
  116                           Right (s', ()) -> return s'
  117 
  118 instance Apply p => Apply (Named p) where
  119     apply opts (NamedP _ _ p) = apply opts p
  120     applyAndTryToFix (NamedP n d p) = mapMaybeSnd (NamedP n d) `fmap` applyAndTryToFix p
  121 
  122 instance Apply Patch where
  123     apply opts p = applyFL opts $ effect p
  124     applyAndTryToFixFL (PP x) = mapMaybeSnd (mapFL_FL PP) `fmap` applyAndTryToFixFL x
  125     applyAndTryToFixFL (ComP xs) = mapMaybeSnd (\xs' -> ComP xs' :>: NilFL) `fmap` applyAndTryToFix xs
  126     applyAndTryToFixFL x = do apply [] x; return Nothing
  127     applyAndTryToFix (ComP xs) = mapMaybeSnd ComP `fmap` applyAndTryToFix xs
  128     applyAndTryToFix x = do mapMaybeSnd ComP `fmap` applyAndTryToFixFL x
  129 
  130 force_replace_slurpy :: Prim C(x y) -> Slurpy -> Maybe Slurpy
  131 force_replace_slurpy (FP f (TokReplace tcs old new)) s =
  132     slurp_modfile f (forceTokReplace tcs old new) s
  133 force_replace_slurpy _ _ = bug "Can only force_replace_slurpy on a replace."                                                                                                      
  134 
  135 instance Apply Prim where
  136     apply opts (Split ps) = applyFL opts ps
  137     apply _ Identity = return ()
  138     apply _ (FP f RmFile) = mRemoveFile f
  139     apply _ (FP f AddFile) = mCreateFile f
  140     apply opts p@(FP _ (Hunk _ _ _)) = applyFL opts (p :>: NilFL)
  141     apply _ (FP f (TokReplace t o n)) = mModifyFilePSs f doreplace
  142         where doreplace ls =
  143                   case mapM (try_tok_internal t (BC.pack o) (BC.pack n)) ls of
  144                   Nothing -> fail $ "replace patch to " ++ fn2fp f
  145                              ++ " couldn't apply."
  146                   Just ls' -> return $ map B.concat ls'
  147     apply _ (FP f (Binary o n)) = mModifyFilePS f doapply
  148         where doapply oldf = if o == oldf
  149                              then return n
  150                              else fail $ "binary patch to " ++ fn2fp f
  151                                   ++ " couldn't apply."
  152     apply _ (DP d AddDir) = mCreateDirectory d
  153     apply _ (DP d RmDir) = mRemoveDirectory d
  154     apply _ (Move f f') = mRename f f'
  155     apply _ (ChangePref p f t) =
  156         do b <- mDoesDirectoryExist (fp2fn $ darcsdir++"/prefs")
  157            when b $ change_prefval p f t
  158     applyAndTryToFixFL (FP f RmFile) =
  159         do x <- mReadFilePS f
  160            if B.null x then do mRemoveFile f
  161                                return Nothing
  162                        else do mWriteFilePS f B.empty
  163                                mRemoveFile f
  164                                return $ Just ("WARNING: Fixing removal of non-empty file "++fn2fp f,
  165                                               FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )
  166     applyAndTryToFixFL p = do apply [] p; return Nothing
  167 
  168 applyFL :: WriteableDirectory m => [DarcsFlag] -> FL Prim C(x y) -> m ()
  169 applyFL _ NilFL = return ()
  170 applyFL opts ((FP f h@(Hunk _ _ _)):>:the_ps)
  171  = case spanFL f_hunk the_ps of
  172        (xs :> ps') ->
  173            do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs
  174               mModifyFilePS f $ hunkmod foo
  175               case h of
  176                 (Hunk 1 _ (n:_)) | BC.pack "#!" `B.isPrefixOf` n &&
  177                                    SetScriptsExecutable `elem` opts
  178                                  -> mSetFileExecutable f True
  179                 _ -> return ()
  180               applyFL opts ps'
  181     where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True
  182           f_hunk _ = False
  183           hunkmod :: WriteableDirectory m => FL FilePatchType C(x y)
  184                   -> B.ByteString -> m B.ByteString
  185           hunkmod NilFL ps = return ps
  186           hunkmod (Hunk line old new:>:hs) ps
  187            = case applyHunkLines [(line,old,new)] ps of
  188                  Just ps' -> hunkmod hs ps'
  189                  Nothing -> fail $ "Error applying hunk to file " ++ fn2fp f
  190           hunkmod _ _ = impossible                                                                                                      
  191 applyFL opts (p:>:ps) = do apply opts p
  192                            applyFL opts ps
  193 \end{code}
  194 
  195 \subsection{Hunk patches}
  196 
  197 Hunks are an example of a complex filepatch.  A hunk is a set of lines of a
  198 text file to be replaced by a different set of lines.  Either of these sets
  199 may be empty, which would mean a deletion or insertion of lines.
  200 \begin{code}
  201 applyHunks :: [(Int, [B.ByteString], [B.ByteString])]
  202            -> B.ByteString -> Maybe [B.ByteString]
  203 applyHunks [] ps = Just [ps]
  204 applyHunks ((l, [], n):hs) ps
  205     = case break_before_nth_newline (l - 2) ps of
  206       (prfix, after_prefix) -> do rest <- applyHunks hs after_prefix
  207                                   return $ intersperse nl (prfix:n) ++ rest
  208                                        where nl = BC.singleton '\n'
  209 applyHunks ((l, o, n):hs) ps
  210     = case break_before_nth_newline (l - 2) ps of
  211       (prfix, after_prefix) ->
  212           case break_before_nth_newline (length o) after_prefix of
  213           (oo, _) | oo /= unlinesPS (B.empty:o) -> fail "applyHunks error"
  214           (_, suffix) ->
  215               do rest <- applyHunks hs suffix
  216                  return $ intersperse nl (prfix:n) ++ rest
  217     where nl = BC.singleton '\n'
  218 
  219 applyHunkLines :: [(Int, [B.ByteString], [B.ByteString])]
  220                -> FileContents -> Maybe FileContents
  221 applyHunkLines [] c = Just c
  222 applyHunkLines [(1, [], n)] ps | B.null ps = Just $ unlinesPS (n++[B.empty])
  223 applyHunkLines hs@((l, o, n):hs') ps =
  224  do pss <- case l of
  225            1 -> case break_after_nth_newline (length o) ps of
  226                 Nothing -> if ps == unlinesPS o
  227                            then return $ intersperse nl n
  228                            else fail "applyHunkLines: Unexpected hunks"
  229                 Just (shouldbeo, suffix)
  230                     | shouldbeo /= unlinesPS (o++[B.empty]) ->
  231                         fail $ "applyHunkLines: Bad patch!"
  232                     | null n ->
  233                         do x <- applyHunkLines hs' suffix
  234                            return [x]
  235                     | otherwise ->
  236                         do rest <- applyHunks hs' suffix
  237                            return $ intersperse nl n ++ nl:rest
  238            _ | l < 0 -> bug "Prim.applyHunkLines: After -ve lines?"                                                                                                      
  239              | otherwise -> applyHunks hs ps
  240     let result = B.concat pss
  241     return result
  242     where nl = BC.singleton '\n'
  243 \end{code}
  244 
  245 \subsection{Token replace patches}\label{token_replace}
  246 
  247 Although most filepatches will be hunks, darcs is clever enough to support
  248 other types of changes as well.  A ``token replace'' patch replaces all
  249 instances of a given token with some other version.  A token, here, is
  250 defined by a regular expression, which must be of the simple [a--z\ldots]\ type,
  251 indicating which characters are allowed in a token, with all other
  252 characters acting as delimiters.  For example, a C identifier would be a
  253 token with the flag \verb![A-Za-z_0-9]!.
  254 
  255 \begin{code}
  256 forceTokReplace :: String -> String -> String
  257                 -> FileContents -> Maybe FileContents
  258 forceTokReplace t os ns c = Just $ unlinesPS $ map forceReplace $ linesPS c
  259     where o = BC.pack os
  260           n = BC.pack ns
  261           tokchar = regChars t
  262           toks_and_intratoks ps | B.null ps = []
  263           toks_and_intratoks ps =
  264               let (before,s') = BC.break tokchar ps
  265                   (tok, after) = BC.break (not . tokchar) s'
  266                   in before : tok : toks_and_intratoks after
  267           forceReplace ps = B.concat $ map o_t_n $ toks_and_intratoks ps
  268           o_t_n s | s == o = n
  269                   | otherwise = s
  270 \end{code}
  271 
  272 What makes the token replace patch special is the fact that a token replace
  273 can be merged with almost any ordinary hunk, giving exactly what you would
  274 want.  For example, you might want to change the patch type {\tt
  275 TokReplace} to {\tt TokenReplace} (if you decided that saving two
  276 characters of space was stupid).  If you did this using hunks, it would
  277 modify every line where {\tt TokReplace} occurred, and quite likely provoke
  278 a conflict with another patch modifying those lines.  On the other hand, if
  279 you did this using a token replace patch, the only change that it could
  280 conflict with would be if someone else had used the token ``{\tt
  281 TokenReplace}'' in their patch rather than TokReplace---and that actually
  282 would be a real conflict!
  283 
  284 %\section{Outputting interesting and useful information}
  285 
  286 %Just being able to manipulate patches and trees is not enough.  We also
  287 %want to be able to view the patches and files.  This requires another set
  288 %of functions, closely related to the patch application functions, which
  289 %will give us the necessary information to browse the changes we have made.
  290 %It is \emph{not} the Patch module's responsibility to add any sort of
  291 %markup or formatting, but simply to provide the information necessary for an
  292 %external module to do the formatting.
  293 
  294 \begin{code}
  295 data LineMark = AddedLine PatchInfo | RemovedLine PatchInfo
  296               | AddedRemovedLine PatchInfo PatchInfo | None
  297                 deriving (Show)
  298 type MarkedUpFile = [(B.ByteString, LineMark)]
  299 empty_markedup_file :: MarkedUpFile
  300 empty_markedup_file = [(B.empty, None)]
  301 
  302 markup_file :: Effect p => PatchInfo -> p C(x y)
  303             -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
  304 markup_file x p = mps (effect p)
  305     where mps :: FL Prim C(a b) -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
  306           mps NilFL = id
  307           mps (pp:>:pps) = mps pps . markup_prim x pp
  308 
  309 markup_prim :: PatchInfo -> Prim C(x y)
  310             -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
  311 markup_prim _ (Split NilFL) (f, mk) = (f, mk)
  312 markup_prim n (Split (p:>:ps)) (f, mk) = markup_prim n (Split ps) $
  313                                        markup_prim n p (f, mk)
  314 markup_prim _ (FP _ AddFile) (f, mk) = (f, mk)
  315 markup_prim _ (FP _ RmFile) (f, mk) = (f, mk)
  316 markup_prim n (FP f' (Hunk line old new)) (f, mk)
  317     | fn2fp f' /= f = (f, mk)
  318     | otherwise = (f, markup_hunk n line old new mk)
  319 markup_prim name (FP f' (TokReplace t o n)) (f, mk)
  320     | fn2fp f' /= f = (f, mk)
  321     | otherwise = (f, markup_tok name t o n mk)
  322 markup_prim _ (DP _ _) (f, mk) = (f, mk)
  323 markup_prim _ (Move d d') (f, mk) = (fn2fp $ movedirfilename d d' (fp2fn f), mk)
  324 markup_prim _ (ChangePref _ _ _) (f,mk) = (f,mk)
  325 markup_prim _ Identity (f,mk) = (f,mk)
  326 markup_prim n (FP f' (Binary _ _)) (f,mk)
  327     | fn2fp f' == f = (f,(BC.pack "Binary file", AddedLine n):mk)
  328     | otherwise = (f,mk)
  329 
  330 markup_hunk :: PatchInfo -> Int -> [B.ByteString] -> [B.ByteString]
  331             -> MarkedUpFile -> MarkedUpFile
  332 markup_hunk n l old new ((sf, RemovedLine pi):mk) =
  333     (sf, RemovedLine pi) : markup_hunk n l old new mk
  334 markup_hunk n l old new ((sf, AddedRemovedLine po pn):mk) =
  335     (sf, AddedRemovedLine po pn) : markup_hunk n l old new mk
  336 
  337 markup_hunk name 1 old (n:ns) mk =
  338     (n, AddedLine name) : markup_hunk name 1 old ns mk
  339 markup_hunk n 1 (o:os) [] ((sf, None):mk)
  340     | o == sf = (sf, RemovedLine n) : markup_hunk n 1 os [] mk
  341     | otherwise = [(BC.pack "Error in patch application", AddedLine n)]
  342 markup_hunk n 1 (o:os) [] ((sf, AddedLine nold):mk)
  343     | o == sf = (sf, AddedRemovedLine nold n) : markup_hunk n 1 os [] mk
  344     | otherwise = [(BC.pack "Error in patch application", AddedLine n)]
  345 markup_hunk _ 1 [] [] mk = mk
  346 
  347 markup_hunk n l old new ((sf, AddedLine pi):mk)
  348     | l > 1 = (sf, AddedLine pi) : markup_hunk n (l-1) old new mk
  349     | l < 1 = (sf, AddedLine pi) : markup_hunk n (l-1) old new mk
  350 markup_hunk n l old new ((sf, None):mk)
  351     | l > 1 = (sf, None) : markup_hunk n (l-1) old new mk
  352     | l < 1 = (sf, None) : markup_hunk n (l-1) old new mk
  353 
  354 markup_hunk _ _ _ _ [] = []
  355 
  356 markup_hunk _ _ _ _ mk = (BC.pack "Error: ",None) : mk
  357 
  358 markup_tok :: PatchInfo -> String -> String -> String
  359            -> MarkedUpFile -> MarkedUpFile
  360 markup_tok name t ostr nstr mk = concatMap mt mk
  361     where o = BC.pack ostr
  362           n = BC.pack nstr
  363           mt (sf, AddedLine pi) =
  364               case B.concat `fmap` try_tok_internal t o n sf of
  365               Just sf' | sf' == sf -> [(sf, AddedLine pi)]
  366                        | otherwise -> [(sf, AddedRemovedLine pi name),
  367                                        (sf', AddedLine name)]
  368               Nothing ->
  369                   [(sf, AddedLine pi),
  370                    (BC.pack "There seems to be an inconsistency...", None),
  371                    (BC.pack "Please run darcs check.", None)]
  372           mt mark = [mark]
  373 \end{code}
  374 
  375 %files or directories, changed by a patch
  376 %we get it solely from the patch here
  377 %instead of performing patch apply on a population
  378 %we !could! achieve the same by applying a patch to a cleaned population
  379 %and getting modified files and dirs
  380 %but this should be significantly slower when the population grows large
  381 %This could be useful for just presenting a summary of what a patch does
  382 %(especially useful for larger repos)
  383 
  384 \begin{code}
  385 patchChanges :: Prim C(x y) -> [(String,DirMark)]
  386 patchChanges (Move f1 f2) = [(fn2fp f1,MovedFile $ fn2fp f2),
  387                              (fn2fp f2,MovedFile $ fn2fp f1)]
  388 patchChanges (DP d AddDir) = [(fn2fp d,AddedDir)]
  389 patchChanges (DP d RmDir) = [(fn2fp d,RemovedDir)]
  390 patchChanges (FP f AddFile) = [(fn2fp f,AddedFile)]
  391 patchChanges (FP f RmFile) = [(fn2fp f,RemovedFile)]
  392 patchChanges (FP f _) = [(fn2fp f,ModifiedFile)]
  393 patchChanges (Split ps) = concat $ mapFL patchChanges ps
  394 patchChanges (ChangePref _ _ _) = []
  395 patchChanges Identity = []
  396 \end{code}
  397 
  398 %apply a patch to a population at a given time
  399 
  400 \begin{code}
  401 applyToPop :: PatchInfo -> FL Prim C(x y) -> Population -> Population
  402 applyToPop _ NilFL = id
  403 applyToPop pinf (p:>:ps) = applyToPop pinf ps . applyToPop' pinf p 
  404 
  405 applyToPop'
  406     :: PatchInfo -> Prim C(x y) -> Population -> Population
  407 applyToPop' pi patch (Pop _ tree)
  408  = Pop pi (applyToPopTree patch tree)
  409    -- ``pi'' is global below!
  410  where applyToPopTree :: Prim C(x y) -> PopTree -> PopTree
  411        applyToPopTree (Split ps) tr =
  412         foldlFL (\t p -> applyToPopTree p t) tr ps
  413        applyToPopTree p@(FP f AddFile) tr =
  414            let xxx = BC.split '/' (fn2ps  f) in
  415                popChange xxx p $ fst $ breakP xxx tr
  416        applyToPopTree p@(FP f _) tr = popChange (BC.split '/' (fn2ps  f)) p tr
  417        applyToPopTree p@(DP f AddDir) tr =
  418            let xxx = BC.split '/' (fn2ps  f) in
  419                popChange xxx p $ fst $ breakP xxx tr
  420        applyToPopTree p@(DP d _) tr = popChange (BC.split '/' (fn2ps  d)) p tr
  421        -- precondition: ``to'' does not exist yet!
  422        applyToPopTree (Move from to) tr
  423         = case breakP (BC.split '/' (fn2ps from)) $
  424                fst $ breakP (BC.split '/' $ fn2ps to) tr of
  425            (tr',Just ins) ->
  426                let to' = (BC.split '/' (fn2ps to))
  427                    ins' = case ins of
  428                           PopDir i trs -> PopDir (i {nameI = last to',
  429                                                      modifiedByI = pi,
  430                                                      modifiedHowI = MovedDir (fn2fp from)})
  431                                                  trs
  432                           PopFile i -> PopFile (i {nameI = last to',
  433                                                    modifiedByI = pi,
  434                                                    modifiedHowI = MovedFile (fn2fp from)})
  435                              in insertP to' tr' ins'
  436            _ -> tr -- ignore the move if ``from'' couldn't be found
  437        applyToPopTree (ChangePref _ _ _) tr = tr
  438        applyToPopTree Identity tr = tr
  439 
  440        -- insert snd arg into fst arg
  441        insertP :: [B.ByteString] -> PopTree -> PopTree -> PopTree
  442        insertP [parent,_] org@(PopDir f trs) tr
  443         | parent == (nameI f) = PopDir f (tr:trs)
  444         | otherwise = org
  445        insertP (n:rest) org@(PopDir f trs) tr
  446         | (nameI f) == n = PopDir f trs'
  447         | otherwise = org
  448           where trs' = map (\o -> insertP rest o tr) trs
  449        insertP _ org _ = org
  450 
  451        -- change a population according to a patch
  452        popChange :: [B.ByteString] -> Prim C(x y) -> PopTree -> PopTree
  453        popChange [parent,path] (DP d AddDir) tr@(PopDir f trs)
  454         | parent == (nameI f) = PopDir f (new:trs)
  455         | otherwise = tr
  456               where new = PopDir (Info {nameI = path,
  457                                         modifiedByI = pi,
  458                                         modifiedHowI = AddedDir,
  459                                         createdByI = Just pi,
  460                                         creationNameI = Just $ fn2ps d}) []
  461        -- only mark a directory (and contents) as ``deleted'' do not delete it actually
  462        popChange [path] (DP _ RmDir) tr@(PopDir f trs)
  463         | path == (nameI f) = PopDir (f {modifiedByI = pi,
  464                                          modifiedHowI = RemovedDir}) trs'
  465         | otherwise = tr
  466           where trs' = map markDel trs -- recursively ``delete'' the contents
  467 
  468        popChange [parent,path] (FP d AddFile) tr@(PopDir f trs)
  469         | parent == (nameI f) = PopDir f (new:trs)
  470         | otherwise = tr
  471               where new = PopFile (Info {nameI = path,
  472                                          modifiedByI = pi,
  473                                          modifiedHowI = AddedFile,
  474                                          createdByI = Just pi,
  475                                          creationNameI = Just $ fn2ps d})
  476        popChange [path] (FP _ RmFile) tr@(PopFile f)
  477         | path == (nameI f) = PopFile (f {modifiedByI = pi,
  478                                          modifiedHowI = RemovedFile})
  479         | otherwise = tr
  480        popChange [path] (FP _ _) (PopFile f)
  481         | path == (nameI f)
  482            = PopFile (f {modifiedByI = pi,
  483                          modifiedHowI = if modifiedHowI f == AddedFile && modifiedByI f == pi
  484                                         then AddedFile
  485                                         else ModifiedFile})
  486        popChange (n:rest) p tr@(PopDir f trs)
  487         | (nameI f) == n = PopDir f (map (popChange rest p) trs)
  488         | otherwise = tr
  489        popChange _ _ tr = tr
  490        markDel (PopDir f trs) = PopDir (f {modifiedByI = pi,
  491                                            modifiedHowI = RemovedDir}) trs'
  492                 where trs' = map markDel trs
  493        markDel (PopFile f) = PopFile (f {modifiedByI = pi,
  494                                          modifiedHowI = RemovedFile})
  495 
  496 -- break a poptree fst: org tree with subtree removed,
  497 --                 snd: removed subtree
  498 breakP :: [B.ByteString] -> PopTree -> (PopTree,Maybe PopTree)
  499 breakP [parent,path] tr@(PopDir f trees)
  500  | parent == (nameI f) = case findRem path trees of
  501                          Just (trees',tree') -> (PopDir f trees',Just tree')
  502                          _ -> (tr,Nothing)
  503  | otherwise = (tr,Nothing)
  504  where findRem _ [] = Nothing
  505        findRem the_path (d:trs)
  506         | the_path == pname d = Just (trs,d)
  507         | otherwise = do (trs',d') <- findRem the_path trs
  508                          return (d:trs',d')
  509 breakP (n:rest) tr@(PopDir f trs)
  510  | (nameI f) == n = case catMaybes inss of
  511                     [ins] -> (PopDir f trs', Just ins)
  512                     [] -> (tr,Nothing)
  513                     _ -> error "breakP: more than one break"
  514  | otherwise = (tr,Nothing)
  515    where (trs',inss) = unzip (map (breakP rest) trs)
  516 breakP _ tr = (tr,Nothing)
  517 
  518 pname :: PopTree -> B.ByteString
  519 pname (PopDir i _) = nameI i
  520 pname (PopFile i) = nameI i
  521 \end{code}
  522