darcs

Patch 421 getting rid of ComP constructor in Patch

Title getting rid of ComP constructor in Patch
Superseder Nosy List galbolle, ganesh
Related Issues
Status accepted Assigned To galbolle
Milestone

Created on 2010-10-17.11:23:35 by ganesh, last changed 2011-05-10.22:07:41 by darcswatch. Tracked on DarcsWatch.

Files
File name Status Uploaded Type Edit Remove
add-test-for-handling-of-v1-patches-with-nested-braces.dpatch ganesh, 2010-10-21.20:04:29 text/x-darcs-patch
make-send_output_v__sh-tests-more-robust-against-timezones.dpatch galbolle, 2010-11-14.12:33:33 text/x-darcs-patch
remove-locale-sensitivity-from-send-output-tests.dpatch ganesh, 2010-10-22.20:48:53 text/x-darcs-patch
show-instance-for-rl.dpatch ganesh, 2010-10-17.11:23:35 text/x-darcs-patch
unnamed ganesh, 2010-10-17.11:23:35
unnamed ganesh, 2010-10-21.20:04:29
unnamed ganesh, 2010-10-22.20:48:53
unnamed galbolle, 2010-11-14.12:33:33
See mailing list archives for discussion on individual patches.
Messages
msg12742 (view) Author: ganesh Date: 2010-10-17.11:23:35
This is the bundle implementing the changes that were briefly discussed
in http://lists.osuosl.org/pipermail/darcs-users/2010-October/025474.html

6 patches for repository http://darcs.net/screened:

Sun Oct 17 09:44:45 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * Show instance for RL

Thu Oct 14 07:03:30 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * simplify showContextHunk

Thu Oct 14 18:47:48 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * relax type of bracketedFL

Thu Oct 14 18:48:38 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * Clean up pending API a bit

Thu Oct 14 21:27:17 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * stop using Patch instances for reading/writing pending

Sun Oct 17 11:40:56 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * get rid of ComP
  This makes the treatment of v1 and v2 patches more consistent.
Attachments
msg12744 (view) Author: darcswatch Date: 2010-10-17.11:49:34
This patch bundle (with 6 patches) was just applied to the repository http://darcs.net/screened.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_screened.html#bundle-ac10b79f0d9861d6734c61241579589cab4b9a9f
msg12763 (view) Author: ganesh Date: 2010-10-17.20:20:22
I've identified a problem with this patch, namely that at least one repo 
out there does have nested ComP patches which were assumed not to exist. 
I'll send a followup as soon as I figure out the right fix. Apart from 
that issue, the bundle is still worth reviewing, but don't push it yet.
msg12796 (view) Author: ganesh Date: 2010-10-21.20:04:29
This bundle, which goes on top of the existing bundle as that's
already in screened, sorts out various problems I identified
after sending that.

In particular
(a) a few old repos have nested ComP patches that need to be parsed,
and
(b) we need to exactly reproduce the brace structure in showPatch
when checking the hash in a bundle

I've added tests of these issues.

The "push FL from Repository instances into Named" is something I'd
intended to submit separately as it is a bit of a structural change
in the way patches are handled - Named p now contains FL p rather than
just p - but it turned out to make the fix for the problems above
much easier so I've bundled it up with this work.

The whole lot should now be ready to go into unstable once reviewed.

8 patches for repository http://darcs.net/screened:

Tue Oct 19 06:22:36 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add test for handling of v1 patches with nested braces

Wed Oct 20 07:18:01 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add test of V1 send output

Wed Oct 20 07:56:58 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * showContextPatch FL needs to manage braces too

Thu Oct 21 07:43:10 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * push FL from Repository instances into Named

Thu Oct 21 18:11:49 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * get rid of unneeded pragma

Thu Oct 21 18:40:43 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add test of send adding context around hunks

Thu Oct 21 18:58:46 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * make send output tests for v2 repos

Thu Oct 21 19:00:03 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * fix regressions in V1 patch reading/hash recalc
Attachments
msg12804 (view) Author: ganesh Date: 2010-10-22.20:48:53
The tests above have the same issue as with patch420/patch434. This
should fix them.

1 patch for repository http://darcs.net/screened:

Fri Oct 22 21:41:06 BST 2010  Ganesh Sittampalam <ganesh@earth.li>
  * remove locale sensitivity from send output tests
Attachments
msg12999 (view) Author: galbolle Date: 2010-11-11.17:20:22
Here is the review for the 5 first patches

Show instance for RL
--------------------
Ganesh Sittampalam <ganesh@earth.li>**20101017084445

hunk ./src/Darcs/Witnesses/Ordered.hs 97
>  instance Show2 a => Show2 (FL a) where
>     showDict2 = ShowDictClass
>  
> +instance Show2 a => Show (RL a C(x z)) where
> +   showsPrec _ NilRL = showString "NilRL"
> +   showsPrec d (x :<: xs) = showParen (d > prec) $ showsPrec2 (prec + 
1) x .
> +                            showString " :<: " . showsPrec (prec + 1) 
xs
> +       where prec = 5
> +
> +instance Show2 a => Show1 (RL a C(x)) where
> +   showDict1 = ShowDictClass
> +
> +instance Show2 a => Show2 (RL a) where
> +   showDict2 = ShowDictClass
> +
>  -- reverse list
>  data RL a C(x z) where
>      (:<:) :: a C(y z) -> RL a C(x y) -> RL a C(x z)

Ok

simplify showContextHunk
------------------------
Ganesh Sittampalam <ganesh@earth.li>**20101014060330

hunk ./src/Darcs/Patch/V1/Viewing.hs 20
>  
>  instance ShowPatch Patch where
>      showPatch = showPatch_
> -    showContextPatch (PP x) | primIsHunk x = showContextHunk (PP x)
> +    showContextPatch (PP x) | primIsHunk x = showContextHunk x
>      showContextPatch (ComP NilFL) = return $ blueText "{" $$ blueText 
"}"
>      showContextPatch (ComP ps) =
>          do x <- showContextSeries ps

hunk ./src/Darcs/Patch/Viewing.hs 91
>                                       return $ a $$ fst b
>            scs _ NilFL = return empty
>  
> -showContextHunk :: (Apply p, ShowPatch p, Effect p) => p C(x y) -> 
TreeIO Doc
> -showContextHunk p = case isHunk p of
> -                      Just h -> coolContextHunk identity h identity
> -                      Nothing -> return $ showPatch p
> +-- |Thist must only be called with a hunk patch
> +showContextHunk :: Prim C(x y) -> TreeIO Doc
> +showContextHunk h = coolContextHunk identity h identity
>  
>  coolContextHunk :: Prim C(a b) -> Prim C(b c) -> Prim C(c d) -> 
TreeIO Doc
>  coolContextHunk prev p@(FP f (Hunk l o n)) next = do

Ok

relax type of bracketedFL
-------------------------
Ganesh Sittampalam <ganesh@earth.li>**20101014174748

Remove useless (ReadPatch p) constraint

