[darcs-users] recent darcs patches from unstable

David Roundy droundy at darcs.net
Tue Oct 14 12:24:45 UTC 2008


On Tue, Oct 14, 2008 at 10:22:28AM +0100, Eric Kow wrote:
> Hi David,
> 
> These look safe to pull into stable now.  I'll be pushing them by
> tonight unless you or somebody else shouts.
> 
> Sorry for the delay.  Still catching up from the freeze!

No problem!

> > Wed Oct  8 18:22:07 BST 2008  David Roundy <droundy at darcs.net>
> >   * make writeSlurpy work properly when given "."
> > 
> > Wed Oct  8 18:27:48 BST 2008  David Roundy <droundy at darcs.net>
> >   * refactor Match to handle --store-in-memory itself.
> > 
> > Thu Oct  9 17:58:45 BST 2008  David Roundy <droundy at darcs.net>
> >   * fix incompatibilities with ghc 6.6
> > 
> > Fri Oct 10 20:10:51 BST 2008  David Roundy <droundy at darcs.net>
> >   * remove reimplementation of zipWith.
> > 
> > Sat Oct 11 17:10:59 BST 2008  David Roundy <droundy at darcs.net>
> >   * resolve issue1139: make special cases handle no arguments gracefully.
> 
> 
> make writeSlurpy work properly when given "."
> ---------------------------------------------
> > hunk ./src/Darcs/SlurpDirectory.lhs 190
> > +writeSlurpy s "." = withCurrentDirectory "." $ write_files s (list_slurpy s)
> >  writeSlurpy s d = do
> >    createDirectory d
> >    withCurrentDirectory d $ write_files s (list_slurpy s)
> 
> I'm not sure I understand the original safety feature here.  Is it just
> the exception that createDirectory throws with darcs (presumably) dying?

Right, which means that writeSlurpy can't accidentally clobber user data.
An alternate approach would be to createDirectoryIfMissing, but I felt that
the safety of not overwriting data would be good to keep.  writeSlurpy
really wants to run in an empty directory (since it doesn't check things,
and could die, for instance, if a directory already exists with the same
name as a file in the slurpy).

