Hi,
Reinier Lamers <[EMAIL PROTECTED]> writes:
> Here's a bundle against the current unstable. It also adds some tests as
> Jason
> suggested over IRC. I even found a new bug with those tests, but it's not in
> my lstat-saving code (see issue1196).
review comments interspersed.
> [add a get_unrecorded_in_files to check for unrecorded changes in a subset of
> working directory
> [EMAIL PROTECTED]
> Ignore-this: 7d36ff983e8745049101a92f5b2326fb
> ] hunk ./src/Darcs/Diff.lhs 26
>
> #include "gadts.h"
>
> -module Darcs.Diff ( unsafeDiff, sync, cmp
> +module Darcs.Diff ( diff_at_path, unsafeDiff, sync, cmp
> #ifndef GADT_WITNESSES
> , diff_files
> #endif
> hunk ./src/Darcs/Diff.lhs 53
> import qualified Data.ByteString as B (hGet, length)
>
> import Darcs.SlurpDirectory ( Slurpy, slurp_name, is_dir, is_file,
> +#ifndef GADT_WITNESSES
> + get_slurp,
> +#endif
> get_dircontents, get_filecontents,
> get_mtime, get_length,
> undefined_time
> hunk ./src/Darcs/Diff.lhs 73
> , binary, invert
> #endif
> )
> +#ifndef GADT_WITNESSES
> +import Darcs.Patch.FileName( fp2fn, breakup )
> +#endif
> import System.IO ( openBinaryFile )
> import Darcs.Repository.Prefs ( FileType(..) )
> import Darcs.Flags ( DarcsFlag(..) )
> hunk ./src/Darcs/Diff.lhs 88
> #ifndef GADT_WITNESSES
> #include "impossible.h"
> #endif
> +
> +-- | The diff_at_path function compares what two slurpies have at a certain
> +-- location. This is useful when the user requests a diff for a file that
> +-- is created or removed in the working copy: then there is no slurpy for
> +-- the file in the /current/ or /working/ slurpy respectively.
> +--
> +-- The given paths must always be fixed repository paths starting with a
> +-- ".".
> +--
> +-- It returns Nothing if there is nothing at the given location in both
> +-- slurpies, and the differences between what's there in the slurpies in
> +-- all other cases.
> +diff_at_path :: [DarcsFlag] -> (FilePath -> FileType) ->
> + Slurpy -> Slurpy -> FilePath -> Maybe (FL Prim C(x y))
> +#ifdef GADT_WITNESSES
> +diff_at_path = undefined
> +#else
> +diff_at_path opts filetypeFunction s1 s2 path =
> + let pathIn1 = get_slurp (fp2fn path) s1
> + pathIn2 = get_slurp (fp2fn path) s2 in
> + case (pathIn1, pathIn2) of
> + (Nothing, Nothing) -> Nothing
> + (Nothing, Just s2LocationSlurpy) -> do
> + Just $ diff_added summary filetypeFunction initialFps
> s2LocationSlurpy NilFL
> + (Just s1LocationSlurpy, Nothing) -> do
> + Just $ diff_removed filetypeFunction initialFps s1LocationSlurpy
> NilFL
> + (Just s1LocationSlurpy, Just s2LocationSlurpy) ->
> + Just $ gendiff (ignore_times, look_for_adds, summary)
> filetypeFunction
> + initialFps s1LocationSlurpy s2LocationSlurpy NilFL
> + where ignore_times = IgnoreTimes `elem` opts
> + look_for_adds = LookForAdds `elem` opts
> + -- NoSummary/Summary both present gives False
> + -- Just Summary gives True
> + -- Just NoSummary gives False
> + -- Neither gives False
> + summary = Summary `elem` opts && NoSummary `notElem` opts
> + initialFps = tail $ reverse (breakup path)
> +#endif
> +
> \end{code}
Looks fine. There might be some potential to fold this with the rest of the
diffing functions, but that can be possibly done later, if at all.
>
> The diff function takes a recursive diff of two slurped-up directory trees.
> hunk ./src/Darcs/Diff.lhs 141
> unsafeDiff = undefined
> #else
> unsafeDiff opts wt s1 s2
> - = gendiff (ignore_times, look_for_adds, summary) wt [] s1 s2 NilFL
> - where ignore_times = IgnoreTimes `elem` opts
> - look_for_adds = LookForAdds `elem` opts
> - -- NoSummary/Summary both present gives False
> - -- Just Summary gives True
> - -- Just NoSummary gives False
> - -- Neither gives False
> - summary = Summary `elem` opts && NoSummary `notElem` opts
> + = case diff_at_path opts wt s1 s2 "" of
> + Just d -> d
> + _ -> impossible -- because "" always exists in a slurpy
Just replacing unsafeDiff with a diff_at_path wrapper. Looks ok.
> mk_filepath :: [FilePath] -> FilePath
> mk_filepath fps = concat $ intersperse "/" $ reverse fps
> hunk ./src/Darcs/Patch/FileName.lhs 31
> movedirfilename,
> encode_white, decode_white,
> (///),
> + breakup
> ) where
>
> import System.IO
> hunk ./src/Darcs/Patch/FileName.lhs 124
> p' -> d : p'
> drop_dotdot [] = []
>
> +-- | Split a file path at the slashes
> breakup :: String -> [String]
> breakup p = case break (=='/') p of
> (d,"") -> [d]
Just exporting breakup that's used elsewhere. Might be worth checking if
there's a better function already exported somewhere (one'd expect it to be
used somewhere already?) doing this.
> hunk ./src/Darcs/Repository.lhs 35
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> get_unrecorded, get_unrecorded_unsorted,
> get_unrecorded_no_look_for_adds,
> + get_unrecorded_in_files,
> read_repo, sync_repo,
> prefsUrl,
> add_to_pending,
> hunk ./src/Darcs/Repository.lhs 67
> slurp_recorded, slurp_recorded_and_unrecorded,
> withRecorded,
> get_unrecorded, get_unrecorded_unsorted,
> get_unrecorded_no_look_for_adds,
> + get_unrecorded_in_files,
> read_repo, sync_repo,
> prefsUrl, checkPristineAgainstCwd, checkPristineAgainstSlurpy,
> add_to_pending,
> hunk ./src/Darcs/Repository/Internal.lhs 33
> withRecorded, checkPristineAgainstCwd,
> checkPristineAgainstSlurpy,
> get_unrecorded, get_unrecorded_unsorted,
> get_unrecorded_no_look_for_adds,
> + get_unrecorded_in_files,
> read_repo, sync_repo,
> prefsUrl, makePatchLazy,
> add_to_pending,
Exporting the new get_unrecorded_in_files. Ack.
> hunk ./src/Darcs/Repository/Internal.lhs 57
>
> import Printer ( putDocLn, (<+>), text, ($$) )
>
> -import Data.Maybe ( isJust, isNothing )
> +import Data.Maybe ( isJust, isNothing, catMaybes )
> import Darcs.Repository.Prefs ( get_prefval )
> import Darcs.Resolution ( standard_resolution, external_resolution )
> import System.Exit ( ExitCode(..), exitWith )
> hunk ./src/Darcs/Repository/Internal.lhs 89
> try_to_shrink, commuteFL, commute )
> import Darcs.Patch.Prim ( try_shrinking_inverse, Conflict )
> import Darcs.Patch.Bundle ( scan_bundle, make_bundle )
> +import Darcs.Patch.FileName ( FileName, fn2fp )
> import Darcs.SlurpDirectory ( Slurpy, slurp_unboring, mmap_slurp, co_slurp,
> slurp_has, list_slurpy_files )
> import Darcs.Hopefully ( PatchInfoAnd, info, n2pia,
> hunk ./src/Darcs/Repository/Internal.lhs 135
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
> import Darcs.Patch.Apply ( markup_file, LineMark(None) )
> import Darcs.Patch.Depends ( get_common_and_uncommon, deep_optimize_patchset
> )
> -import Darcs.Diff ( unsafeDiff )
> +import Darcs.Diff ( diff_at_path, unsafeDiff )
> import Darcs.RepoPath ( FilePathLike, AbsolutePath, toFilePath )
> import Darcs.Utils ( promptYorn, catchall, withCurrentDirectory, withUMask,
> nubsort )
> import Darcs.Progress ( progressFL, debugMessage )
Importing bits.
> hunk ./src/Darcs/Repository/Internal.lhs 392
> sfp sofar (p:<:ps) = sfp (p:>:sofar) ps
>
> get_unrecorded_no_look_for_adds :: RepoPatch p => Repository p C(r u t) ->
> IO (FL Prim C(r y))
> -get_unrecorded_no_look_for_adds = get_unrecorded_private (filter (/=
> LookForAdds))
> +get_unrecorded_no_look_for_adds r = get_unrecorded_private (filter (/=
> LookForAdds)) r []
Just adding the empty list meaning "diff everything" to get_unrecorded_private
invocation. Looks ok.
>
> get_unrecorded_unsorted :: RepoPatch p => Repository p C(r u t) -> IO (FL
> Prim C(r u))
> hunk ./src/Darcs/Repository/Internal.lhs 395
> -get_unrecorded_unsorted = get_unrecorded_private (AnyOrder:)
> +get_unrecorded_unsorted r = get_unrecorded_private (AnyOrder:) r []
Same here...
> get_unrecorded :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u))
> hunk ./src/Darcs/Repository/Internal.lhs 398
> -get_unrecorded = get_unrecorded_private id
> +get_unrecorded r = get_unrecorded_private id r []
..and here.
> +
> +-- | Gets the unrecorded changes in the given paths in the current
> repository.
> +get_unrecorded_in_files :: RepoPatch p => Repository p C(r u t) ->
> [FileName] -> IO (FL Prim C(r u))
> +get_unrecorded_in_files = get_unrecorded_private id
The new get_unrecorded variant.
> -- | The /unrecorded/ includes the pending and the working directory changes.
> hunk ./src/Darcs/Repository/Internal.lhs 405
> -get_unrecorded_private :: RepoPatch p => ([DarcsFlag]->[DarcsFlag]) ->
> Repository p C(r u t) -> IO (FL Prim C(r y))
> -get_unrecorded_private _ (Repo _ opts _ _)
> +-- The third argument is a list of paths: if this list is [], it will diff
> +-- the whole repo, but if there are elements in it, the function will
> return
> +-- only changes to files under those paths.
> +get_unrecorded_private :: RepoPatch p => ([DarcsFlag]->[DarcsFlag]) ->
> Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r y))
> +get_unrecorded_private _ (Repo _ opts _ _) _
> | NoUpdateWorking `elem` opts = return $ unsafeCoerceP NilFL
> hunk ./src/Darcs/Repository/Internal.lhs 411
> -get_unrecorded_private modopts repository@(Repo r oldopts _ _) =
> - withCurrentDirectory r $ do
> +get_unrecorded_private modopts repository@(Repo r oldopts _ _) files =
> + withCurrentDirectory r (do
What's been wrong with the $?
> debugMessage "Looking for unrecorded changes..."
> cur <- slurp_pending repository
> work <- if LookForAdds `elem` opts
> hunk ./src/Darcs/Repository/Internal.lhs 421
> else boring_file_filter
> slurp_unboring (myfilt cur nboring) "."
> else co_slurp cur "."
> + ftf <- filetype_function
> Sealed pend <- read_pending repository
> debugMessage "diffing dir..."
> hunk ./src/Darcs/Repository/Internal.lhs 424
> - ftf <- filetype_function
> - let dif = case unsafeDiff opts ftf cur work of
> - di -> if AnyOrder `elem` opts
> - then pend +>+ di
> - else sort_coalesceFL $ pend +>+ di
> + let diffs = if null files
> + then [unsafeDiff opts ftf cur work]
> + else catMaybes (map (diff_at_path opts ftf cur work) (map
> fn2fp files))
> + let workdiff = foldl (+>+) NilFL diffs
I suppose the order doesn't matter here, we just lump all the patches from
"diffs" together. Maybe there's a concatFL somewhere? Indeed, there is, but has
wrong type (FL (FL a)), not our [FL a]. Aye. Oh, right and there is the problem
with multiple copies of a single patch.
> + dif = if AnyOrder `elem` opts
> + then pend +>+ workdiff
> + else sort_coalesceFL $ pend +>+ workdiff
No functional change, just use "workdiff" instead of "di".
> seq dif $ debugMessage "Found unrecorded changes."
> hunk ./src/Darcs/Repository/Internal.lhs 432
> - return dif
> + return dif)
(goes with the $ change above)
> where myfilt s nboring f = slurp_has f s || nboring [f] /= []
> opts = modopts oldopts
>
> [make get_unrecorded_private work with type witnesses again
> [EMAIL PROTECTED]
> Ignore-this: 97418e6487ef9c9508473d4c65f295ca
> ] hunk ./src/Darcs/Repository/Internal.lhs 424
> ftf <- filetype_function
> Sealed pend <- read_pending repository
> debugMessage "diffing dir..."
> + -- the unsafeCoerceP below is necessary to be able to concatenate
> + -- pend with NilFL to form dif. See http://hpaste.org/11480
> let diffs = if null files
> hunk ./src/Darcs/Repository/Internal.lhs 427
> - then [unsafeDiff opts ftf cur work]
> - else catMaybes (map (diff_at_path opts ftf cur work) (map
> fn2fp files))
> - let workdiff = foldl (+>+) NilFL diffs
> + then unsafeDiff opts ftf cur work
> + else let diffsPerFile = catMaybes (map (diff_at_path opts
> ftf cur work) (map fn2fp files))
> + in foldr (+>+) (unsafeCoerceP NilFL) diffsPerFile
This change is beyond me... Jason? It does seem functionally equivalent
though. (Ok, after referring elsewhere, I see that this is where the type
witnesses catch the concatenation problem from above and we circumvent them by
unsafeCoerceP; this will hopefully be corrected later on.)
> dif = if AnyOrder `elem` opts
> hunk ./src/Darcs/Repository/Internal.lhs 431
> - then pend +>+ workdiff
> - else sort_coalesceFL $ pend +>+ workdiff
> + then pend +>+ diffs
> + else sort_coalesceFL $ pend +>+ diffs
Nothing new.
> seq dif $ debugMessage "Found unrecorded changes."
> return dif)
> where myfilt s nboring f = slurp_has f s || nboring [f] /= []
> [make whatsnew use the lstat-saving functions to scan the working copy
> [EMAIL PROTECTED]
> Ignore-this: 54b7a07b7b1d49b3d20050bc905db665
> ] hunk ./src/Darcs/Commands/WhatsNew.lhs 40
> )
> import Darcs.Arguments ( summary )
> import Darcs.Patch.TouchesFiles ( choose_touching )
> -import Darcs.RepoPath ( toFilePath )
> +import Darcs.RepoPath ( toFilePath, sp2fn )
> import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
> hunk ./src/Darcs/Commands/WhatsNew.lhs 42
> - get_unrecorded, get_unrecorded_no_look_for_adds,
> amInRepository )
> + get_unrecorded_no_look_for_adds,
> + get_unrecorded_in_files, amInRepository )
> import Darcs.Repository.Prefs ( filetype_function )
> import Darcs.Diff ( unsafeDiff )
> import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk,
> hunk ./src/Darcs/Commands/WhatsNew.lhs 105
> files <- fixSubPaths opts' args
> when (areFileArgs files) $
> putStrLn $ "What's new in "++unwords (map show files)++":\n"
> - all_changes <- get_unrecorded repository
> - chold <- get_unrecorded_no_look_for_adds repository
> + all_changes <- get_unrecorded_in_files repository (map sp2fn files)
> + chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)
Looks obvious here. We use the tweak to get_unrecorded_no_look_for_adds below
to pass the file list.
> s <- slurp_recorded repository
> ftf <- filetype_function
> let pre_changed_files = apply_to_filepaths (invert chold) $ map
> toFilePath files
> hunk ./src/Darcs/Commands/WhatsNew.lhs 136
> files <- sort `fmap` fixSubPaths opts args
> when (areFileArgs files) $
> putStrLn $ "What's new in "++unwords (map show files)++":\n"
> - changes <- get_unrecorded repository
> + changes <- get_unrecorded_in_files repository (map sp2fn files)
Looks obvious as well.
> when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $
> ExitFailure 1)
> let pre_changed_files = apply_to_filepaths (invert changes) $ map
> toFilePath files
> unseal (printSummary repository) $ mapSeal (mapFL_FL prim2real) $
> choose_touching pre_changed_files changes
> hunk ./src/Darcs/Repository/Internal.lhs 391
> Left _ -> sfp (p:>:sofar) ps
> sfp sofar (p:<:ps) = sfp (p:>:sofar) ps
>
> -get_unrecorded_no_look_for_adds :: RepoPatch p => Repository p C(r u t) ->
> IO (FL Prim C(r y))
> -get_unrecorded_no_look_for_adds r = get_unrecorded_private (filter (/=
> LookForAdds)) r []
> +get_unrecorded_no_look_for_adds :: RepoPatch p => Repository p C(r u t) ->
> [FileName] -> IO (FL Prim C(r y))
> +get_unrecorded_no_look_for_adds r paths = get_unrecorded_private (filter (/=
> LookForAdds)) r paths
This is the tweak I have mentioned above.
>
> get_unrecorded_unsorted :: RepoPatch p => Repository p C(r u t) -> IO (FL
> Prim C(r u))
> get_unrecorded_unsorted r = get_unrecorded_private (AnyOrder:) r []
> [hopefully less buggy version of get_unrecorded_in_files
> Reinier Lamers <[EMAIL PROTECTED]>**20081031215944
> Ignore-this: 9f4f2320a1784cf6f7546ab23eb6bf61
> ] hunk ./src/Darcs/Commands/WhatsNew.lhs 39
> list_registered_files,
> )
> import Darcs.Arguments ( summary )
> -import Darcs.Patch.TouchesFiles ( choose_touching )
> -import Darcs.RepoPath ( toFilePath, sp2fn )
> +import Darcs.RepoPath ( sp2fn )
> import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,
> get_unrecorded_no_look_for_adds,
> get_unrecorded_in_files, amInRepository )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 45
> import Darcs.Repository.Prefs ( filetype_function )
> import Darcs.Diff ( unsafeDiff )
> -import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk,
> - invert, apply_to_filepaths )
> +import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk )
> import Darcs.Patch.Permutations ( partitionRL )
> import Darcs.Patch.Real ( RealPatch, prim2real )
> import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
> hunk ./src/Darcs/Commands/WhatsNew.lhs 50
> import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..),
> nullFL )
> -import Darcs.Sealed ( Sealed(..), unseal, mapSeal )
> import Printer ( putDocLn, renderString, vcat, text )
> #include "impossible.h"
More import juggling.
> \end{code}
> hunk ./src/Darcs/Commands/WhatsNew.lhs 106
> chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)
> s <- slurp_recorded repository
> ftf <- filetype_function
> - let pre_changed_files = apply_to_filepaths (invert chold) $ map
> toFilePath files
> - select_files = choose_touching pre_changed_files
> - Sealed cho <- return $ select_files chold
> - cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL cho
> - Sealed all_fs <- return $ select_files all_changes
> - cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_fs
> + cho_adds :> _ <- return $ partitionRL is_hunk $ reverseFL chold
> + cha :> _ <- return $ partitionRL is_hunk $ reverseFL all_changes
> let chn = unsafeDiff [LookForAdds,Summary] ftf
> (fromJust $ apply_to_slurpy (reverseRL cho_adds)
> s)
> (fromJust $ apply_to_slurpy (reverseRL cha) s)
chold now only contains the interesting hunks (those touching selected files),
so we don't need to filter the diff anymore.
> hunk ./src/Darcs/Commands/WhatsNew.lhs 111
> - exitOnNoChanges (chn, cho)
> - putDocLn $ summarize cho
> + exitOnNoChanges (chn, chold)
> + putDocLn $ summarize chold
Just substituting chold for cho, the former now being already filtered (cho
used to just be the interesting subset of chold).
> printSummary chn
> where lower_as x = vcat $ map (text . l_as) $ lines x
> l_as ('A':x) = 'a':x
> hunk ./src/Darcs/Commands/WhatsNew.lhs 131
> putStrLn $ "What's new in "++unwords (map show files)++":\n"
> changes <- get_unrecorded_in_files repository (map sp2fn files)
> when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $
> ExitFailure 1)
> - let pre_changed_files = apply_to_filepaths (invert changes) $ map
> toFilePath files
> - unseal (printSummary repository) $ mapSeal (mapFL_FL prim2real) $
> choose_touching pre_changed_files changes
> + printSummary repository $ mapFL_FL prim2real changes
I believe this is again just getting rid of redundant patch filtering. We have
changed the way the "changes" bit is obtained to use get_unrecorded_in_files
above.
> where printSummary :: RepoPatch p => Repository p C(r u t) -> FL
> RealPatch C(r y) -> IO ()
> printSummary _ NilFL = do putStrLn "No changes!"
> exitWith $ ExitFailure 1
> hunk ./src/Darcs/Diff.lhs 26
>
> #include "gadts.h"
>
> -module Darcs.Diff ( diff_at_path, unsafeDiff, sync, cmp
> +module Darcs.Diff ( unsafeDiffAtPaths, unsafeDiff, sync, cmp
> #ifndef GADT_WITNESSES
> , diff_files
> #endif
> hunk ./src/Darcs/Diff.lhs 41
> import Control.Monad ( when )
> import Data.List ( sort
> #ifndef GADT_WITNESSES
> - , intersperse
> + , intersperse, isPrefixOf
> #endif
> )
> hunk ./src/Darcs/Diff.lhs 44
> +#ifndef GADT_WITNESSES
> +import Data.Maybe ( catMaybes )
> +#endif
>
> #ifndef GADT_WITNESSES
> import ByteStringUtils ( is_funky, linesPS)
> hunk ./src/Darcs/Diff.lhs 92
> #include "impossible.h"
> #endif
More import juggling.
>
> --- | The diff_at_path function compares what two slurpies have at a certain
> --- location. This is useful when the user requests a diff for a file that
> --- is created or removed in the working copy: then there is no slurpy for
> --- the file in the /current/ or /working/ slurpy respectively.
> +-- | The unsafeDiffAtPaths function calls diff_at_path for a set of files
> and
> +-- returns all changes to those files. It does *not* explore the given
> paths
> +-- recursively.
> +--
> +-- Comparing paths and not slurpies is useful when the user
> +-- requests a diff for a file that is created or removed in the working
> copy:
> +-- then there is no slurpy for the file in the /current/ or /working/
> slurpy
> +-- respectively.
> --
> -- The given paths must always be fixed repository paths starting with a
> hunk ./src/Darcs/Diff.lhs 102
> --- ".".
> ---
> --- It returns Nothing if there is nothing at the given location in both
> --- slurpies, and the differences between what's there in the slurpies in
> --- all other cases.
> -diff_at_path :: [DarcsFlag] -> (FilePath -> FileType) ->
> - Slurpy -> Slurpy -> FilePath -> Maybe (FL Prim C(x y))
> +-- ".". It is safe to pass overlapping paths.
> +--
> +-- The booleans in the first argument tell whether to ignore mtimes,
> whether
> +-- we must look for additions and if we're diffing for a summary only.
> +--
> +-- It returns an FL of patches, that contains all the changes that have
> been
> +-- made at all those paths.
> +unsafeDiffAtPaths :: (Bool, Bool, Bool) -> (FilePath -> FileType) ->
> + Slurpy -> Slurpy -> [FilePath] -> FL Prim C(x y)
> #ifdef GADT_WITNESSES
> hunk ./src/Darcs/Diff.lhs 112
> -diff_at_path = undefined
> +unsafeDiffAtPaths = undefined
> #else
> hunk ./src/Darcs/Diff.lhs 114
> -diff_at_path opts filetypeFunction s1 s2 path =
> - let pathIn1 = get_slurp (fp2fn path) s1
> - pathIn2 = get_slurp (fp2fn path) s2 in
> +unsafeDiffAtPaths flags filetypeFunction s1 s2 paths =
> + foldr (+>+) NilFL (catMaybes diffsPerPath)
this should be okay assuming that safePaths below is really correct...
> + where diffsPerPath = map differ safePaths
> + differ = diff_at_path flags filetypeFunction s1 s2
> + safePaths = make_nonoverlapping_path_set paths
We use make_nonoverlapping_path_set, that appears later. If that function is
correct, this is correct as well, as no file will appear twice in the listing.
> +
> +diff_at_path :: (Bool, Bool, Bool) -> (FilePath -> FileType)
> + -> Slurpy -> Slurpy -> FilePath -> Maybe (FL Prim)
> +diff_at_path (ignoreTimes, lookForAdds, summary) filetypeFunction s1 s2 path
> =
> case (pathIn1, pathIn2) of
> (Nothing, Nothing) -> Nothing
> hunk ./src/Darcs/Diff.lhs 125
> - (Nothing, Just s2LocationSlurpy) -> do
> - Just $ diff_added summary filetypeFunction initialFps
> s2LocationSlurpy NilFL
> - (Just s1LocationSlurpy, Nothing) -> do
> - Just $ diff_removed filetypeFunction initialFps s1LocationSlurpy
> NilFL
> - (Just s1LocationSlurpy, Just s2LocationSlurpy) ->
> - Just $ gendiff (ignore_times, look_for_adds, summary)
> filetypeFunction
> - initialFps s1LocationSlurpy s2LocationSlurpy NilFL
> - where ignore_times = IgnoreTimes `elem` opts
> - look_for_adds = LookForAdds `elem` opts
> - -- NoSummary/Summary both present gives False
> - -- Just Summary gives True
> - -- Just NoSummary gives False
> - -- Neither gives False
> - summary = Summary `elem` opts && NoSummary `notElem` opts
> + (Nothing, Just s2PathSlurpy) -> do
> + Just $ diff_added summary filetypeFunction initialFps
> s2PathSlurpy NilFL
> + (Just s1PathSlurpy, Nothing) -> do
> + Just $ diff_removed filetypeFunction initialFps s1PathSlurpy
> NilFL
> + (Just s1PathSlurpy, Just s2PathSlurpy) ->
> + Just $ gendiff (ignoreTimes, lookForAdds, summary)
> filetypeFunction
> + initialFps s1PathSlurpy s2PathSlurpy NilFL
> + where pathIn1 = get_slurp (fp2fn path) s1
> + pathIn2 = get_slurp (fp2fn path) s2
> initialFps = tail $ reverse (breakup path)
This looks ok, just *LocationSlurpy has renamed to *PathSlurpy.
> hunk ./src/Darcs/Diff.lhs 135
> +
> +make_nonoverlapping_path_set :: [FilePath] -> [FilePath]
> +make_nonoverlapping_path_set = map unbreakup . delete_overlapping . map
> breakup . sort
> + where
> + delete_overlapping :: [[FilePath]] -> [[FilePath]]
> + delete_overlapping (p1:p2:ps) = if p1 `isPrefixOf` p2
> + then delete_overlapping (p1:ps)
> + else p1 : delete_overlapping (p2:ps)
> + delete_overlapping ps = ps
> + unbreakup = concat . intersperse "/"
> #endif
Now, this assumes that prefixes always sort first, which is hopefully true (and
trying it in ghci seems to confirm that). Is there a possibility that the paths
are not canonical? We need to ensure that nothing like "foo/../bar" ever gets
fed into this function (!). This might actually be a weak spot, although
there's a call to fix paths somewhere quite high in the stack (in beginning of
most commands, I believe). It might be worth adding a test checking something
like "darcs whatsnew foo/. foo/bar/..".
(Ok, looking near the end of the patch, this seems to be taken into account in
testing. I would just like this to be double-checked, as this is what we rely
on for correctness.)
>
> \end{code}
> hunk ./src/Darcs/Diff.lhs 161
> unsafeDiff = undefined
> #else
> unsafeDiff opts wt s1 s2
> - = case diff_at_path opts wt s1 s2 "" of
> + = case diff_at_path (ignoreTimes, lookForAdds, summary) wt s1 s2 "" of
> Just d -> d
> _ -> impossible -- because "" always exists in a slurpy
This remains safe, only one path is passed to diff_at_path.
> hunk ./src/Darcs/Diff.lhs 164
> + where -- NoSummary/Summary both present gives False
> + -- Just Summary gives True
> + -- Just NoSummary gives False
> + -- Neither gives False
> + summary = Summary `elem` opts && NoSummary `notElem` opts
> + lookForAdds = LookForAdds `elem` opts
> + ignoreTimes = IgnoreTimes `elem` opts
This has apparently just moved back, since diff_at_path no longer does opt
processing for us.
>
> mk_filepath :: [FilePath] -> FilePath
> mk_filepath fps = concat $ intersperse "/" $ reverse fps
> hunk ./src/Darcs/Diff.lhs 179
> -> (FilePath -> FileType) -> [FilePath] -> Slurpy -> Slurpy
> -> (FL Prim -> FL Prim)
> gendiff opts@(isparanoid,_,_) wt fps s1 s2
> - | is_file s1 && is_file s2 && maybe_differ =
> - case wt n2 of
> - TextFile -> diff_files f b1 b2
> - BinaryFile -> if b1 /= b2 then (binary f b1 b2:>:)
> - else id
> + | is_file s1 && is_file s2 = diff_regular_files isparanoid wt f s1 s2
A harmless refactor, taking the file diffing case into a separate function.
> | is_dir s1 && is_dir s2 =
> let fps' = case n2 of
> "." -> fps
> hunk ./src/Darcs/Diff.lhs 188
> | otherwise = id
> where n2 = slurp_name s2
> f = mk_filepath (n2:fps)
> - b1 = get_filecontents s1
> - b2 = get_filecontents s2
> dc1 = get_dircontents s1
> dc2 = get_dircontents s2
> hunk ./src/Darcs/Diff.lhs 190
> - maybe_differ = isparanoid
> - || get_mtime s1 == undefined_time
> - || get_mtime s1 /= get_mtime s2
> - || get_length s1 == undefined_size
> - || get_length s1 /= get_length s2
All of these have moved to diff_regular_files.
>
> -- recur_diff or recursive diff
> -- First parameter is (IgnoreTimes?, LookforAdds?, Summary?)
> hunk ./src/Darcs/Diff.lhs 214
> recur_diff (_,False,_) _ _ [] _ = id
> recur_diff _ _ _ _ _ = impossible
>
> +-- diff, taking into account paranoidness and file type, two regular files
> +diff_regular_files :: Bool -> (FilePath -> FileType) -> FilePath -> Slurpy
> -> Slurpy -> (FL Prim -> FL Prim)
> +diff_regular_files ignoreTimes filetypeFunction f s1 s2 =
> + if maybe_differ
> + then case filetypeFunction (slurp_name s2) of
>
> + TextFile -> diff_files f b1 b2
> + BinaryFile -> if b1 /= b2 then (binary f b1 b2:>:)
> + else id
> + else id
> + where maybe_differ = ignoreTimes
> + || get_mtime s1 == undefined_time
> + || get_mtime s1 /= get_mtime s2
> + || get_length s1 == undefined_size
> + || get_length s1 /= get_length s2
> + b1 = get_filecontents s1
> + b2 = get_filecontents s2
Travelled from above. Probably this part is unrelated to the rest of the patch?
> +
> -- creates a diff for a file or directory which needs to be added to the
> -- repository
> diff_added :: Bool -> (FilePath -> FileType) -> [FilePath] -> Slurpy
> hunk ./src/Darcs/Repository/Internal.lhs 57
>
> import Printer ( putDocLn, (<+>), text, ($$) )
>
> -import Data.Maybe ( isJust, isNothing, catMaybes )
> +import Data.Maybe ( isJust, isNothing )
> import Darcs.Repository.Prefs ( get_prefval )
> import Darcs.Resolution ( standard_resolution, external_resolution )
> import System.Exit ( ExitCode(..), exitWith )
> hunk ./src/Darcs/Repository/Internal.lhs 86
>
> import Darcs.Patch ( Patch, RealPatch, Effect, is_hunk, is_binary,
> description,
>
> - try_to_shrink, commuteFL, commute )
> + try_to_shrink, commuteFL, commute, apply_to_filepaths )
> import Darcs.Patch.Prim ( try_shrinking_inverse, Conflict )
> import Darcs.Patch.Bundle ( scan_bundle, make_bundle )
> import Darcs.Patch.FileName ( FileName, fn2fp )
> hunk ./src/Darcs/Repository/Internal.lhs 90
> +import Darcs.Patch.TouchesFiles ( choose_touching )
> import Darcs.SlurpDirectory ( Slurpy, slurp_unboring, mmap_slurp, co_slurp,
> slurp_has, list_slurpy_files )
> import Darcs.Hopefully ( PatchInfoAnd, info, n2pia,
> hunk ./src/Darcs/Repository/Internal.lhs 110
> import Darcs.Flags ( DarcsFlag(AnyOrder, Boring, LookForAdds, Verbose, Quiet,
> MarkConflicts, AllowConflicts,
> NoUpdateWorking,
> RepoDir, WorkDir, UMask, Test, LeaveTestDir,
> - SetScriptsExecutable, DryRun, IgnoreTimes ),
> + SetScriptsExecutable, DryRun, IgnoreTimes,
> + Summary, NoSummary),
> want_external_merge, compression )
> import Darcs.Ordered ( FL(..), RL(..), EqCheck(..), unsafeCoerceP,
> (:\/:)(..), (:/\:)(..), (:>)(..),
> hunk ./src/Darcs/Repository/Internal.lhs 137
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
> import Darcs.Patch.Apply ( markup_file, LineMark(None) )
> import Darcs.Patch.Depends ( get_common_and_uncommon, deep_optimize_patchset
> )
> -import Darcs.Diff ( diff_at_path, unsafeDiff )
> +import Darcs.Diff ( unsafeDiffAtPaths, unsafeDiff )
> import Darcs.RepoPath ( FilePathLike, AbsolutePath, toFilePath )
> import Darcs.Utils ( promptYorn, catchall, withCurrentDirectory, withUMask,
> nubsort )
> import Darcs.Progress ( progressFL, debugMessage )
Imports again...
> hunk ./src/Darcs/Repository/Internal.lhs 409
> -- | The /unrecorded/ includes the pending and the working directory changes.
> -- The third argument is a list of paths: if this list is [], it will diff
> -- the whole repo, but if there are elements in it, the function will
> return
> --- only changes to files under those paths.
> +-- only changes to files under those paths. The paths must be fixed paths
> +-- starting with ".", but need not yet be unique.
> get_unrecorded_private :: RepoPatch p => ([DarcsFlag]->[DarcsFlag]) ->
> Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r y))
> get_unrecorded_private _ (Repo _ opts _ _) _
> | NoUpdateWorking `elem` opts = return $ unsafeCoerceP NilFL
> hunk ./src/Darcs/Repository/Internal.lhs 426
> else co_slurp cur "."
> ftf <- filetype_function
> Sealed pend <- read_pending repository
> + let changed_files = apply_to_filepaths pend filesFP
> + pre_changed_files = apply_to_filepaths (invert pend) filesFP
> + Sealed relevantPend <- return $ if null files
> + then seal pend
> + else choose_touching pre_changed_files
> pend
> debugMessage "diffing dir..."
We only take subset of pending that touches the relevant files here. Good
catch.
> hunk ./src/Darcs/Repository/Internal.lhs 432
> - -- the unsafeCoerceP below is necessary to be able to concatenate
> - -- pend with NilFL to form dif. See http://hpaste.org/11480
> let diffs = if null files
> then unsafeDiff opts ftf cur work
> hunk ./src/Darcs/Repository/Internal.lhs 434
> - else let diffsPerFile = catMaybes (map (diff_at_path opts
> ftf cur work) (map fn2fp files))
> - in foldr (+>+) (unsafeCoerceP NilFL) diffsPerFile
> + else unsafeDiffAtPaths (ignoreTimes, lookForAdds, summary)
> ftf cur work changed_files
We now use the new unsafeDiffAtPaths that produces a single FL Prim from all
the paths, instead of mapping over paths, obtaining [FL Prim] that needs to be
concatenated (which is the unsafe operation). This fixes the possible double
appearance of same Prim here (assuming unsafeDiffAtPaths is correct, see above).
> dif = if AnyOrder `elem` opts
> hunk ./src/Darcs/Repository/Internal.lhs 436
> - then pend +>+ diffs
> - else sort_coalesceFL $ pend +>+ diffs
> + then relevantPend +>+ diffs
> + else sort_coalesceFL $ relevantPend +>+ diffs
> seq dif $ debugMessage "Found unrecorded changes."
> return dif)
> where myfilt s nboring f = slurp_has f s || nboring [f] /= []
> hunk ./src/Darcs/Repository/Internal.lhs 442
> opts = modopts oldopts
> + -- NoSummary/Summary both present gives False
> + -- Just Summary gives True
> + -- Just NoSummary gives False
> + -- Neither gives False
> + summary = Summary `elem` opts && NoSummary `notElem` opts
> + lookForAdds = LookForAdds `elem` opts
> + ignoreTimes = IgnoreTimes `elem` opts
> + filesFP = map fn2fp files
>
> -- @todo: we should not have to open the result of HashedRepo and
> -- seal it. Instead, update this function to work with type witnesses
(testing and buildsystem bits seem to follow, Kowey could you take over here
please? Or you probably know whom to ask...)
> [Try a bit harder to hack darcs pathname canonicalization in tests
> Reinier Lamers <[EMAIL PROTECTED]>**20081103211112
> Ignore-this: 3b419ed6b5c3b4d8529ca045d8c63548
> ] hunk ./tests/whatsnew-file.sh 47
> cat out
> grep date out | wc -l | grep 1
>
> +darcs wh foo ./foo > out
> +cat out
> +grep date out | wc -l | grep 1
> +
> +darcs wh foo bar/../foo > out
> +cat out
> +grep date out | wc -l | grep 1
> +
> +darcs wh foo foo/../foo/. > out
> +cat out
> +grep date out | wc -l | grep 1
> +
> cd ..
>
> rm -rf temp1
> [Fix "make bugs" target in makefile
> Reinier Lamers <[EMAIL PROTECTED]>**20081103221941
> Ignore-this: 541567455acb0308bbbcf8eb4fe4c83b
> ] hunk ./GNUmakefile 505
> echo ALL --hashed >> .darcs/defaults)
>
> bugs-old: darcs hspwd
> - $(call shell_bugs,old-fashioned,\
> + $(call bug_harness,old-fashioned,\
> echo ALL --old-fashioned-inventory >> .darcs/defaults)
>
> bugs-format2: darcs hspwd
> hunk ./GNUmakefile 509
> - $(call shell_bugs,format-2,\
> + $(call bug_harness,format-2,\
> echo ALL --darcs-2 >> .darcs/defaults)
>
> bugs-hashed: darcs hspwd
> hunk ./GNUmakefile 513
> - $(call shell_bugs,hashed,\
> + $(call bug_harness,hashed,\
> echo ALL --hashed >> .darcs/defaults)
>
> test_unit: darcs unit
> [Add bug script for issue1196
> Reinier Lamers <[EMAIL PROTECTED]>**20081103222106
> Ignore-this: a91333382a944602881b388da4606eca
> ] addfile ./bugs/issue1196_whatsnew_falsely_lists_all_changes.sh
> hunk ./bugs/issue1196_whatsnew_falsely_lists_all_changes.sh 1
> +#!/usr/bin/env bash
> +set -ev
> +
> +not () { "$@" && exit 1 || :; }
> +
> +rm -rf temp1
> +mkdir temp1
> +cd temp1
> +
> +darcs init
> +touch aargh
> +darcs add aargh
> +echo utrecht > aargh
> +
> +darcs wh foo foo/../foo/. > out
> +cat out
> +not grep utrecht out
> +
> +cd ..
> +rm -rf temp1
> +
> hunk ./tests/whatsnew-file.sh 55
> cat out
> grep date out | wc -l | grep 1
>
> -darcs wh foo foo/../foo/. > out
> -cat out
> -grep date out | wc -l | grep 1
> +# This one fails actually, but it's not my fault. Filed as issue1196.
> +#darcs wh foo foo/../foo/. > out
> +#cat out
> +#grep date out | wc -l | grep 1
>
> cd ..
>
> [add yet another braindead file path to file path canonicalization test
> Reinier Lamers <[EMAIL PROTECTED]>**20081103222552
> Ignore-this: a2b2f6f8c47a14943dd99a6a1d0a5c7d
> ] hunk ./tests/whatsnew-file.sh 47
> cat out
> grep date out | wc -l | grep 1
>
> -darcs wh foo ./foo > out
> +darcs wh foo ./foo ../temp1/foo > out
> cat out
> grep date out | wc -l | grep 1
Yours,
Petr.
--
Peter Rockai | me()mornfall!net | prockai()redhat!com
http://blog.mornfall.net | http://web.mornfall.net
"In My Egotistical Opinion, most people's C programs should be
indented six feet downward and covered with dirt."
-- Blair P. Houghton on the subject of C program indentation
_______________________________________________
darcs-users mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-users