hunk ./src/Darcs/Patch/Read.hs 82
>                               return $ Just $ Sealed $ reverseFL fl
>  
>  {-# INLINE bracketedFL #-}
> -bracketedFL :: forall p m C(x) . (ReadPatch p, ParserM m) =>
> +bracketedFL :: forall p m C(x) . (ParserM m) =>
>                 (FORALL(y) m (Maybe (Sealed (p C(y))))) -> Char -> 
Char -> m (Maybe (Sealed (FL p C(x))))
>  bracketedFL parser pre post =
>      peekforc pre bfl (return Nothing)

ok

Clean up pending API a bit
--------------------------
Ganesh Sittampalam <ganesh@earth.li>**20101014174838

hunk ./src/Darcs/Repository/Internal.hs 56

hunk ./src/Darcs/Repository/Internal.hs 77

hunk ./src/Darcs/Repository/Internal.hs 106

hunk ./src/Darcs/Repository/Internal.hs 118
[imports]

hunk ./src/Darcs/Repository/Internal.hs 313
>      do let newname = pendingName tp ++ ".new"
>         debugMessage $ "Writing new pending:  " ++ newname
>         Sealed sfp <- return $ siftForPending origp
> -       writeSealedPatch newname $ seal $ fromPrims $ sfp
> +       writePendingFile newname sfp
>         cur <- readRecorded repo
>         Sealed p <- readPendingfile newname
>         catch (applyToTree p cur) $ \err -> do

hunk ./src/Darcs/Repository/Internal.hs 325
>                      $$ text "along with a bug report."
>         renameFile newname (pendingName tp)
>         debugMessage $ "Finished writing new pending:  " ++ newname
> -    where writeSealedPatch :: FilePath -> Sealed (Patch C(x)) -> IO 
()
> -          writeSealedPatch fp (Sealed p) = writePatch fp p
>  
>  siftForPending :: FL Prim C(x y) -> Sealed (FL Prim C(x))
>  siftForPending simple_ps =

Stop reimplementing writePendingFile

hunk ./src/Darcs/Repository/Internal.hs 384
>  handlePendForAdd :: forall p q C(r u t x y). (RepoPatch p, Effect q)
>                      => Repository p C(r u t) -> q C(x y) -> IO ()
>  handlePendForAdd (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = 
return ()
> -handlePendForAdd (Repo _ _ _ rt) p =
> -    do let pn = pendingName rt ++ ".tentative"
> -       Sealed pend <- (readPrims `fmap` gzReadFilePS pn) `catchall` 
(return $ Sealed NilFL)
> +handlePendForAdd repo p =
> +    do
> +       Sealed pend <- readTentativePending repo
>         let effectp = if allFL isSimple pend then crudeSift $ effect p
>                                               else effect p

Stop reimplementing readTentativePending

hunk ./src/Darcs/Repository/Internal.hs 389
> -       Sealed newpend <- return $ rmpend (progressFL "Removing from 
pending:" effectp) pend
> -       writePatch pn $ fromPrims_ newpend
> +       Sealed newpend <- return $ rmpend (progressFL "Removing from 
pending:" effectp) (unsafeCoercePStart pend)
> +       writeTentativePending repo (unsafeCoercePStart newpend)
>      where rmpend :: FL Prim C(a b) -> FL Prim C(a c) -> Sealed (FL 
Prim C(b))
>            rmpend NilFL x = Sealed x
>            rmpend _ NilFL = Sealed NilFL

See above

hunk ./src/Darcs/Repository/Internal.hs 406
>                                          -- reached, but it also
>                                          -- shouldn't lead to
>                                          -- corruption.
> -          fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> -          fromPrims_ = fromPrims
>  
>  isSimple :: Prim C(x y) -> Bool
>  isSimple x = primIsHunk x || primIsBinary x || primIsSetpref x

No longer needed

hunk ./src/Darcs/Repository/Internal.hs 503
>  tentativelyAddToPending (Repo _ opts _ _) _ _
>      | NoUpdateWorking `elem` opts = return ()
>      | DryRun `elem` opts = bug "tentativelyAddToPending called when -
-dry-run is specified"
> -tentativelyAddToPending (Repo dir _ _ rt) _ patch =
> +tentativelyAddToPending repo@(Repo dir _ _ _) _ patch =
>      withCurrentDirectory dir $ do

hunk ./src/Darcs/Repository/Internal.hs 505
> -      let pn = pendingName rt
> -          tpn = pn ++ ".tentative"
> -      Sealed pend <- readPrims `liftM` (gzReadFilePS tpn `catchall` 
(return B.empty))
> +      Sealed pend <- readTentativePending repo
>        FlippedSeal newpend_ <- return $ newpend (unsafeCoerceP pend :: 
FL Prim C(a x)) patch

ibidem

hunk ./src/Darcs/Repository/Internal.hs 507
> -      writePatch tpn $ fromPrims_ newpend_
> +      writeTentativePending repo (unsafeCoercePStart newpend_)
>        where newpend :: FL Prim C(a b) -> FL Prim C(b c) -> 
FlippedSeal (FL Prim) C(c)
>              newpend NilFL patch_ = flipSeal patch_
>              newpend p     patch_ = flipSeal $ p +>+ patch_

Why seal then coerce, rather than coerce directly?

hunk ./src/Darcs/Repository/Internal.hs 511
> -            fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> -            fromPrims_ = fromPrims
>  
>  -- | setTentativePending is basically unsafe.  It overwrites the 
pending state with a new one, not related to
>  -- the repository state.

No longer needed, thanks to readTentativePending

hunk ./src/Darcs/Repository/Internal.hs 516
>  setTentativePending :: forall p C(r u t x y). RepoPatch p => 
Repository p C(r u t) -> FL Prim C(x y) -> IO ()
>  setTentativePending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts 
= return ()
> -setTentativePending (Repo dir _ _ rt) patch = do
> +setTentativePending repo@(Repo dir _ _ _) patch = do
>      Sealed prims <- return $ siftForPending patch

hunk ./src/Darcs/Repository/Internal.hs 518
> -    withCurrentDirectory dir $
> -      writePatch (pendingName rt ++ ".tentative") $ fromPrims_ prims
> -    where fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> -          fromPrims_ = fromPrims
> +    withCurrentDirectory dir $ writeTentativePending repo 
(unsafeCoercePStart prims)
>  
>  -- | prepend is basically unsafe.  It overwrites the pending state
>  -- with a new one, not related to the repository state.

as above

hunk ./src/Darcs/Repository/Internal.hs 525
>  prepend :: forall p C(r u t x y). RepoPatch p =>
>             Repository p C(r u t) -> FL Prim C(x y) -> IO ()
>  prepend (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()
> -prepend (Repo _ _ _ rt) patch =
> -    do let pn = pendingName rt ++ ".tentative"
> -       Sealed pend <- readPrims `liftM` (gzReadFilePS pn `catchall` 
(return B.empty))
> -       Sealed newpend_ <- return $ newpend pend patch
> -       writePatch pn $ fromPrims_ (crudeSift newpend_)
> +prepend repo@(Repo _ _ _ _) patch =
> +    do
> +       Sealed pend <- readTentativePending repo
> +       Sealed newpend_ <- return $ newpend (unsafeCoerceP pend) patch
> +       writeTentativePending repo (unsafeCoercePStart $ crudeSift 
newpend_)
>        where newpend :: FL Prim C(b c) -> FL Prim C(a b) -> Sealed (FL 
Prim C(a))
>              newpend NilFL patch_ = seal patch_
>              newpend p     patch_ = seal $ patch_ +>+ p

as above, why seal then coerce?

What's more, there are unsafeCoerces because of the function's
unsafety. On the other hand, prepend is called only once, with
x = t. Shouldn't it be reflected in its type, and wouldn't it reduce
the need for unsafeCoerces?

hunk ./src/Darcs/Repository/Internal.hs 533
> -            fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> -            fromPrims_ = fromPrims
>  
>  tentativelyRemovePatches :: RepoPatch p => Repository p C(r u t) -> 
Compression
>                           -> FL (PatchInfoAnd p) C(x t) -> IO 
(Repository p C(r u x))

ok

hunk ./src/Darcs/Repository/Internal.hs 570
>  finalizePending (Repo dir opts _ rt)
>      | NoUpdateWorking `elem` opts =
>          withCurrentDirectory dir $ removeFileMayNotExist $ 
(pendingName rt)
> -finalizePending repository@(Repo dir _ _ rt) = do
> -  withCurrentDirectory dir $ do let pn = pendingName rt
> -                                    tpn = pn ++ ".tentative"
> -                                tpfile <- gzReadFilePS tpn `catchall` 
(return B.empty)
> -                                Sealed tpend <- return $ readPrims 
tpfile
> +finalizePending repository@(Repo dir _ _ _) = do
> +  withCurrentDirectory dir $ do
> +                                Sealed tpend <- readTentativePending 
repository
>                                  Sealed new_pending <- return $ 
siftForPending tpend
>                                  makeNewPending repository new_pending
>  

idem, we stop reinventing the wheel

replace ./src/Darcs/Repository/Internal.hs [A-Za-z_0-9] readPendingfile 
readPendingFile

replace ./src/Darcs/Repository/Internal.hs [A-Za-z_0-9] readPrims 
readPendingContents

clearer

hunk ./src/Darcs/Repository/LowLevel.hs 23
>  
>  #include "gadts.h"
>  
> -module Darcs.Repository.LowLevel ( readPending, readPendingfile, 
pendingName, readPrims ) where
> +module Darcs.Repository.LowLevel
> +    ( readPending, readTentativePending
> +    , writeTentativePending
> +    -- deprecated interface:
> +    , readPendingfile, writePendingFile
> +    , pendingName )
> +    where
>  
>  import Darcs.Repository.InternalTypes ( RepoType(..), Repository(..) 
)

Would it be possible to tell hlint that these functions are deprecated?

hunk ./src/Darcs/Repository/LowLevel.hs 32
> -import Darcs.Patch ( readPatch, Prim, RepoPatch, effect )
> +import Darcs.Patch ( readPatch, writePatch, Prim, effect, fromPrims )
>  import Darcs.Patch.V1 ( Patch ) -- needed for readPrims
>  import Darcs.Global ( darcsdir )
>  import Darcs.Witnesses.Sealed ( Sealed(Sealed) )

hunk ./src/Darcs/Repository/LowLevel.hs 37
>  import Darcs.Witnesses.Ordered ( FL(..) )
> -import Darcs.Utils ( catchall, withCurrentDirectory )
> +import Darcs.Utils ( catchall )
>  import ByteStringUtils ( gzReadFilePS )
>  import qualified Data.ByteString as BS ( ByteString, empty )
>  

hunk ./src/Darcs/Repository/LowLevel.hs 44
>  pendingName :: RepoType p -> String
>  pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending"
>  
> -readPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL 
Prim C(t)))
> -readPending (Repo r _ _ tp) =
> -    withCurrentDirectory r (readPendingfile (pendingName tp))
> +-- | Read the contents of pending. CWD should be the repository 
directory.
> +-- The return type is currently incorrect as it refers to the 
tentative
> +-- state rather than the recorded state.
> +readPending :: Repository p C(r u t) -> IO (Sealed (FL Prim C(t)))
> +readPending (Repo _ _ _ tp) =
> +    readPendingfile (pendingName tp)
> +
> +-- |Read the contents of tentative pending. CWD should be the 
repository directory.
> +readTentativePending :: Repository p C(r u t) -> IO (Sealed (FL Prim 
C(t)))
> +readTentativePending (Repo _ _ _ tp) =
> +    readPendingfile (pendingName tp ++ ".tentative")
>  
>  readPendingfile :: String -> IO (Sealed (FL Prim C(x)))
>  readPendingfile name = do

darcs does not compile if we correct the type of readPending. Does
that means (potential) bugs?

hunk ./src/Darcs/Repository/LowLevel.hs 65
>  readPrims s = case readPatch s :: Maybe (Sealed (Patch C(x )), 
BS.ByteString) of
>                Nothing -> Sealed NilFL
>                Just (Sealed p,_) -> Sealed (effect p)
> -

hunk ./src/Darcs/Repository/LowLevel.hs 66
> +writePendingFile :: String -> FL Prim C(x y) -> IO ()
> +writePendingFile name pend = writePatch name $ fromPrims_ pend
> +  where fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> +        fromPrims_ = fromPrims
> +
> +-- |Read the contents of tentative pending. CWD should be the 
repository directory.
> +writeTentativePending :: Repository p C(r u t) -> FL Prim C(t y) -> 
IO ()
> +writeTentativePending (Repo _ _ _ tp) pend =
> +    writePendingFile (pendingName tp ++ ".tentative") pend

s/-- |Read/-- |Write/

replace ./src/Darcs/Repository/LowLevel.hs [A-Za-z_0-9] readPendingfile 
readPendingFile

replace ./src/Darcs/Repository/LowLevel.hs [A-Za-z_0-9] readPrims 
readPendingContents

ok

stop using Patch instances for reading/writing pending
------------------------------------------------------
Ganesh Sittampalam <ganesh@earth.li>**20101014202717

hunk ./src/Darcs/Repository/LowLevel.hs 32

hunk ./src/Darcs/Repository/LowLevel.hs 37

hunk ./src/Darcs/Repository/LowLevel.hs 41
[imports]

hunk ./src/Darcs/Repository/LowLevel.hs 67
>    pend <- gzReadFilePS name `catchall` return BS.empty
>    return $ readPendingContents pend
>  
> +-- Wrapper around FL where printed format uses { } except around 
singletons
> +newtype FLM p C(x y) = FLM { unFLM :: FL p C(x y) }
> +
> +instance ReadPatch p => ReadPatch (FLM p) where
> +   readPatch' want_eof =
> +       do res <- fmap (mapSeal FLM) <$> readMaybeBracketedFL 
(readPatch' False) '{' '}'
> +          when want_eof lexEof
> +          return res
> +
> +instance ShowPatch p => ShowPatch (FLM p) where
> +   showPatch = showMaybeBracketedFL showPatch '{' '}' . unFLM
> +
>  readPendingContents :: BS.ByteString -> Sealed (FL Prim C(x))

ok

hunk ./src/Darcs/Repository/LowLevel.hs 80
> -readPendingContents s = case readPatch s :: Maybe (Sealed (Patch C(x 
)), BS.ByteString) of
> -              Nothing -> Sealed NilFL
> -              Just (Sealed p,_) -> Sealed (effect p)
> +readPendingContents = maybe (Sealed NilFL) (mapSeal unFLM . fst) . 
readPatch
>  
>  writePendingFile :: String -> FL Prim C(x y) -> IO ()

ok

hunk ./src/Darcs/Repository/LowLevel.hs 83
> -writePendingFile name pend = writePatch name $ fromPrims_ pend
> -  where fromPrims_ :: FL Prim C(a b) -> Patch C(a b)
> -        fromPrims_ = fromPrims
> +writePendingFile name = writePatch name . FLM
> +
> +readMaybeBracketedFL :: forall m p C(x) . ParserM m =>
> +                         (FORALL(y) m (Maybe (Sealed (p C(y))))) -> 
Char -> Char -> m (Maybe (Sealed (FL p C(x))))
> +readMaybeBracketedFL parser pre post =
> +  do mps <- bracketedFL parser pre post
> +     case mps of
> +       Just res -> return (Just res)
> +       Nothing -> fmap (mapSeal (:>:NilFL)) <$> parser
> +
> +showMaybeBracketedFL :: (FORALL(x y) p C(x y) -> Doc) -> Char -> Char 
-> FL p C(a b) -> Doc
> +showMaybeBracketedFL _       pre post NilFL         = text [pre] $$ 
text [post]
> +showMaybeBracketedFL printer _   _    (p :>: NilFL) = printer p
> +showMaybeBracketedFL printer pre post ps            = text [pre] $$ 
vcat (mapFL printer ps) $$ text [post]
>  
>  -- |Read the contents of tentative pending. CWD should be the 
repository directory.
>  writeTentativePending :: Repository p C(r u t) -> FL Prim C(t y) -> 
IO ()

Ok
msg13000 (view) Author: galbolle Date: 2010-11-11.20:09:37
>  import Darcs.Repository.Checkpoint ( writeCheckpointPatch, 
getCheckpoint )
>  import Darcs.Patch ( RepoPatch, apply, patch2patchinfo, invert, 
effect )
>  import Darcs.Patch.V1 ( Patch ) -- needed by some code that should be 
refactored into Repository
> -import Darcs.Witnesses.Ordered ( RL(..), reverseRL, lengthFL, 
mapFL_FL, (:>>)(..) )
> +import Darcs.Witnesses.Ordered ( FL, RL(..), reverseRL, lengthFL, 
mapFL_FL, (:>>)(..) )
>  import Darcs.External ( copyFileOrUrl, Cachable(..) )
>  import Darcs.Hopefully ( hopefully )
>  import Darcs.Patch.Depends ( findCommonWithThem, countUsThem, 
getPatchesBeyondTag )
msg13001 (view) Author: galbolle Date: 2010-11-11.20:37:12
get rid of ComP
---------------

Ganesh Sittampalam <ganesh@earth.li>**20101017104056

=======================================================================
New general stuff about patches, FLs and witnesses needed by the rest

hunk ./src/Darcs/Witnesses/Ordered.hs 34
>                               nullFL, concatFL, concatRL,
>                               consRLSealed, nullRL, toFL,
>                               (:>>)(..), dropWhileFL, dropWhileRL,
> -                             spanFL_M
> +                             spanFL_M,
> +                             eqFL, eqFLRev, eqFLUnsafe
>                             ) where
>  
>  #include "impossible.h"

Three new functions:
eqFL forgets the last witnesses, eqFLRev the firsts, and eqFLUnsafe all.

hunk ./src/Darcs/Witnesses/Ordered.hs 285
> +-- |Check that two 'FL's are equal element by element.
> +-- This differs from the 'MyEq' instance for 'FL' which
> +-- uses commutation.
> +eqFL :: MyEq a => FL a C(x y) -> FL a C(x z) -> EqCheck C(y z)
> +eqFL NilFL NilFL = IsEq
> +eqFL (x:>:xs) (y:>:ys) | IsEq <- x =\/= y, IsEq <- eqFL xs ys = IsEq
> +eqFL _ _ = NotEq
> +
> +eqFLRev :: MyEq a => FL a C(x z) -> FL a C(y z) -> EqCheck C(x y)
> +eqFLRev NilFL NilFL = IsEq
> +eqFLRev (x:>:xs) (y:>:ys) | IsEq <- eqFLRev xs ys, IsEq <- x =/\= y = 
IsEq
> +eqFLRev _ _ = NotEq
> +
> +eqFLUnsafe :: MyEq a => FL a C(x y) -> FL a C(z w) -> Bool
> +eqFLUnsafe NilFL NilFL = True
> +eqFLUnsafe (x:>:xs) (y:>:ys) = unsafeCompare x y && eqFLUnsafe xs ys
> +eqFLUnsafe _ _ = False

hunk ./src/Darcs/Witnesses/Ordered.hs 95
>                              showString " :>: " . showsPrec (prec + 1) 
xs
>         where prec = 5
>  
> +instance Show2 a => Show1 (FL a C(x)) where
> +   showDict1 = ShowDictClass
> +
>  instance Show2 a => Show2 (FL a) where
>     showDict2 = ShowDictClass
>  

ok

hunk ./src/Darcs/Patch/Permutations.hs 32
>                                    headPermutationsFL,
>                                    removeSubsequenceFL, 
removeSubsequenceRL,
>                                    partitionConflictingFL,
> -                                  CommuteFn, selfCommuter, 
commuterIdRL,
> +                                  CommuteFn, selfCommuter,
> +                                  commuterIdFL, commuterFLId,
> +                                  commuterIdRL
>                                  ) where
>  
>  import Data.Maybe ( catMaybes )

hunk ./src/Darcs/Patch/Permutations.hs 269
>         y' :> x'' <- commuter (x' :> y)
>         return ((y' :<: ys') :> x'')
>  
> +commuterIdFL :: CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
> +commuterIdFL _ (x :> NilFL) = return (NilFL :> x)
> +commuterIdFL commuter (x :> (y :>: ys))
> +  = do y' :> x' <- commuter (x :> y)
> +       ys' :> x'' <- commuterIdFL commuter (x' :> ys)
> +       return ((y' :>: ys') :> x'')