> refactor Match to handle --store-in-memory itself.
> --------------------------------------------------
> > +               else map sp2fn `fmap` fixSubPaths opts args
> >    thename <- return $ just_dir formerdir
> >    withTempDir ("old-"++thename) $ \odir -> do
> >      setCurrentDirectory formerdir
> > hunk ./src/Darcs/Commands/Diff.lhs 197
> >      withTempDir ("new-"++thename) $ \ndir -> do
> >      if first_match opts
> >         then withCurrentDirectory odir $
> > -            if StoreInMemory `elem` opts
> > -            then apply_patches_to_some_files repository path_list (get_first_match_s opts)
> > -            else get_first_match repository opts
> > +            get_partial_first_match repository opts path_list
> >         else createPartialsPristineDirectoryTree repository path_list (toFilePath odir)
> >      if second_match opts
> >         then withCurrentDirectory ndir $
> > hunk ./src/Darcs/Commands/Diff.lhs 201
> > -            if StoreInMemory `elem` opts
> > -            then apply_patches_to_some_files repository path_list (get_second_match_s opts)
> > -            else get_second_match repository opts
> > +            get_partial_second_match repository opts path_list
> >         else do (_, s) <- slurp_recorded_and_unrecorded repository
> > hunk ./src/Darcs/Commands/Diff.lhs 203
> > -               let ps = concatMap (get_path_list s) path_list
> > +               let ps = concatMap (get_path_list s . toFilePath) path_list
> >                 clonePaths formerdir (toFilePath ndir) ps
> >      thediff <- withCurrentDirectory (toFilePath odir ++ "/..") $
> >                     case path_list of
> > hunk ./src/Darcs/Commands/Diff.lhs 208
> >                     [] -> rundiff (just_dir $ toFilePath odir) (just_dir $ toFilePath ndir)
> > -                   fs -> vcat `liftM` mapM (\f -> rundiff
> > -                                            (just_dir (toFilePath odir) ++ "/" ++ f)
> > -                                            (just_dir (toFilePath ndir) ++ "/" ++ f)) fs
> > +                   fs -> vcat `liftM`
> > +                         mapM (\f -> rundiff
> > +                               (just_dir (toFilePath odir) ++ "/" ++ toFilePath f)
> > +                               (just_dir (toFilePath ndir) ++ "/" ++ toFilePath f)) fs
> >      morepatches <- read_repo repository
> >      putDocLn $ changelog (get_diff_info opts morepatches)
> >              $$ thediff
> > hunk ./src/Darcs/Commands/Dist.lhs 30
> >  
> >  import Darcs.Commands
> >  import Darcs.Arguments
> > -import Darcs.Match ( get_nonrange_match, get_nonrange_match_s,
> > -                     apply_patches_to_some_files, have_nonrange_match )
> > +import Darcs.Match ( get_nonrange_match, have_nonrange_match )
> >  import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,
> >                            createPartialsPristineDirectoryTree )
> >  import Darcs.Repository.Prefs ( get_prefval )
> > hunk ./src/Darcs/Commands/Dist.lhs 109
> >        setCurrentDirectory (formerdir)
> >        withTempDir (toFilePath tempdir++"/"++(basename distname)) $ \ddir -> do
> >          if have_nonrange_match opts
> > -          then withCurrentDirectory ddir $
> > -             if StoreInMemory `elem` opts
> > -             then apply_patches_to_some_files repository path_list (get_nonrange_match_s opts)
> > -             else get_nonrange_match repository opts
> > +          then withCurrentDirectory ddir $ get_nonrange_match repository opts
> >            else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
> >          case predist of Nothing -> return ExitSuccess
> >                          Just pd -> system pd
> > hunk ./src/Darcs/Commands/ShowContents.lhs 23
> >  module Darcs.Commands.ShowContents ( show_contents ) where
> >  
> >  import Control.Monad ( filterM )
> > -import System.Directory( doesFileExist )
> >  import System.IO ( stdout )
> >  
> > hunk ./src/Darcs/Commands/ShowContents.lhs 25
> > -import FastPackedString ( readFilePS, hPutPS )
> > +import FastPackedString ( hPutPS )
> >  import Workaround ( getCurrentDirectory )
> > hunk ./src/Darcs/Commands/ShowContents.lhs 27
> > -import Darcs.Utils ( withCurrentDirectory )
> >  
> >  import Darcs.Commands ( DarcsCommand(..), nodefaults )
> >  import Darcs.Arguments ( DarcsFlag, match_one,
> > hunk ./src/Darcs/Commands/ShowContents.lhs 32
> >                           working_repo_dir, fixSubPaths )
> >  import Darcs.FilePathUtils ( just_dir )
> > -import Darcs.RepoPath ( toFilePath )
> > -import Darcs.Match ( get_nonrange_match_s, have_nonrange_match, apply_patches_to_some_files,
> > -                   )
> > -import Darcs.Repository ( withRepository, ($-), findRepository )
> > -import Darcs.Repository ( createPartialsPristineDirectoryTree )
> > +import Darcs.RepoPath ( toFilePath, sp2fn )
> > +import Darcs.IO ( mReadFilePS, mDoesFileExist )
> > +import Darcs.Match ( get_partial_nonrange_match, have_nonrange_match )
> > +import Darcs.Repository ( withRepository, ($-), findRepository,
> > +                          createPartialsPristineDirectoryTree )
> >  import Darcs.Lock ( withTempDir )
> >  \end{code}
> >  
> > hunk ./src/Darcs/Commands/ShowContents.lhs 72
> >  show_contents_cmd :: [DarcsFlag] -> [String] -> IO ()
> >  show_contents_cmd opts args = withRepository opts $- \repository -> do
> >    formerdir <- getCurrentDirectory
> > -  path_list <- map toFilePath `fmap` fixSubPaths opts args
> > +  path_list <- map sp2fn `fmap` fixSubPaths opts args
> >    thename <- return $ just_dir formerdir
> >    withTempDir thename $ \dir -> do
> >       if have_nonrange_match opts
> > hunk ./src/Darcs/Commands/ShowContents.lhs 76
> > -        then withCurrentDirectory dir $
> > -               apply_patches_to_some_files repository path_list $ get_nonrange_match_s opts
> > +        then get_partial_nonrange_match repository opts path_list
> >          else createPartialsPristineDirectoryTree repository path_list (toFilePath dir)
> > hunk ./src/Darcs/Commands/ShowContents.lhs 78
> > -     filterM doesFileExist path_list >>= mapM_ (\f -> readFilePS f >>= hPutPS stdout)
> > +     filterM mDoesFileExist path_list >>= mapM_ (\f -> mReadFilePS f >>= hPutPS stdout)
> >  \end{code}
> > hunk ./src/Darcs/Match.lhs 19
> >  %  Boston, MA 02110-1301, USA.
> >  
> >  \begin{code}
> > -{-# OPTIONS_GHC -cpp #-}
> > +{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
> >  #include "gadts.h"
> >  module Darcs.Match ( match_first_patchset, match_second_patchset,
> >                 match_patch,
> > hunk ./src/Darcs/Match.lhs 24
> >                 match_a_patch, doesnt_not_match, match_a_patchread,
> > -               get_first_match, get_second_match, get_first_match_s, get_second_match_s,
> > -               get_nonrange_match, get_nonrange_match_s,
> > +               get_first_match, get_nonrange_match,
> > +               get_partial_first_match, get_partial_second_match,
> > +               get_partial_nonrange_match,
> >                 first_match, second_match, have_nonrange_match,
> > hunk ./src/Darcs/Match.lhs 28
> > -               have_patchset_match, get_one_patchset, apply_patches_to_some_files,
> > +               have_patchset_match, get_one_patchset,
> >                 checkMatchSyntax,
> >               ) where
> >  
> > hunk ./src/Darcs/Match.lhs 48
> >  
> >  import FastPackedString ( mmapFilePS )
> >  import Darcs.Flags ( DarcsFlag( OnePatch, SeveralPatch, Context,
> > +                                StoreInMemory,
> >                                 AfterPatch, UpToPatch, LastN, PatchIndexRange,
> >                                 OneTag, AfterTag, UpToTag,
> >                                 OnePattern, SeveralPattern,
> > hunk ./src/Darcs/Match.lhs 60
> >  
> >  import Darcs.RepoPath ( toFilePath )
> >  import Darcs.IO ( WriteableDirectory(..), ReadableDirectory(..) )
> > -import Darcs.SlurpDirectory ( SlurpMonad, withSlurpy )
> > -import Darcs.Patch.FileName (fp2fn, FileName, super_name, norm_path, (///))
> > +import Darcs.SlurpDirectory ( SlurpMonad, writeSlurpy, withSlurpy )
> > +import Darcs.Patch.FileName ( FileName, super_name, norm_path, (///) )
> >  import FastPackedString (PackedString)
> >  import Darcs.Sealed ( FlippedSeal(..), Sealed2(..),
> >                        seal, flipSeal, seal2, unsealFlipped, unseal2, unseal )
> > hunk ./src/Darcs/Match.lhs 116
> >            hasC (_:xs) = hasC xs
> >  
> >  get_nonrange_match :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()
> > -get_nonrange_match r fs =
> > -    case nonrange_matcher fs of
> > -      Just m  -> if nonrange_matcher_is_tag fs
> > -                 then get_tag r m
> > -                 else get_matcher Exclusive r m
> > -      Nothing -> fail "Pattern not specified in get_nonrange_match."
> > +get_nonrange_match r fs = withRecordedMatchSmart fs r $ get_nonrange_match_s fs
> > +
> > +get_partial_nonrange_match :: RepoPatch p => Repository p C(r u t)
> > +                           -> [DarcsFlag] -> [FileName] -> IO ()
> > +get_partial_nonrange_match r fs files =
> > +    withRecordedMatchOnlySomeSmart fs r files $ get_nonrange_match_s fs
> >  
> > hunk ./src/Darcs/Match.lhs 123
> > -get_nonrange_match_s :: RepoPatch p => [DarcsFlag] -> PatchSet p C(x) -> SlurpMonad ()
> > +get_nonrange_match_s :: (MatchMonad m p, RepoPatch p) =>
> > +                        [DarcsFlag] -> PatchSet p C(x) -> m ()
> >  get_nonrange_match_s fs repo =
> >      case nonrange_matcher fs of
> >          Just m -> if nonrange_matcher_is_tag fs
> > hunk ./src/Darcs/Match.lhs 128
> > -                        then get_tag_s repo m
> > -                        else get_matcher_s Exclusive repo m
> > +                        then get_tag_s m repo
> > +                        else get_matcher_s Exclusive m repo
> >          Nothing -> fail "Pattern not specified in get_nonrange_match."
> >  
> >  first_match :: [DarcsFlag] -> Bool
> > hunk ./src/Darcs/Match.lhs 137
> >                   || isJust (has_index_range fs)
> >  
> >  get_first_match :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()
> > -get_first_match r fs =
> > -    case has_lastn fs of
> > -    Just n -> get_dropn r n
> > -    Nothing -> case first_matcher fs of
> > -               Nothing -> fail "Pattern not specified in get_first_match."
> > -               Just m -> if first_matcher_is_tag fs
> > -                         then get_tag r m
> > -                         else get_matcher Inclusive r m
> > +get_first_match r fs = withRecordedMatchSmart fs r $ get_first_match_s fs
> > +
> > +get_partial_first_match :: RepoPatch p => Repository p C(r u t)
> > +                        -> [DarcsFlag] -> [FileName] -> IO ()
> > +get_partial_first_match r fs files =
> > +    withRecordedMatchOnlySomeSmart fs r files $ get_first_match_s fs
> >  
> > hunk ./src/Darcs/Match.lhs 144
> > -get_first_match_s :: RepoPatch p => [DarcsFlag] -> PatchSet p C(x) -> SlurpMonad ()
> > +get_first_match_s :: (MatchMonad m p, RepoPatch p) =>
> > +                     [DarcsFlag] -> PatchSet p C(x) -> m ()
> >  get_first_match_s fs repo =
> >      case has_lastn fs of
> > hunk ./src/Darcs/Match.lhs 148
> > -    Just n -> get_dropn_s repo n
> > +    Just n -> applyInvRL `unsealFlipped` (safetake n $ concatRL repo)
> >      Nothing -> case first_matcher fs of
> >                 Nothing -> fail "Pattern not specified in get_first_match."
> >                 Just m -> if first_matcher_is_tag fs
> > hunk ./src/Darcs/Match.lhs 152
> > -                         then get_tag_s repo m
> > -                         else get_matcher_s Inclusive repo m
> > +                         then get_tag_s m repo
> > +                         else get_matcher_s Inclusive m repo
> >  
> >  
> >  second_match :: [DarcsFlag] -> Bool
> > hunk ./src/Darcs/Match.lhs 159
> >  second_match fs = isJust (second_matcher fs::Maybe (Matcher Patch)) || isJust (has_index_range fs)
> >  
> > -get_second_match :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()
> > -get_second_match r fs =
> > +get_partial_second_match :: RepoPatch p => Repository p C(r u t)
> > +                        -> [DarcsFlag] -> [FileName] -> IO ()
> > +get_partial_second_match r fs files =
> > +    withRecordedMatchOnlySomeSmart fs r files $ \repo ->
> >      case second_matcher fs of
> >      Nothing -> fail "Two patterns not specified in get_second_match."
> >      Just m -> if second_matcher_is_tag fs
> > hunk ./src/Darcs/Match.lhs 166
> > -              then get_tag r m
> > -              else get_matcher Exclusive r m
> > -
> > -
> > -get_second_match_s :: RepoPatch p => [DarcsFlag] -> PatchSet p C(x) -> SlurpMonad ()
> > -get_second_match_s fs repo =
> > -    case second_matcher fs of
> > -    Nothing -> fail "Two patterns not specified in get_second_match."
> > -    Just m -> if second_matcher_is_tag fs
> > -              then get_tag_s repo m
> > -              else get_matcher_s Exclusive repo m
> > +              then get_tag_s m repo
> > +              else get_matcher_s Exclusive m repo
> >  
> >  checkMatchSyntax :: [DarcsFlag] -> IO ()
> >  checkMatchSyntax opts = do
> > hunk ./src/Darcs/Match.lhs 359
> >  \end{code}
> >  
> >  \begin{code}
> > -get_matcher :: RepoPatch p => InclusiveOrExclusive -> Repository p C(r u t) -> Matcher p -> IO ()
> > -get_matcher ioe r m =
> > -    do repo <- read_repo r
> > -       if match_exists m repo
> > -          then do createPristineDirectoryTree r "."
> > -                  apply_inv_to_matcher ioe m repo
> > -          else fail $ "Couldn't match pattern "++ show m
> > -
> >  apply_inv_to_matcher :: (RepoPatch p, WriteableDirectory m) => InclusiveOrExclusive -> Matcher p -> PatchSet p C(x) -> m ()
> >  apply_inv_to_matcher _ _ NilRL = impossible
> >  apply_inv_to_matcher ioe m (NilRL:<:xs) = apply_inv_to_matcher ioe m xs
> > hunk ./src/Darcs/Match.lhs 366
> >      | apply_matcher m p = when (ioe == Inclusive) (apply_invp p)
> >      | otherwise = apply_invp p >> apply_inv_to_matcher ioe m (ps:<:xs)
> >  
> > -maybe_read_file :: FileName -> SlurpMonad ([(FileName, PackedString)])
> > +maybe_read_file :: ReadableDirectory m => FileName -> m ([(FileName, PackedString)])
> >  maybe_read_file file = do
> >      d <- mDoesDirectoryExist file
> >      if d
> > hunk ./src/Darcs/Match.lhs 386
> >                        y <- maybe_read_files fs
> >                        return $ concat [x,y]
> >  
> > -get_file_contents :: RepoPatch p => Repository p C(r u t) -> [FilePath] -> (PatchSet p C(r) -> SlurpMonad())
> > -                  -> IO ([(FileName, PackedString)])
> > -get_file_contents r files gf = do
> > -    s <- slurp_recorded r
> > -    repo <- read_repo r
> > -    case withSlurpy s (gf repo >>  mapM ( maybe_read_file . fp2fn) files) of
> > -      Left err -> fail err
> > -      Right (_, ret) -> return $ concat ret
> > -
> > -apply_patches_to_some_files :: RepoPatch p => Repository p C(r u t) -> [FilePath]
> > -                            -> (PatchSet p C(r) -> SlurpMonad()) -> IO ()
> > -apply_patches_to_some_files r files gf = do
> > -    fcs <- get_file_contents r files gf
> > -    writeFiles fcs
> > -  where writeFiles [] = return ()
> > -        writeFiles ((p, c):xs) = (ensureDirectories $ super_name p) >> ( mWriteFilePS p c) >> writeFiles xs
> > -        ensureDirectories d = do
> > -          isPar <- mDoesDirectoryExist d
> > -          if isPar
> > -            then return ()
> > -            else ensureDirectories (super_name d) >> (mCreateDirectory d)
> > -
> > -get_matcher_s :: RepoPatch p => InclusiveOrExclusive -> PatchSet p C(x) -> Matcher p -> SlurpMonad ()
> > -get_matcher_s ioe repo m =
> > +get_matcher_s :: (MatchMonad m p, RepoPatch p) =>
> > +                 InclusiveOrExclusive -> Matcher p -> PatchSet p C(x) -> m ()
> > +get_matcher_s ioe m repo =
> >      if match_exists m repo
> >      then apply_inv_to_matcher ioe m repo
> >      else fail $ "Couldn't match pattern "++ show m
> > hunk ./src/Darcs/Match.lhs 393
> >  
> > -get_dropn_s :: RepoPatch p => PatchSet p C(x) -> Int -> SlurpMonad ()
> > -get_dropn_s repo n = applyInvRL `unsealFlipped` (safetake n $ concatRL repo)
> > -
> > -get_tag_s :: RepoPatch p => PatchSet p C(x) -> Matcher p -> SlurpMonad ()
> > -get_tag_s repo match = do
> > +get_tag_s :: (MatchMonad m p, RepoPatch p) =>
> > +             Matcher p -> PatchSet p C(x) -> m ()
> > +get_tag_s match repo = do
> >      let pinfo = patch2patchinfo `unseal2` (find_a_patch match repo)
> >      case get_patches_beyond_tag pinfo repo of
> >          FlippedSeal (extras:<:NilRL) -> applyInvRL $ extras
> > hunk ./src/Darcs/Match.lhs 401
> >          _ -> impossible
> >  
> > -applyInvRL :: (Patchy p, WriteableDirectory m) => RL (PatchInfoAnd p) C(x y) -> m ()
> 
> moved to typeclass below
> 
> > -get_dropn :: RepoPatch p => Repository p C(r u t) -> Int -> IO ()
> 
> redundant with new MatchMonad
>
> > -get_tag :: RepoPatch p => Repository p C(r u t) -> Matcher p -> IO ()
> > -get_tag r match = do
> > -    ps <- read_repo r
> > -    let pinfo = patch2patchinfo `unseal2` (find_a_patch match ps)
> > -    case get_patches_beyond_tag pinfo ps of
> > -        FlippedSeal (extras:<:NilRL) -> do createPristineDirectoryTree r "."
> > -                                           apply_patches [] $ invertRL extras
> > -        _ -> impossible
> 
> > +class (RepoPatch p, WriteableDirectory m) => MatchMonad m p where
> 
> For the interested: One recurring theme in the match code was to invert
> the matched patches and apply them to the current recorded state.
> Normally we apply incrementally directly to a temporary directory.  Now
> we want to capture the idea of /optionally/ applying everything to a
> slurpy first and then writing the resulting slurpy to disk.  This seems
> like it would be faster, although I guess the reason we don't /always/
> do this is that it could take up a lot of memory.

Yes, previously we had duplicates of every function, one that stored the
intermediate slurpy in memory, and one that worked directly on disk.

> Anyway, the new withSmart functions let us hide the implementation
> details so that we just see the end result in IO.  Under the hood, we
> just use the most appropriate MatchMonad to do the job.
> 
> NB: the potentially icky bit in the darcs code is that we assume we have
> already cd'ed into the temporary directory where we unapply patches.

Yes, we could potentially rework these functions to create the directories
they're using.

> > +    -- withRecordedMatch is responsible for getting the recorded state
> > +    -- into the monad, and then applying the second argument, and
> > +    -- finally placing the resulting state into the current directory.
> 
> These comments could easily be made into haddocks ;-)

By someone who knows the haddock syntax...  :) (or has a haddock that they
can run on darcs to test their syntax)

> > +    withRecordedMatch :: Repository p C(r u t)
> > +                      -> (PatchSet p C(r) -> m ()) -> IO ()
> > +    -- withRecordedMatchOnlySomeFiles is a variant of
> > +    -- withRecordedMatch that may only return some of the files
> > +    -- (e.g. if we want to run diff on just a few files).
> > +    withRecordedMatchOnlySomeFiles
> > +        :: Repository p C(r u t) -> [FileName]
> > +        -> (PatchSet p C(r) -> m ()) -> IO ()
> > +    withRecordedMatchOnlySomeFiles r _ j = withRecordedMatch r j
> > +    applyInvRL :: RL (PatchInfoAnd p) C(x r) -> m ()
> > +    applyInvRL NilRL = return ()
> > +    applyInvRL (p:<:ps) = apply_invp p >> applyInvRL ps
> 
> > +withRecordedMatchIO :: RepoPatch p => Repository p C(r u t)
> > +                    -> (PatchSet p C(r) -> IO ()) -> IO ()
> > +withRecordedMatchIO = withRecordedMatch
> 
> > +withRecordedMatchSmart :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)
> > +                       -> (forall m. MatchMonad m p => PatchSet p C(r) -> m ())
> > +                       -> IO ()
> 
> The 'smartness' here is just that it avoids using withRecordedMatchIO if
> we asked for StoreInMemory.  For symmetry with withRecordedMatchOnlySomeSmart,
> we would perhaps do away with withRecordedMatchIO, making it just a
> withIO helper.

Yeah, it's a sort of stupid name...

> > +withRecordedMatchOnlySomeSmart :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)
> > +                       -> [FileName]
> > +                       -> (forall m. MatchMonad m p => PatchSet p C(r) -> m ())
> > +                       -> IO ()
> 
> For the interested, the way to parse this name is as the smart version
> of withRecordedMatchOnlySome (as opposed to 'only smart on some').  It
> just applies the right version of withRecordedMatchOnlySomeFiles, where
> right means 'SlurpMonad' if sm
> 
> > +instance RepoPatch p => MatchMonad SlurpMonad p where
> > +    withRecordedMatch r job =
> > +        do ps <- read_repo r
> > +           s <- slurp_recorded r
> > +           case withSlurpy s (job ps) of
> > +             Left err -> fail err
> > +             Right (s',_) -> writeSlurpy s' "."
> 
> Note the new withSlurpy s "." that David implemented in the previous
> match.

s/match/patch/? Anyhow, withSlurpy has been around for quite a while, I
believe...

> > +    withRecordedMatchOnlySomeFiles r fs job =
> > +        do ps <- read_repo r
> > +           s <- slurp_recorded r
> > +           case withSlurpy s (job ps >> mapM maybe_read_file fs) of
> > +             Left err -> fail err
> > +             Right (_,fcs) -> mapM_ createAFile $ concat fcs
> > +               where createAFile (p,c) = do ensureDirectories $ super_name p
> > +                                            mWriteFilePS p c
> > +                     ensureDirectories d =
> > +                         do isPar <- mDoesDirectoryExist d
> > +                            if isPar
> > +                              then return ()
> > +                              else do ensureDirectories $ super_name d
> > +                                      mCreateDirectory d
> > +
> >  \end{code}
> 
> remove reimplementation of zipWith.
> -----------------------------------
> > -map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
> > -map2 _ [] [] = []
> > -map2 f (a:as) (b:bs) = f a b : map2 f as bs
> > -map2 _ _ _ = bug "map2 in mv given lists of differing lengths!"
> 
> One potentially worry is that we lose this length check.
> 
> The list-extras package implements a 'safe' zip like our map2 and some
> other handy list functions
>   http://hackage.haskell.org/cgi-bin/hackage-scripts/package/list-extras
> 
> Maybe it's worth the extra dependency?

I don't think so, I don't recall this check having ever caught a bug...

> resolve issue1139: make special cases handle no arguments gracefully.
> ---------------------------------------------------------------------
> > -       else createPartialsPristineDirectoryTree repository path_list (toFilePath odir)
> > +       else if null path_list
> > +            then createPristineDirectoryTree repository (toFilePath odir)
> > +            else createPartialsPristineDirectoryTree repository path_list (toFilePath odir)
> 
> > +               if null path_list
> > +                  then withCurrentDirectory ndir $ writeSlurpy s "."
> > +                  else clonePaths formerdir (toFilePath ndir) ps
> 
> I'm guessing that what broke was removing the code that set the
> path_list to [""] if it was null on the user command line.  How was
> a pathlist of "" supposed to work anyway
>
> Anyway, the fix seems to make sense (no paths means do this on the whole
> repository).  Do the other commands, dist and show contents need a similar fix?

Right, that's exactly the hack that I removed.  [""] was treated as a special
case indicating that we want everything.  I just made it so [] is treated
as the same special case, which makes a bit more sense to me.
-- 
David Roundy
http://www.darcs.net
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://lists.osuosl.org/pipermail/darcs-users/attachments/20081014/cd60544f/attachment-0001.pgp 


More information about the darcs-users mailing list