[darcs-users] [patch374] ADV: the initial pile

Eric Kow kowey at darcs.net
Tue Aug 31 12:56:29 UTC 2010


On Mon, Aug 30, 2010 at 08:43:30 +0000, Petr Ročkai wrote:
> I have also cloned HEAD as darcs-unstable at darcs.net:adventure (also available
> as http://darcs.net/adventure) where I imagine these patches would go. I'll set
> up a buildbot waterfall for it when people start pushing patches there.

Nice work.  But you moved too fast (I would have waited until the
adventure branch discussion made progress before actually creating
the branch, but no harm done).  Anyway Let's hold off on pushing patches
to this adventure branch until we've made more progress on the
discussion.  Consensus building is slow, patient and sometimes
frustrating work, but it's worth it in the end.

That said, just because consensus building is slow doesn't mean we can't
get some work done while we're trying to build consensus.  I don't see
any reason folks can't review review patches for efficiency while
the adventure branch thread converges...  trying my hand at a little bit
of high-level review (sorry, this really is a token effort):

> Wed Aug 11 17:39:29 CEST 2010  Petr Rockai <me at mornfall.net>
>   * First stab at a hashed-storage 0.6 port.

I mostly skipped as it was a big one, and also because I didn't really
know how to review a replace-this-bit-hs-use-with-this-other-bit
patch.

> Wed Jul 14 19:52:08 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Wibble path building in Repository.Prefs.
> 
> Thu Jul 15 10:59:38 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Use more meaningful names for seal_up_patches' parameters.
> 
> Sat Jul 17 10:40:48 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Update haddock.
 
> Wed Aug 11 21:25:55 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Move the preferences system into IO where it belongs.
> 
> Wed Aug 11 21:45:04 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Make FileName an alias to Relative (from Hashed.Storage.Path).
> 
> Wed Aug 11 22:12:49 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Fix annotate that got broken due to path format change.
> 
> Thu Aug 12 00:02:43 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Replace FilePath with FileName in SelectChanges and ChooseTouching.
> 
> Thu Aug 12 00:09:46 CEST 2010  Petr Rockai <me at mornfall.net>
>   * Make SubPath just another alias for Relative.

I only got up to here... and hmm, it took me a couple of hours
of review, so I don't know if I'm doing something wrong or just
being slow.

[snip remaining 52 patches :-/]

Hmm, so if this adventure branch thing is going to work, we're going to
need to learn how to review it.

Wibble path building in Repository.Prefs.
-----------------------------------------
Wibble acknowledged

Use more meaningful names for seal_up_patches' parameters.
----------------------------------------------------------
> -          seal_up_patches xxx yyy =
> +          seal_up_patches patches context =

Better

Update haddock.
---------------
Slightly more precise patch names please

>  -- | Sets scripts in or below the current directory executable. A script is any file that starts
> ---   with the bytes '#!'. This is used sometimes for --set-scripts-executable, but at other times
> ---   --set-scripts-executable is handled by the hunk patch case of applyFL.
> +--   with the bytes '#!'. This is used for --set-scripts-executable.

Thanks

First stab at a hashed-storage 0.6 port.
----------------------------------------
Seems to replace anchorPath (old stuff)

> -       return $ map (anchorPath "" . fst) $ list recorded
> +       return $ map (pathToString . fst) $ list recorded

I'm going to just have to guess anchorPath "" and pathToString
both from hashed-storage are equivalent

>  filesDirs :: Bool -> Bool -> Tree m -> [FilePath]
>  filesDirs False False _ = []
> -filesDirs False True  t = "." : [ anchorPath "." p | (p, SubTree _) <- list t ]
> +filesDirs False True  t = "." : [ pathToString p | (p, SubTree _) <- list t ]
> -filesDirs True  False t = [ anchorPath "." p | (p, File _) <- list t ]
> +filesDirs True  False t = [ pathToString p | (p, File _) <- list t ]
> -filesDirs True  True  t = "." : (map (anchorPath "." . fst) $ list t)
> +filesDirs True  True  t = "." : (map (pathToString . fst) $ list t)

What was the difference between anchorPath "." and anchorPath ""?
Seems to be none according to this block of code.

> -import Storage.Hashed( floatPath )
> +import Storage.Hashed.Path( unsafePathFromString )

And I guess I have to assume these do the same thing

> conflictor [
> hunk ./src/Darcs/Diff.hs 56
> -    where diff :: Gap w
> -               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
> -               -> IO (w (FL Prim))
> +    where diff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m)
> +               -> m (w (FL Prim))
> hunk ./src/Darcs/Diff.hs 56
> -    where diff :: AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m)
> -               -> m (w (FL Prim))
> -          diff _ (Just (SubTree _)) (Just (SubTree _)) = return (emptyGap NilFL)
> -          diff p (Just (SubTree _)) Nothing =
> +    where
> +          -- sort into removes, changes, adds, with removes in reverse-path order
> +          -- and everything else in forward order
> +          organise :: (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering
> +
> +          organise (p1, Changed _ _ ) (p2, Changed _ _) = compare p1 p2
> +          organise (p1, Added _)      (p2, Added _)   = compare p1 p2
> +          organise (p1, Removed _)    (p2, Removed _) = compare p2 p1
> +
> +          organise (p1, Removed _) _ = LT
> +          organise _ (p1, Removed _) = GT
> +
> +          organise (p1, Changed _ _) _ = LT
> +          organise _ (p1, Changed _ _) = GT
> +
> +          diff :: AnchoredPath -> Diff m -> m (w (FL Prim))
> +          diff _ (Changed (SubTree _) (SubTree _)) = return (emptyGap NilFL)
> +          diff p (Removed (SubTree _)) =
> hunk ./src/Darcs/Diff.hs 65
> -          organise (p1, Removed _) _ = LT
> -          organise _ (p1, Removed _) = GT
> +          organise (_, Removed _) _ = LT
> +          organise _ (_, Removed _) = GT
> hunk ./src/Darcs/Diff.hs 68
> -          organise (p1, Changed _ _) _ = LT
> -          organise _ (p1, Changed _ _) = GT
> +          organise (_, Changed _ _) _ = LT
> +          organise _ (_, Changed _ _) = GT
> ]
> :
> hunk ./src/Darcs/Diff.hs 57
> -               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)
> +               => Relative -> Maybe (TreeItem IO) -> Maybe (TreeItem IO)