commutes a patch past a FL of patches, given a commute function

> +
> +commuterFLId :: CommuteFn p1 p2 -> CommuteFn (FL p1) p2
> +commuterFLId _ (NilFL :> y) = return (y :> NilFL)
> +commuterFLId commuter ((x :>: xs) :> y)
> +  = do y' :> xs' <- commuterFLId commuter (xs :> y)
> +       y'' :> x' <- commuter (x :> y')
> +       return (y'' :> (x' :>: xs'))
> +
>  -- |Partition a list into the patches that commute with the given 
patch and those that don't (including dependencies)
>  partitionConflictingFL :: (Commute p1, Invert p1) => CommuteFn p1 p2 
-> FL p1 C(x y) -> p2 C(x z) -> (FL p1 :> FL p1) C(x y)
>  partitionConflictingFL _ NilFL _ = (NilFL :> NilFL)

commutes a FL of patches past a patch, given a commute function

========================================================================
Core modifications of the representation of V1 patches.

hunk ./src/Darcs/Patch/Prim.lhs 1026
>  instance ToFromPrim Prim where
>      toPrim = Just . id
>  
> +instance FromPrim p => FromPrim (FL p) where
> +    fromPrim p = fromPrim p :>: NilFL
>  instance FromPrim p => FromPrims (FL p) where
>      fromPrims = mapFL_FL fromPrim
>      joinPatches = concatFL

ok

hunk ./src/Darcs/Patch/V1.hs 5
[imports]


hunk ./src/Darcs/Patch/V1.hs 16
>  
>  instance Patchy Patch
>  instance RepoPatchBase Patch
> -instance RepoPatch Patch

'Patch'es are never seen in RepoPatches, only 'FL Patch'es.


hunk ./src/Darcs/Patch/V1/Core.lhs 4
[exports]

hunk ./src/Darcs/Patch/V1/Core.lhs 10
[imports]

hunk ./src/Darcs/Patch/V1/Core.lhs 17
>  
>  data Patch C(x y) where
>      PP :: Prim C(x y) -> Patch C(x y)
> -    ComP :: FL Patch C(x y) -> Patch C(x y)
> -    Merger :: Patch C(x y)
> +    Merger :: FL Patch C(x y)
>             -> RL Patch C(x b)
>             -> Patch C(c b)
>             -> Patch C(c d)
>             -> Patch C(x y)
> -    Regrem :: Patch C(x y)
> +    Regrem :: FL Patch C(x y)
>             -> RL Patch C(x b)
>             -> Patch C(c b)
>             -> Patch C(c a)

Removal of ComP

hunk ./src/Darcs/Patch/V1/Core.lhs 31
>  instance FromPrim Patch where
>      fromPrim = PP
>  
> -isNullPatch :: Patch C(x y) -> Bool
> -nullP :: Patch C(x y) -> EqCheck C(x y)
>

ok

hunk ./src/Darcs/Patch/V1/Core.lhs 36
>  isMerger _ = False
>  
> -mergerUndo :: Patch C(x y) -> Patch C(x y)
> +mergerUndo :: Patch C(x y) -> FL Patch C(x y)
>  mergerUndo (Merger undo _ _ _) = undo
>  mergerUndo _ = impossible
>  
ok

