src/Darcs/Patch/Apply.lhs

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