% 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. \begin{code}

    {-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
    {-# LANGUAGE CPP #-}

    #include "gadts.h"

    module Darcs.Patch.Apply ( applyToFilepaths, applyToSlurpy,
                               forceTokReplace,
                               markupFile, emptyMarkedupFile,
                               patchChanges,
                               applyToPop,
                               applyToTree,
                               LineMark(..), MarkedUpFile,
                               forceReplaceSlurpy )
        where

    import Prelude hiding ( catch, pi )
    import Darcs.Flags ( DarcsFlag( SetScriptsExecutable ) )

    import qualified Data.ByteString.Char8 as BC (split, break, pack, singleton)

    import qualified Data.ByteString       as B (ByteString, null, empty, concat, isPrefixOf)
    import ByteStringUtils ( linesPS, unlinesPS, break_after_nth_newline, break_before_nth_newline, )

    import Darcs.Patch.FileName ( fn2ps, fn2fp, fp2fn,
                                  movedirfilename )
    import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..) )
    import Data.List ( intersperse )
    import Data.Maybe ( catMaybes )
    import Darcs.Patch.Patchy ( Apply, apply, applyAndTryToFixFL, applyAndTryToFix,
                                mapMaybeSnd )
    import Darcs.Patch.Commute ()
    import Darcs.Patch.Core ( Patch(..), Named(..) )
    import Darcs.Patch.Prim ( Prim(..), Effect(effect),
                              DirPatchType(..), FilePatchType(..),
                              try_tok_internal )
    import Darcs.Patch.Info ( PatchInfo )
    import Control.Monad ( when )
    import Darcs.SlurpDirectory ( FileContents, Slurpy, withSlurpy, slurp_modfile )
    import Darcs.Patch.RegChars ( regChars )
    import Darcs.Repository.Prefs ( changePrefval )
    import Darcs.Global ( darcsdir )
    import Darcs.IO ( WriteableDirectory(..), ReadableDirectory(..) )
    import Darcs.FilePathMonad ( withFilePaths )
    #include "impossible.h"
    import Darcs.Witnesses.Ordered ( FL(..), (:>)(..),
                                 mapFL, mapFL_FL, spanFL, foldlFL )

    import Storage.Hashed.Tree( Tree )
    import Storage.Hashed.Monad( virtualTreeIO )