hunk ./src/Darcs/Patch/V1/Core.lhs 40
> -\end{code}
> -
> -%Another nice thing to be able to do with composite patches is to 
`flatten'
> -%them, that is, turn them into a simple list of patches 
(appropriately
> -%ordered, of course), with all nested compositeness unnested.
> -
> -\begin{code}
> +-- TODO this is a relic from the days in which Patch had a ComP 
constructor
> +-- for nesting lists. It is likely completely useless now but is 
still used
> +-- in a couple of places which need to be checked before removig it.
>  {- INLINE flattenFL -}
>  flattenFL :: Patch C(x y) -> FL Patch C(x y)

noted

hunk ./src/Darcs/Patch/V1/Core.lhs 45
> -flattenFL (ComP ps) = concatFL (mapFL_FL flattenFL ps)
>  flattenFL (PP Identity) = NilFL
>  flattenFL p = p :>: NilFL
>  
ok

hunk ./src/Darcs/Patch/V1/Core.lhs 48
> -joinPatchesFL :: FL Patch C(x y) -> Patch C(x y)
> -joinPatchesFL ps = ComP $! ps
> -
ok


hunk ./src/Darcs/Patch/V1/Apply.hs 12
[imports]

hunk ./src/Darcs/Patch/V1/Apply.hs 19
>  instance Apply Patch where
>      apply p = applyFL $ 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

hunk ./src/Darcs/Patch/V1/Apply.hs 20
> -    applyAndTryToFix (ComP xs) = mapMaybeSnd ComP `fmap` 
applyAndTryToFix xs
> -    applyAndTryToFix x = do mapMaybeSnd ComP `fmap` 
applyAndTryToFixFL x
> -
> +    applyAndTryToFix (PP x) = do mapMaybeSnd PP `fmap` 
applyAndTryToFix x
> +    applyAndTryToFix x = do apply x; return Nothing
ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 26
>  #include "gadts.h"
>  
>  module Darcs.Patch.V1.Commute
[exports]

hunk ./src/Darcs/Patch/V1/Commute.lhs 45

hunk ./src/Darcs/Patch/V1/Commute.lhs 50

hunk ./src/Darcs/Patch/V1/Commute.lhs 62
[imports]

hunk ./src/Darcs/Patch/V1/Commute.lhs 173
>            p2_modifies = isFilepatchMerger p2
>  
>  everythingElseCommute :: MaybeCommute -> CommuteFunction
> -everythingElseCommute c x = eec x
> +everythingElseCommute _ x = eec x
>      where
>      eec :: CommuteFunction
>      eec (PP px :< PP py) = toPerhaps $ do x' :> y' <- commute (py :> 
px)

hunk ./src/Darcs/Patch/V1/Commute.lhs 178
>                                            return (PP y' :< PP x')
> -    eec (ComP NilFL :< p1) = Succeeded (unsafeCoerceP p1 :< (ComP 
NilFL))
> -    eec (p2 :< ComP NilFL) = Succeeded (ComP NilFL :< unsafeCoerceP 
p2)
> -    eec (ComP (p:>:ps) :< p1) = toPerhaps $ do
> -                              (p1' :< p') <- c (p :< p1)
> -                              (p1'' :< ComP ps') <- c (ComP ps :< 
p1')
> -                              return (p1'' :< ComP (p':>:ps'))
> -    eec (patch2 :< ComP patches) =
> -        toPerhaps $ do (patches' :< patch2') <- ccr (patch2 :< 
reverseFL patches)
> -                       return (ComP (reverseRL patches') :< patch2')
> -        where ccr :: FORALL(x y) (Patch :< RL Patch) C(x y) -> Maybe 
((RL Patch :< Patch) C(x y))
> -              ccr (p2 :< NilRL) = seq p2 $ return (NilRL :< p2)
> -              ccr (p2 :< p:<:ps) = do (p' :< p2') <- c (p2 :< p)
> -                                      (ps' :< p2'') <- ccr (p2' :< 
ps)
> -                                      return (p':<:ps' :< p2'')
>      eec _xx =
>          msum [
>                cleverCommute commuteRecursiveMerger       _xx
removal of all ComP cases

hunk ./src/Darcs/Patch/V1/Commute.lhs 234
>  
>  instance PatchInspect Patch where
>      -- Recurse on everything, these are potentially spoofed patches
> -    listTouchedFiles (ComP ps) = nubsort $ concat $ mapFL 
listTouchedFiles ps
>      listTouchedFiles (Merger _ _ p1 p2) = nubsort $ listTouchedFiles 
p1
>                                              ++ listTouchedFiles p2
>      listTouchedFiles c@(Regrem _ _ _ _) = listTouchedFiles $ invert c

ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 239
>      listTouchedFiles (PP p) = listTouchedFiles p
>  
> -    hunkMatches f (ComP ps) = or $ mapFL (hunkMatches f) ps
>      hunkMatches f (Merger _ _ p1 p2) = hunkMatches f p1 || 
hunkMatches f p2
>      hunkMatches f c@(Regrem _ _ _ _) = hunkMatches f $ invert c
>      hunkMatches f (PP p) = hunkMatches f p

ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 256
>       if f1 == f2 then return f1 else Nothing
>  isFilepatchMerger (Regrem und unw p1 p2)
>      = isFilepatchMerger (Merger und unw p1 p2)
> -isFilepatchMerger (ComP _) = Nothing
>  
>  commuteRecursiveMerger :: (Patch :< Patch) C(x y) -> Perhaps ((Patch 
:< Patch) C(x y))
>  commuteRecursiveMerger (p@(Merger _ _ p1 p2) :< pA) = toPerhaps $

ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 259
> -  do (_ :> pA') <- commute (pA :> undo)
> -     commute (pA' :> invert undo)
> +  do (_ :> pA') <- commuterIdFL selfCommuter (pA :> undo)
> +     commuterIdFL selfCommuter (pA' :> invert undo)
>       (_ :> pAmid) <- commute (pA :> unsafeCoercePStart (invert p1))
>       (p1' :> pAx) <- commute (pAmid :> p1)
>       guard (pAx `unsafeCompare` pA)

pA is now a FL

hunk ./src/Darcs/Patch/V1/Commute.lhs 271
>                then unsafeCoerceP p
>                else unsafeMerger "0.0" p1' p2'
>           undo' = mergerUndo p'
> -     (pAo :> _) <- commute (undo' :> pA')
> +     (pAo :> _) <- commuterFLId selfCommuter (undo' :> pA')
>       guard (pAo `unsafeCompare` pA)
>       return (pA' :< p')
>      where undo = mergerUndo p

idem

hunk ./src/Darcs/Patch/V1/Commute.lhs 280
>  otherCommuteRecursiveMerger :: (Patch :< Patch) C(x y) -> Perhaps 
((Patch :< Patch) C(x y))
>  otherCommuteRecursiveMerger (pA':< p_old@(Merger _ _ p1' p2')) =
>    toPerhaps $
> -  do (pA :> _) <- commute (mergerUndo p_old :> pA')
> +  do (pA :> _) <- commuterFLId selfCommuter (mergerUndo p_old :> pA')
>       (pAmid :> p1) <- commute (unsafeCoercePEnd p1' :> pA)
>       (_ :> pAmido) <- commute (pA :> invert p1)
>       guard (pAmido `unsafeCompare` pAmid)

likewise

hunk ./src/Darcs/Patch/V1/Commute.lhs 292
>               else unsafeMerger "0.0" p1 p2
>           undo = mergerUndo p
>       guard (not $ pA `unsafeCompare` p1) -- special case here...
> -     (_ :> pAo') <- commute (pA :> undo)
> +     (_ :> pAo') <- commuterIdFL selfCommuter (pA :> undo)
>       guard (pAo' `unsafeCompare` pA')
>       return (p :< pA)
>  otherCommuteRecursiveMerger _ = Unknown

same

hunk ./src/Darcs/Patch/V1/Commute.lhs 299
>  
>  type CommuteFunction = FORALL(x y) (Patch :< Patch) C(x y) -> Perhaps 
((Patch :< Patch) C(x y))
>  type MaybeCommute = FORALL(x y) (Patch :< Patch) C(x y) -> Maybe 
((Patch :< Patch) C(x y))
> +
> +revCommuteFLId :: MaybeCommute -> (FL Patch :< Patch) C(x y) -> Maybe 
((Patch :< FL Patch) C(x y))
> +revCommuteFLId _        (NilFL :< p) = return (p :< NilFL)
> +revCommuteFLId commuter ((q :>: qs) :< p) = do
> +   p' :< q' <- commuter (q :< p)
> +   p'' :< qs' <- revCommuteFLId commuter (qs :< p')
> +   return (p'' :< (q' :>: qs'))
> +
Why not in Permutations.hs?

hunk ./src/Darcs/Patch/V1/Commute.lhs 421
>  
>  actualMerge :: (Patch :\/: Patch) C(x y) -> Sealed (Patch C(y))
>  
> -actualMerge (ComP the_p1s :\/: ComP the_p2s) =
> -    mapSeal joinPatchesFL $ mc (the_p1s :\/: the_p2s)
> -    where mc :: (FL Patch :\/: FL Patch) C(x y) -> Sealed (FL Patch 
C(y))
> -          mc (NilFL :\/: (_:>:_)) = Sealed NilFL
> -          mc (p1s :\/: NilFL) = Sealed p1s
> -          mc (p1s :\/: (p2:>:p2s)) = case mergePatchesAfterPatch 
(p1s:\/:p2) of
> -                                       Sealed x -> mc (x:\/:p2s)
> -actualMerge (ComP p1s :\/: p2) = seq p2 $
> -                              mapSeal joinPatchesFL $ 
mergePatchesAfterPatch (p1s:\/:p2)
> -actualMerge (p1 :\/: ComP p2s) = seq p1 $ mergePatchAfterPatches 
(p1:\/:p2s)
> -
>  actualMerge (p1 :\/: p2) = case elegantMerge (p1:\/:p2) of
>                               Just (_ :/\: p1') -> Sealed p1'
>                               Nothing -> merger "0.0" p2 p1
get rid of ComP cases

hunk ./src/Darcs/Patch/V1/Commute.lhs 425
>  
> -mergePatchAfterPatches :: (Patch :\/: FL Patch) C(x y) -> Sealed 
(Patch C(y))
> -mergePatchAfterPatches (p :\/: (p1:>:p1s)) =
> -    case actualMerge (p:\/:p1) of
> -     Sealed x -> mergePatchAfterPatches (x :\/: p1s)
> -mergePatchAfterPatches (p :\/: NilFL) = Sealed p
> -
> -mergePatchesAfterPatch :: (FL Patch :\/: Patch) C(x y) -> Sealed (FL 
Patch C(y))
> -mergePatchesAfterPatch (p2s :\/: p) =
> -    case mergePatchAfterPatches (p :\/: p2s) of
> -     Sealed x -> case commute (joinPatchesFL p2s :> x) of
> -                  Just (_ :> ComP p2s') -> Sealed (unsafeCoercePStart 
p2s')
> -                  _ -> impossible
>  \end{code}
>  

now dead code

hunk ./src/Darcs/Patch/V1/Commute.lhs 595
>      where rcs :: FL Patch C(y w) -> RL Patch C(x y) -> [[Sealed (FL 
Prim C(w))]]
>            rcs _ NilRL = []
>            rcs passedby (p@(Merger _ _ _ _):<:ps) =
> -              case commuteNoMerger (joinPatchesFL passedby:<p) of
> +              case revCommuteFLId commuteNoMerger (passedby:<p) of
>                Just (p'@(Merger _ _ p1 p2):<_) ->
>                    (map Sealed $ nubBy unsafeCompare $
>                          effect (unsafeCoercePStart $ unsafeUnseal 
(glump09 p1 p2)) : map (unsafeCoercePStart . unsafeUnseal) (unravel p'))

passedby is now an FL

hunk ./src/Darcs/Patch/V1/Commute.lhs 641
>            undoit =
>                case (isMerger p1, isMerger p2) of
>                (True ,True ) -> case unwind p of
> -                                 Sealed (_:<:t) -> unsafeCoerceP $ 
joinPatchesFL $ invertRL t
> +                                 Sealed (_:<:t) -> unsafeCoerceP $ 
invertRL t
>                                   _ -> impossible
ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 643
> -              (False,False) -> unsafeCoerceP $ invert p1
> -              (True ,False) -> unsafeCoerceP $ joinPatchesFL NilFL
> -              (False,True ) -> unsafeCoerceP $ joinPatchesFL (invert 
p1 :>: mergerUndo p2 :>: NilFL)
> +              (False,False) -> unsafeCoerceP $ invert p1 :>: NilFL
> +              (True ,False) -> unsafeCoerceP $ NilFL
> +              (False,True ) -> unsafeCoerceP $ invert p1 :>: 
mergerUndo p2
>  merger g _ _ =
>      error $ "Cannot handle mergers other than version 0.0\n"++g
>      ++ "\nPlease use darcs optimize --modernize with an older darcs."
ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 650
>  
> -glump09 :: Patch C(x y) -> Patch C(x z) -> Sealed (Patch C(y))
> -glump09 p1 p2 = mapSeal fromPrims $ mangleUnravelled $ unseal unravel 
$ merger "0.0" p1 p2
> +glump09 :: Patch C(x y) -> Patch C(x z) -> Sealed (FL Patch C(y))
> +glump09 p1 p2 = mapSeal (mapFL_FL fromPrim) $ mangleUnravelled $ 
unseal unravel $ merger "0.0" p1 p2
>  
ok.

$ darcs annotate src/Patch/V1/Commute.lhs

# Line added by [Copy-Paste from Necronomicon.hs
# Cthulhu <cthulu@r_lyeh.fm>**20101111183255
 Ignore-this: b9ce3228c14d2daf198b3ec4337669fc
] …

oh, right.

hunk ./src/Darcs/Patch/V1/Commute.lhs 656
>      effect p@(Regrem _ _ _ _) = invert $ effect $ invert p
> -    effect (ComP ps) = concatFL $ mapFL_FL effect ps
>      effect (PP p) = effect p
>      isHunk p = do PP p' <- return p
>                    isHunk p'

ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 660
>  
> -instance FromPrims Patch where
> -    fromPrims (p :>: NilFL) = PP p
> -    fromPrims ps = joinPatchesFL $ mapFL_FL PP ps
> -    joinPatches = joinPatchesFL
> -
>  newUr :: Patch C(a b) -> RL Patch C(x y) -> [Sealed (RL Patch C(x))]
>  newUr p (Merger _ _ p1 p2 :<: ps) =
>     case filter (\(pp:<:_) -> pp `unsafeCompare` p1) $ 
headPermutationsRL ps of

removal: fromPrims yields a FL

hunk ./src/Darcs/Patch/V1/Commute.lhs 681
>      invert (Regrem undo unwindings p1 p2)
>          = Merger undo unwindings p1 p2
>      invert (PP p) = PP (invert p)
> -    invert (ComP ps)  = ComP $ invert ps
> -    identity = ComP NilFL
> +    identity = PP identity
>  
ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 691
>  
>  eqPatches :: Patch C(x y) -> Patch C(w z) -> Bool
>  eqPatches (PP p1) (PP p2) = unsafeCompare p1 p2
> -eqPatches (ComP ps1) (ComP ps2)
> - = eqFL eqPatches ps1 ps2
> -eqPatches (ComP NilFL) (PP Identity) = True
> -eqPatches (PP Identity) (ComP NilFL) = True
>  eqPatches (Merger _ _ p1a p1b) (Merger _ _ p2a p2b)
>   = eqPatches p1a p2a &&
>     eqPatches p1b p2b
ok

hunk ./src/Darcs/Patch/V1/Commute.lhs 699
>     eqPatches p1b p2b
>  eqPatches _ _ = False
>  
> -eqFL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Bool)
> -      -> FL a C(x y) -> FL a C(w z) -> Bool
> -eqFL _ NilFL NilFL = True
> -eqFL f (x:>:xs) (y:>:ys) = f x y && eqFL f xs ys
> -eqFL _ _ _ = False
> -
>  \end{code}
now in Witnesses

========================================================================
IO with V1 patches
========================================================================

hunk ./src/Darcs/Patch/V1/Read.hs 5
[imports]

hunk ./src/Darcs/Patch/V1/Read.hs 23
>  
>  instance ReadPatch Patch where
>   readPatch' want_eof
> -   = do mps <- bracketedFL (readPatch' False) '{' '}'
> -        case mps of
> -          Just (Sealed ps) -> return $ Just $ Sealed $ ComP ps
> -          Nothing -> choice [ liftM (Just . seal) $ skipSpace >> 
readMerger True
> -                            , liftM (Just . seal) $ skipSpace >> 
readMerger False
> -                            , liftM (fmap (mapSeal PP)) $ readPatch' 
want_eof
> -                            , return Nothing ]
> +   = choice [ liftM (Just . seal) $ skipSpace >> readMerger True
> +            , liftM (Just . seal) $ skipSpace >> readMerger False
> +            , liftM (fmap (mapSeal PP)) $ readPatch' want_eof
> +            , return Nothing ]
This will fail if we do have a ComP, but will be corrected in a followup


hunk ./src/Darcs/Patch/V1/Show.lhs 9

hunk ./src/Darcs/Patch/V1/Show.lhs 11
[imports]

hunk ./src/Darcs/Patch/V1/Show.lhs 34
>  
>  showPatch_ :: Patch C(a b) -> Doc
>  showPatch_ (PP p) = showPrim OldFormat p
> -showPatch_ (ComP NilFL) = blueText "{" $$ blueText "}"
> -showPatch_ (ComP ps)  = blueText "{"
> -                        $$ vcat (mapFL showPatch_ ps)
> -                        $$ blueText "}"
>  showPatch_ (Merger _ _ p1 p2) = showMerger "merger" p1 p2
>  showPatch_ (Regrem _ _ p1 p2) = showMerger "regrem" p1 p2
>  \end{code}
ok

hunk ./src/Darcs/Patch/V1/Viewing.hs 6

hunk ./src/Darcs/Patch/V1/Viewing.hs 13
[imports]

hunk ./src/Darcs/Patch/V1/Viewing.hs 18
>      showPatch = showPatch_
>      showContextPatch (PP x) | primIsHunk x = showContextHunk x
> -    showContextPatch (ComP NilFL) = return $ blueText "{" $$ blueText 
"}"
> -    showContextPatch (ComP ps) =
> -        do x <- showContextSeries ps
> -           return $ blueText "{" $$ x $$ blueText "}"
>      showContextPatch p = return $ showPatch p
>      summary = plainSummary
>      thing _ = "change"
ok

hunk ./src/Darcs/Patch/V1/Viewing.hs 21
> +    showFLBehavior = ShowFLV1
>  
to be undone…

========================================================================
New IO for patches
========================================================================

hunk ./src/Darcs/Patch/V2/Real.hs 39
>                            showPrim, showPrimFL, 
FileNameFormat(NewFormat),
>                            IsConflictedPrim(..), ConflictState(..) )
>  import Darcs.Patch.Read ( readPrim, bracketedFL )
> +import Darcs.Patch.Show ( ShowFLBehavior(ShowFLV2) )
>  import Darcs.Patch.Patchy ( Patchy, Apply(..), Commute(..)
>                            , PatchInspect(..)
>                            , ReadPatch(..), ShowPatch(..)
idem

hunk ./src/Darcs/Patch/V2/Real.hs 737
>          showNon p
>      showContextPatch (Normal p) = showContextPatch p
>      showContextPatch c = return $ showPatch c
> +    showFLBehavior = ShowFLV2
>  
>  instance ReadPatch RealPatch where
>   readPatch' _ = skipSpace >> choice
likewise


hunk ./src/Darcs/Patch/Read.hs 40
[imports]

hunk ./src/Darcs/Patch/Read.hs 58
>  
>  
>  instance ReadPatch p => ReadPatch (FL p) where
> -    readPatch' want_eof = Just `liftM` read_patches
> -     where read_patches :: ParserM m => m (Sealed (FL p C(x )))
> -           read_patches = do --tracePeek "starting FL read"
> -                             mp <- readPatch' False
> +    readPatch' eof = Just `liftM` read_patches_braces eof
> +     where read_patches, read_patches_braces :: ParserM m => Bool -> 
m (Sealed (FL p C(x )))
> +           read_patches want_eof
> +                        = do --tracePeek "starting FL read"
> +                             -- need to make sure that something is 
read, to avoid
> +                             -- stack overflow when parsing FL (FL p)
> +                             mp <- checkConsumes $ readPatch' False
>                               case mp of
>                                 Just (Sealed p) -> do --tracePeek 
"found one patch"

hunk ./src/Darcs/Patch/Read.hs 67
> -                                                     Sealed ps <- 
read_patches
> +                                                     Sealed ps <- 
read_patches want_eof
>                                                       return $ Sealed 
(p:>:ps)
>                                 Nothing -> if want_eof
>                                            then do --tracePeek "no 
more patches"

hunk ./src/Darcs/Patch/Read.hs 76
>                                                      () -> return $ 
Sealed NilFL
>                                            else do --tracePeek "no 
more patches"
>                                                    return $ Sealed 
NilFL
> +           read_patches_braces want_eof =
> +             do mps <- bracketedFL (readPatch' False) '{' '}'
> +                case mps of
> +                   Just res -> if want_eof
> +                                then do unit' <- lexEof
> +                                        case unit' of
> +                                           () -> return res
> +                                else return res
> +                   Nothing -> read_patches want_eof
> +
>  --           tracePeek x = do y <- peekInput
>  --                            traceDoc (greenText x $$ greenText 
(show $ sal_to_string y)) return ()
>  
to be undone later…

hunk ./src/Darcs/Patch/ReadMonads.hs 10
>                          option, choice, skipSpace, skipWhile, string,
>                          lexChar, lexString, lexEof, takeTillChar,
>                          myLex', anyChar, endOfInput, takeTill,
> +                        checkConsumes,
>                          linesStartingWith, 
linesStartingWithEndingWith) where
>  
>  import ByteStringUtils ( dropSpace, breakSpace, breakFirstPS,

hunk ./src/Darcs/Patch/ReadMonads.hs 182
>  choice :: Alternative f => [f a] -> f a
>  choice = foldr (<|>) empty
>  
> +-- |Ensure that a parser consumes input when producing a result
> +-- Causes the initial state of the input stream to be held on to 
while the
> +-- parser runs, so use with caution.
> +checkConsumes :: ParserM m => m (Maybe a) -> m (Maybe a)
> +checkConsumes parser = do
> +   x <- B.length <$> peekInput
> +   res <- parser
> +   x' <- B.length <$> peekInput
> +   return $ if x' < x then res else Nothing
> +
>  class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) 
=> ParserM m where
>      -- | Applies a parsing function inside the 'ParserM' monad.
>      work :: (B.ByteString -> Maybe (ParserState a)) -> m a

ok

hunk ./src/Darcs/Patch/Show.lhs 22
> -module Darcs.Patch.Show ( ShowPatch(..), showNamedPrefix )
> +module Darcs.Patch.Show ( ShowPatch(..), ShowFLBehavior(..), 
showNamedPrefix )


hunk ./src/Darcs/Patch/Show.lhs 53
> +-- | This type is used to tweak the way that 'FL p' is shown for a
> +-- given 'Patch' type 'p'. It is needed to maintain backwards 
compatibility
> +-- for V1 and V2 patches.
> +data ShowFLBehavior p
> +    = ShowFLDefault -- ^braces around all lists
> +    | ShowFLV1      -- ^braces around all lists except singletons
> +    | ShowFLV2      -- ^no braces around lists
>  
ShowFLDefault would be for debug output?

hunk ./src/Darcs/Patch/Show.lhs 61

hunk ./src/Darcs/Patch/Show.lhs 79
>      thing _ = "patch"
>      things :: p C(x y) -> String
>      things x = plural (Noun $ thing x) ""
> +    showFLBehavior :: ShowFLBehavior p
> +    showFLBehavior = ShowFLDefault
>  
>  \end{code}
ok

hunk ./src/Darcs/Patch/Viewing.hs 46
>                            Effect, IsConflictedPrim(IsC), 
ConflictState(..),
>                            DirPatchType(..), FilePatchType(..) )
>  import Darcs.Patch.Patchy ( Apply, ShowPatch(..), identity )
> -import Darcs.Patch.Show ( showNamedPrefix )
> +import Darcs.Patch.Show ( showNamedPrefix, ShowFLBehavior(..) )
>  import Darcs.Patch.Info ( showPatchInfo, humanFriendly )
>  import Darcs.Patch.Apply ( applyToTree )
>  import Darcs.Patch.Named ( Named(..), patchcontents )

hunk ./src/Darcs/Patch/Viewing.hs 279
>      showDict2 = ShowDictClass
>  
>  instance (Apply p, Effect p, ShowPatch p) => ShowPatch (FL p) where
> -    showPatch xs = vcat (mapFL showPatch xs)
> +    showPatch = showPatchInternal showFLBehavior
> +      where showPatchInternal :: ShowPatch q => ShowFLBehavior q -> 
FL q C(x y) -> Doc
> +            showPatchInternal ShowFLV2 xs            = vcat (mapFL 
showPatch xs)
> +            showPatchInternal ShowFLV1 (x :>: NilFL) = showPatch x
> +            showPatchInternal _        NilFL         = blueText "{" 
$$ blueText "}"
> +            showPatchInternal _        xs            = blueText "{" 
$$ vcat (mapFL showPatch xs) $$ blueText "}"
> +
>      showContextPatch = showContextSeries
>      description = vcat . mapFL description
>      summary = vcat . mapFL summary
ok

========================================================================
Use the new patches in repositories
========================================================================

hunk ./src/Darcs/Repository.hs 165
>    writeRepoFormat rf (darcsdir++"/format")
>    if formatHas HashedInventory rf
>        then writeBinFile (darcsdir++"/hashed_inventory") ""
> -      else DarcsRepo.writeInventory "." (PatchSet NilRL NilRL :: 
PatchSet Patch C(Origin Origin)) -- YUCK!
> +      else DarcsRepo.writeInventory "." (PatchSet NilRL NilRL :: 
PatchSet (FL Patch) C(Origin Origin)) -- YUCK!
>  
>  copyRepository :: RepoPatch p => Repository p C(r u t) -> IO ()
>  copyRepository fromrepository@(Repo _ opts rf _)
ok

hunk ./src/Darcs/Repository.hs 213
>  
>  copyOldrepoPatches :: RepoPatch p => [DarcsFlag] -> Repository p C(r 
u t) -> FilePath -> IO ()
>  copyOldrepoPatches opts repository@(Repo dir _ _ _) out = do
> -  Sealed patches <- DarcsRepo.readRepo "." :: IO (SealedPatchSet 
Patch C(Origin))
> +  Sealed patches <- DarcsRepo.readRepo "." :: IO (SealedPatchSet (FL 
Patch) C(Origin))
>    mpi <- if Partial `elem` opts
>           -- FIXME this should get last pinfo *before*
>           -- desired tag...
ok

hunk ./src/Darcs/Repository/Internal.hs 113
>                               allFL, filterFLFL,
>                               reverseFL, mapFL_FL, concatFL )
>  import Darcs.Patch ( RepoPatch, Patchy, Prim, merge,
> -                     joinPatches,
>                       listConflictedFiles, listTouchedFiles,
>                       Named, patchcontents,
>                       commuteRL, fromPrims,
ok

hunk ./src/Darcs/Repository/Internal.hs 227
>                    Nothing ->  do cs <- getCaches opts url
>                                   return $ GoodRepository $ Repo url 
opts rf (DarcsRepository nopristine cs)
>  
> -identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository 
Patch C(r u t))
> +identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository 
(FL Patch) C(r u t))
>  identifyDarcs1Repository opts url =
>      do er <- maybeIdentifyRepository opts url
>         case er of
we really should drop the 1 in identifyDarcs1Repository, given that it
comes up in code paths for darcs2 repositories.

hunk ./src/Darcs/Repository/Internal.hs 447
>  checkUnrecordedConflicts opts pc =
>      do repository <- identifyDarcs1Repository opts "."
>         cuc repository
> -    where cuc :: Repository Patch C(r u t) -> IO Bool
> +    where cuc :: Repository (FL Patch) C(r u t) -> IO Bool
>            cuc r = do Sealed mpend <- readPending r :: IO (Sealed (FL 
Prim C(t)))
>                       case mpend of
>                         NilFL -> return False
ok

hunk ./src/Darcs/Repository/Internal.hs 661
>                   job2_ (Repo dir opts rf rt)
>    where job1_ :: Repository (FL RealPatch) C(r u r) -> IO a
>          job1_ = job
> -        job2_ :: Repository Patch C(r u r) -> IO a
> +        job2_ :: Repository (FL Patch) C(r u r) -> IO a
>          job2_ = job
>  
>  
ok

hunk ./src/Darcs/Repository/Internal.hs 805
>  withTentative repository@(Repo dir _ _ _) mk_dir f =
>      withRecorded repository mk_dir $ \d ->
>      do Sealed ps <- read_patches (dir ++ 
"/"++darcsdir++"/tentative_pristine")
> -       apply $ joinPatches ps
> +       apply ps
>         f d
>      where read_patches :: FilePath -> IO (Sealed (FL p C(x)))
>            read_patches fil = do ps <- B.readFile fil
ok

hunk ./src/Darcs/Repository/LowLevel.hs 68
>    return $ readPendingContents pend
>  
>  -- Wrapper around FL where printed format uses { } except around 
singletons
> +-- Now that the Show behaviour of FL p can be customised (using 
showFLBehavior),
> +-- we could instead change the general behaviour of FL Prim; but 
since the pending
> +-- code can be kept nicely compartmentalised, it's nicer to do it 
this way.
>  newtype FLM p C(x y) = FLM { unFLM :: FL p C(x y) }
>  
>  instance ReadPatch p => ReadPatch (FLM p) where
ok

========================================================================
Tests
========================================================================
hunk ./src/Darcs/Test/Patch/Test.hs 63

hunk ./src/Darcs/Test/Patch/Test.hs 66
[imports]

hunk ./src/Darcs/Test/Patch/Test.hs 115
>  instance Arbitrary (Sealed (Prim C(x))) where
>      arbitrary = arbitraryP
>  
> -instance Arbitrary (Sealed (Patch C(x))) where
> +instance Arbitrary (Sealed (FL Patch C(x))) where
>      arbitrary = arbitraryP
>  
>  instance Arbitrary (Sealed2 (Prim :> Prim)) where

ok, idem from then on


========================================================================
Use of the new API in commands
========================================================================

hunk ./src/Darcs/Commands/Convert.lhs 53

hunk ./src/Darcs/Commands/Convert.lhs 62

hunk ./src/Darcs/Commands/Convert.lhs 78
[imports and includes]

hunk ./src/Darcs/Commands/Convert.lhs 173
>        -- unsatisfying.
>  
>        let repository = unsafeCoerce# repositoryfoo :: Repository (FL 
RealPatch) C(r u t)
> -          themrepo = unsafeCoerce# themrepobar :: Repository Patch 
C(r u t)
> +          themrepo = unsafeCoerce# themrepobar :: Repository (FL 
Patch) C(r u t)
>        theirstuff <- readRepo themrepo
>        let patches = mapFL_FL convertNamed $ patchSetToPatches 
theirstuff
>            inOrderTags = iot theirstuff
ok

hunk ./src/Darcs/Commands/Convert.lhs 202
>                                                              "lossy 
conversion of complicated conflict:" $$
>                                                              showPatch 
x)
>                                                    fromPrims (effect 
x)
> -                       | otherwise = case flattenFL x of
> -                                     NilFL -> NilFL
> -                                     (x':>:NilFL) -> fromPrims $ 
effect x'
> -                                     xs -> concatFL $ mapFL_FL 
convertOne xs
> -          convertNamed :: Named Patch C(x y) -> PatchInfoAnd (FL 
RealPatch) C(x y)
> +          convertOne (PP x) = fromPrim x :>: NilFL
> +          convertOne _ = impossible
> +          convertFL :: FL Patch C(x y) -> FL RealPatch C(x y)
> +          convertFL = concatFL . mapFL_FL convertOne
> +          convertNamed :: Named (FL Patch) C(x y) -> PatchInfoAnd (FL 
RealPatch) C(x y)
>            convertNamed n = n2pia $
>                             adddeps (infopatch (convertInfo $ 
patch2patchinfo n) $
ok

hunk ./src/Darcs/Commands/Convert.lhs 209
> -                                              convertOne $ 
patchcontents n)
> +                                              convertFL $ 
patchcontents n)
>                                     (map convertInfo $ concatMap 
fixDep $ getdeps n)
>            convertInfo n | n `elem` inOrderTags = n
>                          | otherwise = maybe n (\t -> piRename n ("old 
tag: "++t)) $ piTag n
ok

hunk ./src/Darcs/Commands/Get.lhs 59
[imports]

hunk ./src/Darcs/Commands/Get.lhs 173
>                          Right x -> return x
>    if formatHas HashedInventory rf -- refactor this into repository
>      then writeBinFile (darcsdir++"/hashed_inventory") ""
> -    else writeInventory "." (PatchSet NilRL NilRL :: PatchSet Patch 
C(Origin Origin))
> +    else writeInventory "." (PatchSet NilRL NilRL :: PatchSet (FL 
Patch) C(Origin Origin))
>  
>    if not (null [p | OnePattern p <- opts]) -- --to-match given
>       && not (Partial `elem` opts) && not (Lazy `elem` opts)
ok

hunk ./src/Darcs/Commands/Get.lhs 333
>    debugMessage "Copying patches..."
>    copyOldrepoPatches opts fromrepo "."
>    debugMessage "Patches copied"
> -  Sealed local_patches <- DR.readRepo "." :: IO (SealedPatchSet Patch 
C(Origin))
> +  Sealed local_patches <- DR.readRepo "." :: IO (SealedPatchSet (FL 
Patch) C(Origin))
>    debugMessage "Repo read"
>    repo_is_local <- doesDirectoryExist repodir
>    debugMessage $ "Repo local: " ++ formatPath (show repo_is_local)
ok

hunk ./src/Darcs/Commands/Record.lhs 355
>                              $$ text ""
>                              $$ text "This patch contains the 
following changes:"
>                              $$ text ""
> -                            $$ summary (fromPrims chs :: Patch C(x 
y))
> +                            $$ summary (fromPrims chs :: FL Patch C(x 
y))
>  
>  eod :: String
>  eod = "***END OF DESCRIPTION***"
ok
msg13002 (view) Author: ganesh Date: 2010-11-11.22:51:38
Hi,

On Thu, 11 Nov 2010, Florent Becker wrote:

>>  type CommuteFunction = FORALL(x y) (Patch :< Patch) C(x y) -> Perhaps
> ((Patch :< Patch) C(x y))
>>  type MaybeCommute = FORALL(x y) (Patch :< Patch) C(x y) -> Maybe
> ((Patch :< Patch) C(x y))
>> +
>> +revCommuteFLId :: MaybeCommute -> (FL Patch :< Patch) C(x y) -> Maybe
> ((Patch :< FL Patch) C(x y))
>> +revCommuteFLId _        (NilFL :< p) = return (p :< NilFL)
>> +revCommuteFLId commuter ((q :>: qs) :< p) = do
>> +   p' :< q' <- commuter (q :< p)
>> +   p'' :< qs' <- revCommuteFLId commuter (qs :< p')
>> +   return (p'' :< (q' :>: qs'))
>> +
> Why not in Permutations.hs?

Agreed, that would probably be a better place for it, but I've been trying 
to write patches that do one thing at a time and have minimal local 
changes. Somewhere in my invisible and unwritten plans for Darcs.Patch is 
the idea of rationalising stuff like this (building complex commute 
functions out of simpler ones). [The existence of such plans in my head 
should of course not constrain anyone else from doing something that seems 
sensible to them in the meantime, though I'd also be happy to discuss 
things.]

> hunk ./src/Darcs/Patch/Show.lhs 53
>> +-- | This type is used to tweak the way that 'FL p' is shown for a
>> +-- given 'Patch' type 'p'. It is needed to maintain backwards
> compatibility
>> +-- for V1 and V2 patches.
>> +data ShowFLBehavior p
>> +    = ShowFLDefault -- ^braces around all lists
>> +    | ShowFLV1      -- ^braces around all lists except singletons
>> +    | ShowFLV2      -- ^no braces around lists
>>
> ShowFLDefault would be for debug output?

My intention at the time of writing this patch was for ShowFLDefault to be 
the standard for V3 and beyond. That's since changed though due to the 
problems I ran into: the new default behaviour is the same as the V2 
behaviour.

>> -identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository
> Patch C(r u t))
>> +identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository
> (FL Patch) C(r u t))
>>  identifyDarcs1Repository opts url =
>>      do er <- maybeIdentifyRepository opts url
>>         case er of
> we really should drop the 1 in identifyDarcs1Repository, given that it
> comes up in code paths for darcs2 repositories.

Agreed (though the type means it really is about darcs 1 repos, and then 
we hack the resulting Repository value later on)

I've actually already made this change as part of a pending series of 
patches to abstract over Prim; I'll submit that as soon as I can (and 
perhaps once the review backlog is cleared a bit more, which I do intend 
to help with!)

Ganesh
msg13003 (view) Author: ganesh Date: 2010-11-11.23:12:52
On Thu, 11 Nov 2010, Florent Becker wrote:

> hunk ./src/Darcs/Repository/Internal.hs 507
>> -      writePatch tpn $ fromPrims_ newpend_
>> +      writeTentativePending repo (unsafeCoercePStart newpend_)
>>        where newpend :: FL Prim C(a b) -> FL Prim C(b c) ->
> FlippedSeal (FL Prim) C(c)
>>              newpend NilFL patch_ = flipSeal patch_
>>              newpend p     patch_ = flipSeal $ p +>+ patch_
>
> Why seal then coerce, rather than coerce directly?
>
> hunk ./src/Darcs/Repository/Internal.hs 525
>>  prepend :: forall p C(r u t x y). RepoPatch p =>
>>             Repository p C(r u t) -> FL Prim C(x y) -> IO ()
>>  prepend (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()
>> -prepend (Repo _ _ _ rt) patch =
>> -    do let pn = pendingName rt ++ ".tentative"
>> -       Sealed pend <- readPrims `liftM` (gzReadFilePS pn `catchall`
> (return B.empty))
>> -       Sealed newpend_ <- return $ newpend pend patch
>> -       writePatch pn $ fromPrims_ (crudeSift newpend_)
>> +prepend repo@(Repo _ _ _ _) patch =
>> +    do
>> +       Sealed pend <- readTentativePending repo
>> +       Sealed newpend_ <- return $ newpend (unsafeCoerceP pend) patch
>> +       writeTentativePending repo (unsafeCoercePStart $ crudeSift
> newpend_)
>>        where newpend :: FL Prim C(b c) -> FL Prim C(a b) -> Sealed (FL
> Prim C(a))
>>              newpend NilFL patch_ = seal patch_
>>              newpend p     patch_ = seal $ patch_ +>+ p
>
> as above, why seal then coerce?
>
> What's more, there are unsafeCoerces because of the function's
> unsafety. On the other hand, prepend is called only once, with
> x = t. Shouldn't it be reflected in its type, and wouldn't it reduce
> the need for unsafeCoerces?

I think you're right; I think I was aiming for minimal changes and so I 
chose unsafeCoercing (which won't affect behaviour) over more significant 
refactorings. Worth a followup, though given the general witness-y mess in 
Repository doing it properly will be a lot of effort.

> hunk ./src/Darcs/Repository/LowLevel.hs 23
>>
>>  #include "gadts.h"
>>
>> -module Darcs.Repository.LowLevel ( readPending, readPendingfile,
> pendingName, readPrims ) where
>> +module Darcs.Repository.LowLevel
>> +    ( readPending, readTentativePending
>> +    , writeTentativePending
>> +    -- deprecated interface:
>> +    , readPendingfile, writePendingFile
>> +    , pendingName )
>> +    where
>>
>>  import Darcs.Repository.InternalTypes ( RepoType(..), Repository(..)
> )
>
> Would it be possible to tell hlint that these functions are deprecated?

Possibly, but I don't think it is worth it as noone will be messing with 
this stuff without looking at the code quite carefully. In fact in later 
(as yet unsubmitted) patches I've got rid of those deprecated functions, 
but I have some different ones instead (to handle "pending.new").

> darcs does not compile if we correct the type of readPending. Does
> that means (potential) bugs?

I think the same confused assumption is made through the stack, so it sort 
of works out. But yes, there may well be some lurking. I've made a couple 
of half-hearted attempts at untangling this, but it's fiddly and the mess 
in Repository.Internal makes it harder.

Ganesh
msg13005 (view) Author: galbolle Date: 2010-11-12.10:32:20
Review of the second bundle


ok

hunk ./src/Darcs/Commands/TrackDown.lhs 157
>  patchTree2RL (Fork l r) = (patchTree2RL l) +<+ (patchTree2RL r)
>  
>  -- | Iterate the Patch Tree
> -trackNextBisect :: (Conflict p, Patchy p) => [DarcsFlag] -> 
BisectState -> IO ExitCode -> BisectDir -> PatchTree p C(x y) -> IO ()
> +trackNextBisect :: (Conflict p, PatchListFormat p, Patchy p)
> +                => [DarcsFlag] -> BisectState -> IO ExitCode -> 
BisectDir -> PatchTree p C(x y) -> IO ()
>  trackNextBisect opts (dnow, dtotal) test dir (Fork l r) = do
>    putStr ("Trying " ++ show dnow ++ "/" ++ show dtotal ++ " 
sequences...\n")
>    hFlush stdout
ok

hunk ./src/Darcs/Commands/TrackDown.lhs 173
>    putStrLn ("Last recent patch that fails the test (assuming monotony 
in the given range):")
>    putDocLn (description p)
>  
> -jumpHalfOnRight :: (Conflict p, Patchy p) => [DarcsFlag] -> PatchTree 
p C(x y) -> IO ()
> +jumpHalfOnRight :: (Conflict p, PatchListFormat p, Patchy p) => 
[DarcsFlag] -> PatchTree p C(x y) -> IO ()
>  jumpHalfOnRight opts l = unapplyRL ps >> makeScriptsExecutable opts 
ps
>    where ps = patchTree2RL l
>  
ok

hunk ./src/Darcs/Commands/TrackDown.lhs 177
> -jumpHalfOnLeft :: (Conflict p, Patchy p) => [DarcsFlag] -> PatchTree 
p C(x y) -> IO ()
> +jumpHalfOnLeft :: (Conflict p, PatchListFormat p, Patchy p) => 
[DarcsFlag] -> PatchTree p C(x y) -> IO ()
>  jumpHalfOnLeft opts r = applyRL p >> makeScriptsExecutable opts p
>    where p = patchTree2RL r
>  
ok

hunk ./darcs.cabal 187
>                        Darcs.Match
>                        Darcs.Patch
>                        Darcs.Patch.Apply
> +                      Darcs.Patch.Braced
> +                      Darcs.Patch.Braced.Instances
>                        Darcs.Patch.Bundle
>                        Darcs.Patch.Choices
>                        Darcs.Patch.Commute

hunk ./darcs.cabal 195
>                        Darcs.Patch.ConflictMarking
>                        Darcs.Patch.Depends
>                        Darcs.Patch.FileName
> +                      Darcs.Patch.Format
>                        Darcs.Patch.Info
>                        Darcs.Patch.Inspect
>                        Darcs.Patch.Invert
ok
msg13006 (view) Author: galbolle Date: 2010-11-12.10:39:52
remove locale sensitivity from send output tests
------------------------------------------------
Ganesh Sittampalam <ganesh@earth.li>**20101022204106

This is not robust, because it matches on Oct 1, which has been
updated to Oct 20 by some later patch. Better get the date from the
bundle. I don't want to further delay application because of this, and
I'm sending a followup myself, please review it.


hunk ./tests/send-output-v1.sh 42
>  cd repo
>  darcs send -o repo.dpatch -a ../empty
>  
> -diff -u -I'1 patch for repository ' -I'patches for repository ' 
$TESTDATA/simple-v1.dpatch repo.dpatch
> +diff -u -I'1 patch for repository ' -I'patches for repository ' -
I'Oct 1' $TESTDATA/simple-v1.dpatch repo.dpatch
>  cd ..
>  
>  # context-v1 tests that we are including some context lines in hunk 
patches

'Oct 1' is no longer up to date

hunk ./tests/send-output-v1.sh 51
>  cd repo
>  darcs send -o repo.dpatch -a ../empty
>  
> -diff -u -I'1 patch for repository ' -I'patches for repository ' 
$TESTDATA/context-v1.dpatch repo.dpatch
> +diff -u -I'1 patch for repository ' -I'patches for repository ' -
I'Oct 1' $TESTDATA/context-v1.dpatch repo.dpatch
>  cd ..

idem

hunk ./tests/send-output-v2.sh 42
>  cd repo
>  darcs send -o repo.dpatch -a ../empty
>  
> -diff -u -I'1 patch for repository ' -I'patches for repository ' 
$TESTDATA/simple-v2.dpatch repo.dpatch
> +diff -u -I'1 patch for repository ' -I'patches for repository ' -
I'Oct 1' $TESTDATA/simple-v2.dpatch repo.dpatch
>  cd ..
>  
>  # context-v1 tests that we are including some context lines in hunk 
patches

idem

hunk ./tests/send-output-v2.sh 51
>  cd repo
>  darcs send -o repo.dpatch -a ../empty
>  
> -diff -u -I'1 patch for repository ' -I'patches for repository ' 
$TESTDATA/context-v2.dpatch repo.dpatch
> +diff -u -I'1 patch for repository ' -I'patches for repository ' -
I'Oct 1' $TESTDATA/context-v2.dpatch repo.dpatch
>  cd ..

idem
msg13014 (view) Author: ganesh Date: 2010-11-13.17:26:05
Let me know once you've sent the followup (if you already did I can't find 
it).
msg13017 (view) Author: galbolle Date: 2010-11-14.12:33:33
1 patch for repository http://darcs.net/screened:

Sun Nov 14 13:25:15 CET 2010  Florent Becker <florent.becker@ens-lyon.org>
  * Make send-output-v*.sh tests more robust against timezones
Attachments
msg13018 (view) Author: ganesh Date: 2010-11-14.12:46:05
Looks fine to me. I hadn't thought of that solution!
msg13047 (view) Author: galbolle Date: 2010-11-15.08:58:06
Applying, with ganesh's benediction.
msg13049 (view) Author: darcswatch Date: 2010-11-15.09:17:30
This patch bundle (with 8 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-d2e51fadbc14d81db3f077d15300ead5d4ca21ec
msg13050 (view) Author: darcswatch Date: 2010-11-15.09:17:34
This patch bundle (with 6 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-ac10b79f0d9861d6734c61241579589cab4b9a9f
msg13051 (view) Author: darcswatch Date: 2010-11-15.09:17:35
This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-d7112a133e05f848bc9784b264af01dd6b1ee4a6
msg13052 (view) Author: darcswatch Date: 2010-11-15.09:17:36
This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-dd3193908fda8aad932b31895e48aae69d99ed54
msg14106 (view) Author: darcswatch Date: 2011-05-10.18:06:45
This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-d7112a133e05f848bc9784b264af01dd6b1ee4a6
msg14117 (view) Author: darcswatch Date: 2011-05-10.18:35:58
This patch bundle (with 6 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-ac10b79f0d9861d6734c61241579589cab4b9a9f
msg14234 (view) Author: darcswatch Date: 2011-05-10.20:05:46
This patch bundle (with 8 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-d2e51fadbc14d81db3f077d15300ead5d4ca21ec
msg14405 (view) Author: darcswatch Date: 2011-05-10.22:07:41
This patch bundle (with 1 patches) was just applied to the repository http://darcs.net/reviewed.
This message was brought to you by DarcsWatch
http://darcswatch.nomeata.de/repo_http:__darcs.net_reviewed.html#bundle-dd3193908fda8aad932b31895e48aae69d99ed54
History
Date User Action Args
2010-10-17 11:23:35ganeshcreate
2010-10-17 11:24:56darcswatchsetdarcswatchurl: http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-ac10b79f0d9861d6734c61241579589cab4b9a9f
2010-10-17 11:49:34darcswatchsetstatus: needs-screening -> needs-review
messages: + msg12744
2010-10-17 20:20:22ganeshsetmessages: + msg12763
title: Show instance for RL (and 5 more) -> getting rid of ComP constructor in Patch
2010-10-21 20:04:30ganeshsetfiles: + add-test-for-handling-of-v1-patches-with-nested-braces.dpatch, unnamed
messages: + msg12796
2010-10-21 20:05:55darcswatchsetdarcswatchurl: http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-ac10b79f0d9861d6734c61241579589cab4b9a9f -> http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-d2e51fadbc14d81db3f077d15300ead5d4ca21ec
2010-10-22 20:48:53ganeshsetfiles: + remove-locale-sensitivity-from-send-output-tests.dpatch, unnamed
messages: + msg12804
2010-10-22 20:49:58darcswatchsetdarcswatchurl: http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-d2e51fadbc14d81db3f077d15300ead5d4ca21ec -> http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-dd3193908fda8aad932b31895e48aae69d99ed54
2010-11-11 17:19:26galbollesetstatus: needs-review -> review-in-progress
2010-11-11 17:20:22galbollesetassignedto: galbolle
messages: + msg12999
nosy: + galbolle
2010-11-11 20:09:37galbollesetmessages: + msg13000
2010-11-11 20:37:13galbollesetmessages: + msg13001
2010-11-11 22:51:38ganeshsetmessages: + msg13002
2010-11-11 23:12:52ganeshsetmessages: + msg13003
2010-11-12 10:32:20galbollesetmessages: + msg13005
2010-11-12 10:39:52galbollesetstatus: review-in-progress -> followup-in-progress
messages: + msg13006
2010-11-13 17:26:05ganeshsetmessages: + msg13014
2010-11-14 12:33:34galbollesetfiles: + make-send_output_v__sh-tests-more-robust-against-timezones.dpatch, unnamed
messages: + msg13017
2010-11-14 12:34:43darcswatchsetdarcswatchurl: http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-dd3193908fda8aad932b31895e48aae69d99ed54 -> http://darcswatch.nomeata.de/repo_http:__darcs.net_.html#bundle-d7112a133e05f848bc9784b264af01dd6b1ee4a6
2010-11-14 12:46:05ganeshsetmessages: + msg13018
2010-11-15 08:58:06galbollesetstatus: followup-in-progress -> accepted-pending-tests
messages: + msg13047
2010-11-15 09:17:30darcswatchsetstatus: accepted-pending-tests -> accepted
messages: + msg13049
2010-11-15 09:17:34darcswatchsetmessages: + msg13050
2010-11-15 09:17:35darcswatchsetmessages: + msg13051
2010-11-15 09:17:36darcswatchsetmessages: + msg13052
2011-05-10 18:06:45darcswatchsetmessages: + msg14106
2011-05-10 18:35:58darcswatchsetmessages: + msg14117
2011-05-10 20:05:46darcswatchsetmessages: + msg14234
2011-05-10 22:07:41darcswatchsetmessages: + msg14405