Hmm, not sure how to react to a conflictor like this.

> +pathFromFileName :: FileName -> Relative
> +pathFromFileName x = y -- trace ("pathFromFileName: " ++ show x ++ " -> " ++ show y) y
> +  where y = unsafePathFromString $ fix $ fn2fp x
> +        fix p | "./" `isPrefixOf` p = drop 2 p
> +              | otherwise = p

I'm not going to worry about this  because it's going away in a future
patch

Skipped treeHasAnyCase = treeHas anyCase refactor

Move the preferences system into IO where it belongs.
-----------------------------------------------------
> +import System.IO.Unsafe( unsafePerformIO )

What was wrong with using ReadableDirectory and WriteableDirectory?

> hunk ./src/Darcs/Patch/Apply.lhs 145
>      apply (Move f f') = mRename f f'
>      apply (ChangePref p f t) =
>          do b <- mDoesDirectoryExist (fp2fn $ darcsdir++"/prefs")
> -           when b $ changePrefval p f t
> +           when b $ return $! unsafePerformIO (changePrefval p f t) -- fuck you.

No fucking profanity, please. I'm not so much worried about protecting
people's delicate eyes, as about keeping things
simple/minimal/professional.

Surely you have a more meaningful comment to make.

Make FileName an alias to Relative (from Hashed.Storage.Path).
--------------------------------------------------------------
> hunk ./src/Darcs/Patch/FileName.hs 41
> -newtype FileName = FN FilePath deriving ( Eq, Ord )
> +type FileName = Relative

How do we know that FileName and Relative behave the same ways where it
counts?  We want to be very very careful here. I realise the whole point
of this work is that we replace our braindead path representation with
something far saner, but we have to be super careful about backwards
compatibility.  No surprises.

Also how do we know that Storage.Hashed.Path has sane behaviour in the
first place?  It seems like Storage.Hashed.Path is a module that lends
itself fairly well to testing, some examples being:

 - path/unpath roundtrips
 - properties on isPrefix is reflexivity, antisymmetry, transitivity
 - crazy things with ..
 - maybe just ideas taken from the System.FilePath test suite

Does Storage.Hashed.Path.Absolute behave sanely on Windows (consider
paths starting with \\).  Yeah OK all this stuff is a pain in the ass
but we're going to have deal with it someday

So I'm picking on the path stuff for two reasons: first that we count
on it so much, and second that it seems to be fairly self-contained, so
it could be easy as a way to help us learn to test.  I think I can work
on this if I have some time, but I hope we can agree on the principle
that it's not safe to merge adventure until we at least how the path
stuff really behaves.

> -encodeWhite :: FilePath -> String
> -encodeWhite (c:cs) | isSpace c || c == '\\' =
> -    '\\' : (show $ ord c) ++ "\\" ++ encodeWhite cs
> -encodeWhite (c:cs) = c : encodeWhite cs
> -encodeWhite [] = []
> +encodeWhite :: B.ByteString -> B.ByteString
> +encodeWhite = BC.concatMap encode
> +  where encode c
> +          | isSpace c || c == '\\' = B.concat [ "\\", BC.pack $ show $ ord c, "\\" ]
> +          | otherwise = BC.singleton c

Looks like the FilePath -> String representation should have been
written this way.  This and decodeWhite are the sort of function where
we have haddocks that show examples of what this does for clarity.  Said
haddocks should also be tests, IMHO.

> -ownName :: FileName -> FileName
> -ownName (FN f) =  case breakLast '/' f of Nothing -> FN f
> -                                          Just (_,f') -> FN f'
> -superName :: FileName -> FileName
> -superName fn = case normPath fn of
> -                FN f -> case breakLast '/' f of
> -                        Nothing -> FN "."
> -                        Just (d,_) -> FN d
> -breakOnDir :: FileName -> Maybe (FileName,FileName)
> -breakOnDir (FN p) = case breakFirst '/' p of
> -                      Nothing -> Nothing
> -                      Just (d,f) | d == "." -> breakOnDir $ FN f
> -                                 | otherwise -> Just (FN d, FN f)

> -dropDotdot :: [String] -> [String]
> -dropDotdot ("":p) = dropDotdot p
> -dropDotdot (".":p) = dropDotdot p
> -dropDotdot ("..":p) = ".." : (dropDotdot p)
> -dropDotdot (_:"..":p) = dropDotdot p
> -dropDotdot (d:p) = case dropDotdot p of
> -                    ("..":p') -> p'
> -                    p' -> d : p'
> -dropDotdot [] = []

This is the kind of thing which I expect is easy for us get wrong.  How
does the hashed-storage version compare?

> hunk ./src/Darcs/Patch/FileName.hs 102
> -movedirfilename :: FileName -> FileName -> FileName -> FileName
> -movedirfilename old new name =
> -    if name' == old' then new
> -                     else if length name' > length old' &&
> -                             take (length old'+1) name' == old'++"/"
> -                          then fp2fn ("./"++new'++drop (length old') name')
> -                          else name
> -    where old' = fn2fp $ normPath old
> -          new' = fn2fp $ normPath new
> -          name' = fn2fp $ normPath name

> +movedirfilename :: FileName -> FileName -> FileName -> FileName
> +movedirfilename old new name
> +  | old == name = new
> +  | old `isPrefix` name = new +/+ (suffix old name)
> +  | otherwise = name

I can believe the new one is cleaner/safer but it really could stand to
be checked.

[skimmed the rest of this]

Fix annotate that got broken due to path format change.
-------------------------------------------------------
I didn't really understand what broke here, so I didn't really
look at this much.

Replace FilePath with FileName in SelectChanges and ChooseTouching.
-------------------------------------------------------------------
Making a point of high-level only reviewing this was useful.  I imagine
that the idea is that SelectChanges and ChooseTouching are really
repo-local operations.  When working on the adventure branch, I might
suggest targeting certain local changes like this for mainline.

The rest of this was just a cursory look.

> -isMaliciousPath :: String -> Bool
> -isMaliciousPath fp =
> -    splitDirectories fp `contains_any` [ "..", darcsdir ]
> - where
> -    contains_any a b = not . null $ intersect a b
> +isMaliciousPath :: FileName -> Bool
> +isMaliciousPath fp = not $ nodarcs fp
> + where nodarcs (directory -> dir :/: rest) = dir /= "_darcs" && nodarcs rest
> +       nodarcs _ = True

Again the sort of thing we should really be careful with.
(I dimly recall seeing another patch that fixes this later)

Also, why is this "not . nodarcs" when it could be just "hasDarcs"?

> hunk ./src/Darcs/External.hs 108
> -backupByCopying :: FilePath -> IO ()
> +backupByCopying :: FileName -> IO ()

This also looks like a good idea, but perhaps it's a separate patch.

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

> -fix :: FilePath -> FilePath
> -fix f | "/" `isSuffixOf` f = fix $ init f
> -fix "" = "."
> -fix "." = "."
> -fix f = "./" ++ f

Hooray?  This seems to be just tidying up trailing dots and slashes
and I'm glad to see it go


Make SubPath just another alias for Relative.
---------------------------------------------
Yes, I like the idea that FileName and SubPath get consolidated.

I don't mean to bang on the testing drum again, but the fact that
we're sweeping it all into one central pile means it should be
even easier to have some tests.

-- 
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
For a faster response, try +44 (0)1273 64 2905 or
xmpp:kowey at jabber.fr (Jabber or Google Talk only)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 198 bytes
Desc: Digital signature
URL: <http://lists.osuosl.org/pipermail/darcs-users/attachments/20100831/73bef606/attachment.pgp>


More information about the darcs-users mailing list