\end{code} \section{Introduction} A patch describes a change to the tree. It could be either a primitive patch (such as a file add/remove, a directory rename, or a hunk replacement within a file), or a composite patch describing many such changes. Every patch type must satisfy the conditions described in this appendix. The theory of patches is independent of the data which the patches manipulate, which is what makes it both powerful and useful, as it provides a framework upon which one can build a revision control system in a sane manner. Although in a sense, the defining property of any patch is that it can be applied to a certain tree, and thus make a certain change, this change does not wholly define the patch. A patch is defined by a \emph{representation}, together with a set of rules for how it behaves (which it has in common with its patch type). The \emph{representation} of a patch defines what change that particular patch makes, and must be defined in the context of a specific tree. The theory of patches is a theory of the many ways one can change the representation of a patch to place it in the context of a different tree. The patch itself is not changed, since it describes a single change, which must be the same regardless of its representation\footnote{For those comfortable with quantum mechanics, think of a patch as a quantum mechanical operator, and the representation as the basis set. The analogy breaks down pretty quickly, however, since an operator could be described in any complete basis set, while a patch modifying the file {\tt foo} can only be described in the rather small set of contexts which have a file {\tt foo} to be modified.}. So how does one define a tree, or the context of a patch? The simplest way to define a tree is as the result of a series of patches applied to the empty tree\footnote{This is very similar to the second-quantized picture, in which any state is seen as the result of a number of creation operators acting on the vacuum, and provides a similar set of simplifications---in particular, the exclusion principle is very elegantly enforced by the properties of the anti-hermitian fermion creation operators.}. Thus, the context of a patch consists of the set of patches that precede it. \section{Applying patches} \begin{code}

    applyToFilepaths :: Apply p => p C(x y) -> [FilePath] -> [FilePath]
    applyToFilepaths pa fs = withFilePaths fs (apply [] pa)

    applyToSlurpy :: (Apply p, Monad m) => p C(x y) -> Slurpy -> m Slurpy
    applyToSlurpy p s = case withSlurpy s (apply [] p) of
                              Left err -> fail err
                              Right (s', ()) -> return s'

    instance Apply p => Apply (Named p) where
        apply opts (NamedP _ _ p) = apply opts p
        applyAndTryToFix (NamedP n d p) = mapMaybeSnd (NamedP n d) `fmap` applyAndTryToFix p

    instance Apply Patch where
        apply opts p = applyFL opts $ effect p
        applyAndTryToFixFL (PP x) = mapMaybeSnd (mapFL_FL PP) `fmap` applyAndTryToFixFL x
        applyAndTryToFixFL (ComP xs) = mapMaybeSnd (\xs' -> ComP xs' :>: NilFL) `fmap` applyAndTryToFix xs
        applyAndTryToFixFL x = do apply [] x; return Nothing
        applyAndTryToFix (ComP xs) = mapMaybeSnd ComP `fmap` applyAndTryToFix xs
        applyAndTryToFix x = do mapMaybeSnd ComP `fmap` applyAndTryToFixFL x

    forceReplaceSlurpy :: Prim C(x y) -> Slurpy -> Maybe Slurpy
    forceReplaceSlurpy (FP f (TokReplace tcs old new)) s =
        slurp_modfile f (forceTokReplace tcs old new) s
    forceReplaceSlurpy _ _ = bug "Can only forceReplaceSlurpy on a replace."

    instance Apply Prim where
        apply opts (Split ps) = applyFL opts ps
        apply _ Identity = return ()
        apply _ (FP f RmFile) = mRemoveFile f
        apply _ (FP f AddFile) = mCreateFile f
        apply opts p@(FP _ (Hunk _ _ _)) = applyFL opts (p :>: NilFL)
        apply _ (FP f (TokReplace t o n)) = mModifyFilePSs f doreplace
            where doreplace ls =
                      case mapM (try_tok_internal t (BC.pack o) (BC.pack n)) ls of
                      Nothing -> fail $ "replace patch to " ++ fn2fp f
                                 ++ " couldn't apply."
                      Just ls' -> return $ map B.concat ls'
        apply _ (FP f (Binary o n)) = mModifyFilePS f doapply
            where doapply oldf = if o == oldf
                                 then return n
                                 else fail $ "binary patch to " ++ fn2fp f
                                      ++ " couldn't apply."
        apply _ (DP d AddDir) = mCreateDirectory d
        apply _ (DP d RmDir) = mRemoveDirectory d
        apply _ (Move f f') = mRename f f'
        apply _ (ChangePref p f t) =
            do b <- mDoesDirectoryExist (fp2fn $ darcsdir++"/prefs")
               when b $ changePrefval p f t
        applyAndTryToFixFL (FP f RmFile) =
            do x <- mReadFilePS f
               if B.null x then do mRemoveFile f
                                   return Nothing
                           else do mWriteFilePS f B.empty
                                   mRemoveFile f
                                   return $ Just ("WARNING: Fixing removal of non-empty file "++fn2fp f,
                                                  FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )
        applyAndTryToFixFL p = do apply [] p; return Nothing

    applyFL :: WriteableDirectory m => [DarcsFlag] -> FL Prim C(x y) -> m ()
    applyFL _ NilFL = return ()
    applyFL opts ((FP f h@(Hunk _ _ _)):>:the_ps)
     = case spanFL f_hunk the_ps of
           (xs :> ps') ->
               do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs
                  mModifyFilePS f $ hunkmod foo
                  case h of
                    (Hunk 1 _ (n:_)) | BC.pack "#!" `B.isPrefixOf` n &&
                                       SetScriptsExecutable `elem` opts
                                     -> mSetFileExecutable f True
                    _ -> return ()
                  applyFL opts ps'
        where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True
              f_hunk _ = False
              hunkmod :: WriteableDirectory m => FL FilePatchType C(x y)
                      -> B.ByteString -> m B.ByteString
              hunkmod NilFL ps = return ps
              hunkmod (Hunk line old new:>:hs) ps
               = case applyHunkLines [(line,old,new)] ps of
                     Just ps' -> hunkmod hs ps'
                     Nothing -> fail $ "Error applying hunk to file " ++ fn2fp f
              hunkmod _ _ = impossible
    applyFL opts (p:>:ps) = do apply opts p
                               applyFL opts ps

\end{code} \subsection{Hunk patches} Hunks are an example of a complex filepatch. A hunk is a set of lines of a text file to be replaced by a different set of lines. Either of these sets may be empty, which would mean a deletion or insertion of lines. \begin{code}

    applyHunks :: [(Int, [B.ByteString], [B.ByteString])]
               -> B.ByteString -> Maybe [B.ByteString]
    applyHunks [] ps = Just [ps]
    applyHunks ((l, [], n):hs) ps
        = case break_before_nth_newline (l - 2) ps of
          (prfix, after_prefix) -> do rest <- applyHunks hs after_prefix
                                      return $ intersperse nl (prfix:n) ++ rest
                                           where nl = BC.singleton '\n'
    applyHunks ((l, o, n):hs) ps
        = case break_before_nth_newline (l - 2) ps of
          (prfix, after_prefix) ->
              case break_before_nth_newline (length o) after_prefix of
              (oo, _) | oo /= unlinesPS (B.empty:o) -> fail "applyHunks error"
              (_, suffix) ->
                  do rest <- applyHunks hs suffix
                     return $ intersperse nl (prfix:n) ++ rest
        where nl = BC.singleton '\n'

    applyHunkLines :: [(Int, [B.ByteString], [B.ByteString])]
                   -> FileContents -> Maybe FileContents
    applyHunkLines [] c = Just c
    applyHunkLines [(1, [], n)] ps | B.null ps = Just $ unlinesPS (n++[B.empty])
    applyHunkLines hs@((l, o, n):hs') ps =
     do pss <- case l of
               1 -> case break_after_nth_newline (length o) ps of
                    Nothing -> if ps == unlinesPS o
                               then return $ intersperse nl n
                               else fail "applyHunkLines: Unexpected hunks"
                    Just (shouldbeo, suffix)
                        | shouldbeo /= unlinesPS (o++[B.empty]) ->
                            fail $ "applyHunkLines: Bad patch!"
                        | null n ->
                            do x <- applyHunkLines hs' suffix
                               return [x]
                        | otherwise ->
                            do rest <- applyHunks hs' suffix
                               return $ intersperse nl n ++ nl:rest
               _ | l < 0 -> bug "Prim.applyHunkLines: After -ve lines?"
                 | otherwise -> applyHunks hs ps
        let result = B.concat pss
        return result
        where nl = BC.singleton '\n'

\end{code} \subsection{Token replace patches}\label{token_replace} Although most filepatches will be hunks, darcs is clever enough to support other types of changes as well. A ``token replace'' patch replaces all instances of a given token with some other version. A token, here, is defined by a regular expression, which must be of the simple [a--z\ldots]\ type, indicating which characters are allowed in a token, with all other characters acting as delimiters. For example, a C identifier would be a token with the flag \verb![A-Za-z_0-9]!. \begin{code}

    forceTokReplace :: String -> String -> String
                    -> FileContents -> Maybe FileContents
    forceTokReplace t os ns c = Just $ unlinesPS $ map forceReplace $ linesPS c
        where o = BC.pack os
              n = BC.pack ns
              tokchar = regChars t
              toks_and_intratoks ps | B.null ps = []
              toks_and_intratoks ps =
                  let (before,s') = BC.break tokchar ps
                      (tok, after) = BC.break (not . tokchar) s'
                      in before : tok : toks_and_intratoks after
              forceReplace ps = B.concat $ map o_t_n $ toks_and_intratoks ps
              o_t_n s | s == o = n
                      | otherwise = s

\end{code} What makes the token replace patch special is the fact that a token replace can be merged with almost any ordinary hunk, giving exactly what you would want. For example, you might want to change the patch type {\tt TokReplace} to {\tt TokenReplace} (if you decided that saving two characters of space was stupid). If you did this using hunks, it would modify every line where {\tt TokReplace} occurred, and quite likely provoke a conflict with another patch modifying those lines. On the other hand, if you did this using a token replace patch, the only change that it could conflict with would be if someone else had used the token ``{\tt TokenReplace}'' in their patch rather than TokReplace---and that actually would be a real conflict! %\section{Outputting interesting and useful information} %Just being able to manipulate patches and trees is not enough. We also %want to be able to view the patches and files. This requires another set %of functions, closely related to the patch application functions, which %will give us the necessary information to browse the changes we have made. %It is \emph{not} the Patch module's responsibility to add any sort of %markup or formatting, but simply to provide the information necessary for an %external module to do the formatting. \begin{code}

    data LineMark = AddedLine PatchInfo | RemovedLine PatchInfo
                  | AddedRemovedLine PatchInfo PatchInfo | None
                    deriving (Show)
    type MarkedUpFile = [(B.ByteString, LineMark)]
    emptyMarkedupFile :: MarkedUpFile
    emptyMarkedupFile = [(B.empty, None)]

    markupFile :: Effect p => PatchInfo -> p C(x y)
                -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
    markupFile x p = mps (effect p)
        where mps :: FL Prim C(a b) -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
              mps NilFL = id
              mps (pp:>:pps) = mps pps . markup_prim x pp

    markup_prim :: PatchInfo -> Prim C(x y)
                -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
    markup_prim _ (Split NilFL) (f, mk) = (f, mk)
    markup_prim n (Split (p:>:ps)) (f, mk) = markup_prim n (Split ps) $
                                           markup_prim n p (f, mk)
    markup_prim _ (FP _ AddFile) (f, mk) = (f, mk)
    markup_prim _ (FP _ RmFile) (f, mk) = (f, mk)
    markup_prim n (FP f' (Hunk line old new)) (f, mk)
        | fn2fp f' /= f = (f, mk)
        | otherwise = (f, markup_hunk n line old new mk)
    markup_prim name (FP f' (TokReplace t o n)) (f, mk)
        | fn2fp f' /= f = (f, mk)
        | otherwise = (f, markup_tok name t o n mk)
    markup_prim _ (DP _ _) (f, mk) = (f, mk)
    markup_prim _ (Move d d') (f, mk) = (fn2fp $ movedirfilename d d' (fp2fn f), mk)
    markup_prim _ (ChangePref _ _ _) (f,mk) = (f,mk)
    markup_prim _ Identity (f,mk) = (f,mk)
    markup_prim n (FP f' (Binary _ _)) (f,mk)
        | fn2fp f' == f = (f,(BC.pack "Binary file", AddedLine n):mk)
        | otherwise = (f,mk)

    markup_hunk :: PatchInfo -> Int -> [B.ByteString] -> [B.ByteString]
                -> MarkedUpFile -> MarkedUpFile
    markup_hunk n l old new ((sf, RemovedLine pi):mk) =
        (sf, RemovedLine pi) : markup_hunk n l old new mk
    markup_hunk n l old new ((sf, AddedRemovedLine po pn):mk) =
        (sf, AddedRemovedLine po pn) : markup_hunk n l old new mk

    markup_hunk name 1 old (n:ns) mk =
        (n, AddedLine name) : markup_hunk name 1 old ns mk
    markup_hunk n 1 (o:os) [] ((sf, None):mk)
        | o == sf = (sf, RemovedLine n) : markup_hunk n 1 os [] mk
        | otherwise = [(BC.pack "Error in patch application", AddedLine n)]
    markup_hunk n 1 (o:os) [] ((sf, AddedLine nold):mk)
        | o == sf = (sf, AddedRemovedLine nold n) : markup_hunk n 1 os [] mk
        | otherwise = [(BC.pack "Error in patch application", AddedLine n)]
    markup_hunk _ 1 [] [] mk = mk

    markup_hunk n l old new ((sf, AddedLine pi):mk)
        | l > 1 = (sf, AddedLine pi) : markup_hunk n (l-1) old new mk
        | l < 1 = (sf, AddedLine pi) : markup_hunk n (l-1) old new mk
    markup_hunk n l old new ((sf, None):mk)
        | l > 1 = (sf, None) : markup_hunk n (l-1) old new mk
        | l < 1 = (sf, None) : markup_hunk n (l-1) old new mk

    markup_hunk _ _ _ _ [] = []

    markup_hunk _ _ _ _ mk = (BC.pack "Error: ",None) : mk

    markup_tok :: PatchInfo -> String -> String -> String
               -> MarkedUpFile -> MarkedUpFile
    markup_tok name t ostr nstr mk = concatMap mt mk
        where o = BC.pack ostr
              n = BC.pack nstr
              mt (sf, AddedLine pi) =
                  case B.concat `fmap` try_tok_internal t o n sf of
                  Just sf' | sf' == sf -> [(sf, AddedLine pi)]
                           | otherwise -> [(sf, AddedRemovedLine pi name),
                                           (sf', AddedLine name)]
                  Nothing ->
                      [(sf, AddedLine pi),
                       (BC.pack "There seems to be an inconsistency...", None),
                       (BC.pack "Please run darcs check.", None)]
              mt mark = [mark]

\end{code} %files or directories, changed by a patch %we get it solely from the patch here %instead of performing patch apply on a population %we !could! achieve the same by applying a patch to a cleaned population %and getting modified files and dirs %but this should be significantly slower when the population grows large %This could be useful for just presenting a summary of what a patch does %(especially useful for larger repos) \begin{code}

    patchChanges :: Prim C(x y) -> [(String,DirMark)]
    patchChanges (Move f1 f2) = [(fn2fp f1,MovedFile $ fn2fp f2),
                                 (fn2fp f2,MovedFile $ fn2fp f1)]
    patchChanges (DP d AddDir) = [(fn2fp d,AddedDir)]
    patchChanges (DP d RmDir) = [(fn2fp d,RemovedDir)]
    patchChanges (FP f AddFile) = [(fn2fp f,AddedFile)]
    patchChanges (FP f RmFile) = [(fn2fp f,RemovedFile)]
    patchChanges (FP f _) = [(fn2fp f,ModifiedFile)]
    patchChanges (Split ps) = concat $ mapFL patchChanges ps
    patchChanges (ChangePref _ _ _) = []
    patchChanges Identity = []

\end{code} %apply a patch to a population at a given time \begin{code}

    applyToPop :: PatchInfo -> FL Prim C(x y) -> Population -> Population
    applyToPop _ NilFL = id
    applyToPop pinf (p:>:ps) = applyToPop pinf ps . applyToPop' pinf p

    applyToPop'
        :: PatchInfo -> Prim C(x y) -> Population -> Population
    applyToPop' pi patch (Pop _ tree)
     = Pop pi (applyToPopTree patch tree)
       -- ``pi'' is global below!
     where applyToPopTree :: Prim C(x y) -> PopTree -> PopTree
           applyToPopTree (Split ps) tr =
            foldlFL (\t p -> applyToPopTree p t) tr ps
           applyToPopTree p@(FP f AddFile) tr =
               let xxx = BC.split '/' (fn2ps  f) in
                   popChange xxx p $ fst $ breakP xxx tr
           applyToPopTree p@(FP f _) tr = popChange (BC.split '/' (fn2ps  f)) p tr
           applyToPopTree p@(DP f AddDir) tr =
               let xxx = BC.split '/' (fn2ps  f) in
                   popChange xxx p $ fst $ breakP xxx tr
           applyToPopTree p@(DP d _) tr = popChange (BC.split '/' (fn2ps  d)) p tr
           -- precondition: ``to'' does not exist yet!
           applyToPopTree (Move from to) tr
            = case breakP (BC.split '/' (fn2ps from)) $
                   fst $ breakP (BC.split '/' $ fn2ps to) tr of
               (tr',Just ins) ->
                   let to' = (BC.split '/' (fn2ps to))
                       ins' = case ins of
                              PopDir i trs -> PopDir (i {nameI = last to',
                                                         modifiedByI = pi,
                                                         modifiedHowI = MovedDir (fn2fp from)})
                                                     trs
                              PopFile i -> PopFile (i {nameI = last to',
                                                       modifiedByI = pi,
                                                       modifiedHowI = MovedFile (fn2fp from)})
                                 in insertP to' tr' ins'
               _ -> tr -- ignore the move if ``from'' couldn't be found
           applyToPopTree (ChangePref _ _ _) tr = tr
           applyToPopTree Identity tr = tr

           -- insert snd arg into fst arg
           insertP :: [B.ByteString] -> PopTree -> PopTree -> PopTree
           insertP [parent,_] org@(PopDir f trs) tr
            | parent == (nameI f) = PopDir f (tr:trs)
            | otherwise = org
           insertP (n:rest) org@(PopDir f trs) tr
            | (nameI f) == n = PopDir f trs'
            | otherwise = org
              where trs' = map (\o -> insertP rest o tr) trs
           insertP _ org _ = org

           -- change a population according to a patch
           popChange :: [B.ByteString] -> Prim C(x y) -> PopTree -> PopTree
           popChange [parent,path] (DP d AddDir) tr@(PopDir f trs)
            | parent == (nameI f) = PopDir f (new:trs)
            | otherwise = tr
                  where new = PopDir (Info {nameI = path,
                                            modifiedByI = pi,
                                            modifiedHowI = AddedDir,
                                            createdByI = Just pi,
                                            creationNameI = Just $ fn2ps d}) []
           -- only mark a directory (and contents) as ``deleted'' do not delete it actually
           popChange [path] (DP _ RmDir) tr@(PopDir f trs)
            | path == (nameI f) = PopDir (f {modifiedByI = pi,
                                             modifiedHowI = RemovedDir}) trs'
            | otherwise = tr
              where trs' = map markDel trs -- recursively ``delete'' the contents

           popChange [parent,path] (FP d AddFile) tr@(PopDir f trs)
            | parent == (nameI f) = PopDir f (new:trs)
            | otherwise = tr
                  where new = PopFile (Info {nameI = path,
                                             modifiedByI = pi,
                                             modifiedHowI = AddedFile,
                                             createdByI = Just pi,
                                             creationNameI = Just $ fn2ps d})
           popChange [path] (FP _ RmFile) tr@(PopFile f)
            | path == (nameI f) = PopFile (f {modifiedByI = pi,
                                             modifiedHowI = RemovedFile})
            | otherwise = tr
           popChange [path] (FP _ _) (PopFile f)
            | path == (nameI f)
               = PopFile (f {modifiedByI = pi,
                             modifiedHowI = if modifiedHowI f == AddedFile && modifiedByI f == pi
                                            then AddedFile
                                            else ModifiedFile})
           popChange (n:rest) p tr@(PopDir f trs)
            | (nameI f) == n = PopDir f (map (popChange rest p) trs)
            | otherwise = tr
           popChange _ _ tr = tr
           markDel (PopDir f trs) = PopDir (f {modifiedByI = pi,
                                               modifiedHowI = RemovedDir}) trs'
                    where trs' = map markDel trs
           markDel (PopFile f) = PopFile (f {modifiedByI = pi,
                                             modifiedHowI = RemovedFile})

    -- break a poptree fst: org tree with subtree removed,
    --                 snd: removed subtree
    breakP :: [B.ByteString] -> PopTree -> (PopTree,Maybe PopTree)
    breakP [parent,path] tr@(PopDir f trees)
     | parent == (nameI f) = case findRem path trees of
                             Just (trees',tree') -> (PopDir f trees',Just tree')
                             _ -> (tr,Nothing)
     | otherwise = (tr,Nothing)
     where findRem _ [] = Nothing
           findRem the_path (d:trs)
            | the_path == pname d = Just (trs,d)
            | otherwise = do (trs',d') <- findRem the_path trs
                             return (d:trs',d')
    breakP (n:rest) tr@(PopDir f trs)
     | (nameI f) == n = case catMaybes inss of
                        [ins] -> (PopDir f trs', Just ins)
                        [] -> (tr,Nothing)
                        _ -> error "breakP: more than one break"
     | otherwise = (tr,Nothing)
       where (trs',inss) = unzip (map (breakP rest) trs)
    breakP _ tr = (tr,Nothing)

    pname :: PopTree -> B.ByteString
    pname (PopDir i _) = nameI i
    pname (PopFile i) = nameI i

    -- | Apply a patch to a 'Tree', yielding a new 'Tree'.
    applyToTree :: (Apply p) => p C(x y) -> Tree IO -> IO (Tree IO)
    applyToTree patch t = snd `fmap` virtualTreeIO (apply [] patch) t

\end{code}