Hi,

This series of patches adds witnesses to all the remaining modules in
darcs. It makes a few general changes in how things are done, which I'll
comment on with the relevant patches below.

I note that Petr has also submitted a long series for de-slurpification, 
and I imagine there'll be conflicts. I'm happy for his patches to be 
applied first and I'll then deal with the conflicts appropriately.

Cheers,

Ganesh

28 patches for repository http://darcs.net:


This patch (and a few like it) introduce the concept that we return a
new repository object with different witnesses after each operation on
the repository. This is important to actually get correct witnesses, but
unfortunately we can't easily enforce that callers actually use the new
object rather than the old one. The 'RIO' concept that Jason introduced
a while back may help with this, but is quite clunky and I've chosen to
do without it for now:

Fri Nov 27 17:43:38 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * make tentativelyRemove return the new repo state

Fri Nov 27 17:44:39 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * adding patches should affect the tentative state

Wed Dec  2 19:18:33 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * return new repository state from tentativelyAdd etc

Probably the most difficult/controversial part of this work is the 
introduction of "gaps".

The underlying problem is how to deal with the initial creation of 
primitive patches and what witnesses to give them. The constructors of 
primitive patches are generally completely polymorphic, so can be used 
anywhere, with the exception of things like NilFL, which are quite 
restricted because the two witnesses have to be identical.

The act of constructing fresh patches is inherently unsafe (in relation 
to witnesses), so anything we do will involve some element of forcing 
the witnesses to fit. The approach I've taken is to construct such 
patches with a pair of witnesses where one witness is universally 
quantified and the other is existentially quantified. For example in 
Prim C(x y) the x would be universal and the y existential. What this 
means is that the calling context gets to choose what x should be, e.g. 
to match it up against the recorded witness, but then has to accept an 
arbitrary witness for the ending state. In a few cases, such as diffing 
unrecorded against recorded, the calling code has to use a coercion to 
force the ending state to the expected witness too, but this is rare.

I'm sure that this will feel rather confusing and I'm happy to try to 
explain it more. I have written some documentation for the Gap code, but 
not much else, yet.

Fri Dec 11 01:07:54 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * add concept of gaps

Fri Feb 12 18:06:27 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add docs to Gap and related types

Mon Dec 21 19:03:33 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * add TypeOperators to witnesses build

Tue Jan 26 20:19:33 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * reduce conditionalisation on witnesses in Darcs.Patch.Commute

Wed Feb 10 18:43:08 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to treeDiff

Wed Feb 10 18:59:26 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnessed variant of PatchInfo

Wed Feb 10 19:07:16 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Repository.Repair

Wed Feb 10 19:13:07 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Check

Wed Feb 10 19:15:44 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Move

Wed Feb 10 19:31:04 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnessed toFL operation

Wed Feb 10 19:32:09 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Record

Wed Feb 10 20:37:54 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Add

Wed Feb 10 20:57:23 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Get

Wed Feb 10 21:00:03 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * fix witnesses in Darcs.Commands.Remove using gaps

Wed Feb 10 21:06:33 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Replace

Thu Feb 11 11:04:10 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * return new repo from applyToWorking

Thu Feb 11 11:12:04 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Put

Thu Feb 11 11:19:41 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Optimize

Thu Feb 11 11:31:57 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * use tentative repo in askAboutDepends

Thu Feb 11 11:33:24 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.AmendRecord

Thu Feb 11 11:34:18 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Revert

Thu Feb 11 11:35:10 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.MarkConflicts

Thu Feb 11 18:16:13 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Convert

Thu Feb 11 18:44:35 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Rollback

Thu Feb 11 18:46:08 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * everything now compiles with witnesses
  Note that because of some bits of conditional compilation, this doesn't
  mean we can turn witnesses on for the real build yet.

Attachments

• make-tentativelyremove-return-the-new-repo-state.dpatch
• unnamed

I'll take a look at this as soon as I can find time.

Yay, witnesses!

See below for my comments.

I only made it about 40% of the way through before I had to start
skimming.  The amount of stuff to look at is quite big.  My emacs buffer
claims to have over 2500 lines.

The introduction of the new Gap stuff is hard for me to review because
it's new to me and I don't understand it.  That's really the only thing
that would make me want to reject this patch.  If I understood it
better, perhaps I wouldn't feel so uneasy about it.

Maybe someone else can take a stab at it?

Jason


New patches:

[make tentativelyRemove return the new repo state
Ganesh Sittampalam <ganesh@earth.li>**20091127174338
 Ignore-this: 683cba083ab428a231d8b2c2a144980c
] hunk ./src/Darcs/Repository/Internal.hs 566
             fromPrims_ = fromPrims
 
 tentativelyRemovePatches :: RepoPatch p => Repository p C(r u t) ->
[DarcsFlag]
-                         -> FL (Named p) C(x t) -> IO ()
+                         -> FL (Named p) C(x t) -> IO (Repository p C(r
u x))

Looks reasonable.

hunk ./src/Darcs/Repository/Internal.hs 571
                           -> Repository p C(r u t) -> [DarcsFlag]
-                          -> FL (Named p) C(x t) -> IO ()
-tentativelyRemovePatches_ up repository@(Repo dir _ rf (DarcsRepository
_ c)) opts ps =
+                          -> FL (Named p) C(x t) -> IO (Repository p
C(r u x))

Same as the change above.

+tentativelyRemovePatches_ up repository@(Repo dir ropts rf
(DarcsRepository t c)) opts ps =
     withCurrentDirectory dir $ do
       when (up == UpdatePristine) $ do debugMessage "Adding changes to
pending..."
                                        prepend repository $ effect ps
hunk ./src/Darcs/Repository/Internal.hs 584
                      HashedRepo.apply_to_tentative_pristine c opts $
                      progressFL "Applying inverse to pristine" $ invert ps
         else DarcsRepo.remove_from_tentative_inventory
(up==UpdatePristine) opts ps
+      return (Repo dir ropts rf (DarcsRepository t c))

Returning the Repository now since the return type is no longer IO ().
 
 tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p =>
Repository p C(r u t) -> [DarcsFlag]
                           -> FL (Named p) C(x t) -> IO ()
[adding patches should affect the tentative state
Ganesh Sittampalam <ganesh@earth.li>**20091127174439
 Ignore-this: a98e2488424993191bd790f76ee819c0
] hunk ./src/Darcs/Commands/Apply.lhs 182
 
 applyItNow :: FORALL(p r u t x y z) RepoPatch p =>
              [DarcsFlag] -> String -> Repository p C(r u t)
-           -> RL (PatchInfoAnd p) C(x r) -> FL (PatchInfoAnd p) C(x z)
-> IO ()
+           -> RL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x z)
-> IO ()

We used to claim that the patches applied to the recorded state.  Now
we apply them to the tentative state.  Talking to Ganesh on IRC it
seem this is probably okay because t here is the current
"transaction".

 applyItNow opts from_whom repository us' to_be_applied = do
    printDryRunMessageAndExit "apply" opts to_be_applied
    when (nullFL to_be_applied) $
hunk ./src/Darcs/Repository/Internal.hs 326
       Just pendslurp -> do unrec <- co_slurp pendslurp "."
                            return (cur, unrec)
 
-make_new_pending :: forall p C(r u t y). RepoPatch p => Repository p
C(r u t) -> FL Prim C(r y) -> IO ()
+make_new_pending :: forall p C(r u t y). RepoPatch p => Repository p
C(r u t) -> FL Prim C(t y) -> IO ()

Same change as above.

 make_new_pending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts =
return ()
 make_new_pending repo@(Repo r _ _ tp) origp =
     withCurrentDirectory r $
hunk ./src/Darcs/Repository/Internal.hs 466
                           " "++cmd++" mark-conflicts\n"++
                           "to "++darcsdir++"/prefs/defaults in the
target repo. "
 
-check_unrecorded_conflicts :: forall p C(r y). RepoPatch p =>
[DarcsFlag] -> FL (Named p) C(r y) -> IO Bool
+check_unrecorded_conflicts :: forall p C(t y). RepoPatch p =>
[DarcsFlag] -> FL (Named p) C(t y) -> IO Bool

Alpha renaming to emphasize tentative over recorded.

 check_unrecorded_conflicts opts _ | NoUpdateWorking `elem` opts =
return False
 check_unrecorded_conflicts opts pc =
     do repository <- identifyDarcs1Repository opts "."
hunk ./src/Darcs/Repository/Internal.hs 472
        cuc repository
     where cuc :: Repository Patch C(r u t) -> IO Bool
-          cuc r = do Sealed mpend <- read_pending r :: IO (Sealed (FL
Prim C(r)))
+          cuc r = do Sealed mpend <- read_pending r :: IO (Sealed (FL
Prim C(t)))

If the pending is to represent the current "transaction" then this
change makes sense to me aswell.

                      case mpend of
                        NilFL -> return False
                        pend ->
hunk ./src/Darcs/Repository/Internal.hs 491
           fromPrims_ = fromPrims
 
 tentativelyAddPatch :: RepoPatch p
-                    => Repository p C(r u t) -> [DarcsFlag] ->
PatchInfoAnd p C(r y) -> IO ()
+                    => Repository p C(r u t) -> [DarcsFlag] ->
PatchInfoAnd p C(t y) -> IO ()

tentatively add a patch to the current tentative state.  Okay.

 tentativelyAddPatch = tentativelyAddPatch_ UpdatePristine
 
 data UpdatePristine = UpdatePristine | DontUpdatePristine deriving Eq
hunk ./src/Darcs/Repository/Internal.hs 498
 
 tentativelyAddPatch_ :: RepoPatch p
                      => UpdatePristine -> Repository p C(r u t) ->
[DarcsFlag]
-                     -> PatchInfoAnd p C(r y) -> IO ()
+                     -> PatchInfoAnd p C(t y) -> IO ()

Has to match the one above.

 tentativelyAddPatch_ _ _ opts _
     | DryRun `elem` opts = bug "tentativelyAddPatch_ called when
--dry-run is specified"
 tentativelyAddPatch_ up r@(Repo dir _ rf (DarcsRepository _ c)) opts p =
hunk ./src/Darcs/Repository/Internal.hs 511
                                         debugMessage "Updating pending..."
                                         handle_pend_for_add r p
 
-applyToTentativePristine :: (Effect q, Patchy q) => Repository p C(r u
t) -> q C(r y) -> IO ()
+applyToTentativePristine :: (Effect q, Patchy q) => Repository p C(r u
t) -> q C(t y) -> IO ()

Again, working in the tentative state.  Seems right.

 applyToTentativePristine (Repo dir opts rf (DarcsRepository _ c)) p =
     withCurrentDirectory dir $
     do when (Verbose `elem` opts) $ putDocLn $ text "Applying to
pristine..." <+> description p
hunk ./src/Darcs/Repository/Internal.hs 588
 
 tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p =>
Repository p C(r u t) -> [DarcsFlag]
                           -> FL (Named p) C(x t) -> IO ()
-tentativelyReplacePatches repository@(Repo x y z w) opts ps =
-    -- tentativelyRemovePatches_ leaves the repository in state C(x u t)
-    do tentativelyRemovePatches_ DontUpdatePristine repository opts ps
-       -- Now we add the patches back so that the repo again has state
C(r u t)
-       sequence_ $ mapAdd ((Repo x y z w) :: Repository p C(x u t)) ps
-  where mapAdd :: Repository p C(i l m) -> FL (Named p) C(i j) -> [IO ()]
+tentativelyReplacePatches repository opts ps =
+    do repository' <- tentativelyRemovePatches_ DontUpdatePristine
repository opts ps
+       sequence_ $ mapAdd repository' ps
+  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> [IO ()]

The reordering of witnesses (i l m) to (m l i) here looks suspicious.
What is the reason?  Is it too bothersome to ask that you put the
comments back in?

         mapAdd _ NilFL = []
         mapAdd r@(Repo dir df rf dr) (a:>:as) =
                -- we construct a new Repository object on the recursive
case so that the
hunk ./src/Darcs/Repository/LowLevel.hs 38
 pendingName :: RepoType p -> String
 pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending"
 
-read_pending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL
Prim C(r)))
+read_pending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL
Prim C(t)))

Pending returns the tentative state.  Makes sense.

 read_pending (Repo r _ _ tp) =
     withCurrentDirectory r (read_pendingfile (pendingName tp))
 
hunk ./src/Darcs/Repository/Merge.hs 52
 tentativelyMergePatches_ :: forall p C(r u t y x). RepoPatch p
                          => MakeChanges
                          -> Repository p C(r u t) -> String -> [DarcsFlag]
-                         -> FL (PatchInfoAnd p) C(x r) -> FL
(PatchInfoAnd p) C(x y)
+                         -> FL (PatchInfoAnd p) C(x t) -> FL
(PatchInfoAnd p) C(x y)

Merge in a patch sequence that results in a tentative state not a
recorded state.  Got it.

                          -> IO (Sealed (FL Prim C(u)))
 tentativelyMergePatches_ mc r cmd opts usi themi =
   do let us = mapFL_FL hopefully usi
hunk ./src/Darcs/Repository/Merge.hs 84
                                                     (effect them) pwprim
      debugMessage "Applying patches to the local directories..."
      when (mc == MakeChanges) $
-          do let doChanges :: FL (PatchInfoAnd p) C(x r) -> IO ()
+          do let doChanges :: FL (PatchInfoAnd p) C(x t) -> IO ()

This change is required by the one above it.

                  doChanges NilFL = applyps r themi
                  doChanges _     = applyps r (mapFL_FL n2pia pc)
              doChanges usi
hunk ./src/Darcs/Repository/Merge.hs 90
              setTentativePending r (effect pend' +>+ pw_resolution)
      return $ seal (effect pwprim +>+ pw_resolution)
-  where mapAdd :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j)
-> [IO ()]
+  where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
-> [IO ()]

Again, what is up with the reordering?

         mapAdd _ NilFL = []
         mapAdd r'@(Repo dir df rf dr) (a:>:as) =
                -- we construct a new Repository object on the recursive
case so that the
hunk ./src/Darcs/Repository/Merge.hs 96
                -- recordedstate of the repository can match the fact
that we just wrote a patch
                tentativelyAddPatch_ DontUpdatePristine r' opts a :
mapAdd (Repo dir df rf dr) as
-        applyps :: Repository p C(i l m) -> FL (PatchInfoAnd p) C(i j)
-> IO ()
+        applyps :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
-> IO ()

Another reordering.

         applyps repo ps = do debugMessage "Adding patches to inventory..."
                              sequence_ $ mapAdd repo ps
                              debugMessage "Applying patches to pristine..."
hunk ./src/Darcs/Repository/Merge.hs 104
 
 tentativelyMergePatches :: RepoPatch p
                         => Repository p C(r u t) -> String -> [DarcsFlag]
-                        -> FL (PatchInfoAnd p) C(x r) -> FL
(PatchInfoAnd p) C(x y)
+                        -> FL (PatchInfoAnd p) C(x t) -> FL
(PatchInfoAnd p) C(x y)

Another fix up for tentative vs. recorded.

                         -> IO (Sealed (FL Prim C(u)))
 tentativelyMergePatches = tentativelyMergePatches_ MakeChanges
 
hunk ./src/Darcs/Repository/Merge.hs 111
 
 considerMergeToWorking :: RepoPatch p
                        => Repository p C(r u t) -> String -> [DarcsFlag]
-                       -> FL (PatchInfoAnd p) C(x r) -> FL
(PatchInfoAnd p) C(x y)
+                       -> FL (PatchInfoAnd p) C(x t) -> FL
(PatchInfoAnd p) C(x y)

Tentative vs. recorded.  OK.

                        -> IO (Sealed (FL Prim C(u)))
 considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges
 
hunk ./src/Darcs/Repository/State.hs 130
 -- out of sync (file is modified, index is updated and file is modified
again
 -- within a single second).
 unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t)
-                  -> [SubPath] -> IO (FL Prim C(r y))
+                  -> [SubPath] -> IO (FL Prim C(t y))

This one seems a bit odd, but I guess it is consistent with the new
way of thinking about t being the current transation.  What seemed odd
when I first looked at it is that we are fetching *unrecorded* changes
but giving back everything from tentative to the end of the new stuff.

 unrecordedChanges opts repo paths = do
   (all_current, _) <- readPending repo
   Sealed pending <- pendingChanges repo paths
hunk ./src/Darcs/Repository/State.hs 195
   Sealed pending <- pendingChanges repo []
   applyToTree pending pristine
 
-readPending :: (RepoPatch p) => Repository p C(r u t) -> IO (Tree IO,
Sealed (FL Prim C(r)))
+readPending :: (RepoPatch p) => Repository p C(r u t) -> IO (Tree IO,
Sealed (FL Prim C(t)))

More of the same.

 readPending repo =
   do Sealed pending <- read_pending repo
      pristine <- readRecorded repo
hunk ./src/Darcs/Repository/State.hs 207
        return (pristine, seal NilFL)
 
 pendingChanges :: (RepoPatch p) => Repository p C(r u t)
-               -> [SubPath] -> IO (Sealed (FL Prim C(r)))
+               -> [SubPath] -> IO (Sealed (FL Prim C(t)))

Yup.

 pendingChanges repo paths = do
   Sealed pending <- snd `fmap` readPending repo
   let files = map (fn2fp . sp2fn) paths
hunk ./src/Darcs/SelectChanges.hs 656
 filterOutConflicts :: RepoPatch p
                    => [DarcsFlag]                                    --
^Command-line options. Only 'SkipConflicts' is
                                                                      --
significant; filtering will happen iff it is present
-                   -> RL (PatchInfoAnd p) C(x r)                     --
^Recorded patches from repository, starting from
+                   -> RL (PatchInfoAnd p) C(x t)                     --
^Recorded patches from repository, starting from

Got it.

                                                                      --
same context as the patches to filter
                    -> Repository p C(r u t)                          --
^Repository itself, used for grabbing unrecorded changes
                    -> FL (PatchInfoAnd p) C(x z)                     --
^Patches to filter
[return new repository state from tentativelyAdd etc
Ganesh Sittampalam <ganesh@earth.li>**20091202191833
 Ignore-this: 72a9c476023fa0c22cd0aa21d1f6ef1e
] hunk ./src/Darcs/Repository/Internal.hs 491
           fromPrims_ = fromPrims
 
 tentativelyAddPatch :: RepoPatch p
-                    => Repository p C(r u t) -> [DarcsFlag] ->
PatchInfoAnd p C(t y) -> IO ()
+                    => Repository p C(r u t) -> [DarcsFlag] ->
PatchInfoAnd p C(t y) -> IO (Repository p C(r u y))

Looks good.

 tentativelyAddPatch = tentativelyAddPatch_ UpdatePristine
 
 data UpdatePristine = UpdatePristine | DontUpdatePristine deriving Eq
hunk ./src/Darcs/Repository/Internal.hs 498
 
 tentativelyAddPatch_ :: RepoPatch p
                      => UpdatePristine -> Repository p C(r u t) ->
[DarcsFlag]
-                     -> PatchInfoAnd p C(t y) -> IO ()
+                     -> PatchInfoAnd p C(t y) -> IO (Repository p C(r u y))

Same as previous change.

 tentativelyAddPatch_ _ _ opts _
     | DryRun `elem` opts = bug "tentativelyAddPatch_ called when
--dry-run is specified"
hunk ./src/Darcs/Repository/Internal.hs 501
-tentativelyAddPatch_ up r@(Repo dir _ rf (DarcsRepository _ c)) opts p =
+tentativelyAddPatch_ up r@(Repo dir ropts rf (DarcsRepository t c))
opts p =

Introduce a binding so that you can return a repository below.

     withCurrentDirectory dir $
     do decideHashedOrNormal rf $ HvsO {
           hashed = HashedRepo.add_to_tentative_inventory c (compression
opts) p,
hunk ./src/Darcs/Repository/Internal.hs 510
                                         applyToTentativePristine r p
                                         debugMessage "Updating pending..."
                                         handle_pend_for_add r p
+       return (Repo dir ropts rf (DarcsRepository t c))

Reasonable.

 
 applyToTentativePristine :: (Effect q, Patchy q) => Repository p C(r u
t) -> q C(t y) -> IO ()
 applyToTentativePristine (Repo dir opts rf (DarcsRepository _ c)) p =
hunk ./src/Darcs/Repository/Internal.hs 588
       return (Repo dir ropts rf (DarcsRepository t c))
 
 tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p =>
Repository p C(r u t) -> [DarcsFlag]
-                          -> FL (Named p) C(x t) -> IO ()
+                          -> FL (Named p) C(x t) -> IO (Repository p
C(r u t))

Looks good.


 tentativelyReplacePatches repository opts ps =
     do repository' <- tentativelyRemovePatches_ DontUpdatePristine
repository opts ps
hunk ./src/Darcs/Repository/Internal.hs 591
-       sequence_ $ mapAdd repository' ps
-  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> [IO ()]
-        mapAdd _ NilFL = []
-        mapAdd r@(Repo dir df rf dr) (a:>:as) =
-               -- we construct a new Repository object on the recursive
case so that the
-               -- recordedstate of the repository can match the fact
that we just wrote a patch
-               tentativelyAddPatch_ DontUpdatePristine r opts (n2pia a)
: mapAdd (Repo dir df rf dr) as
+       mapAdd repository' ps
+  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> IO
(Repository p C(m l j))
+        mapAdd r NilFL = return r
+        mapAdd r (a:>:as) =
+               do r' <- tentativelyAddPatch_ DontUpdatePristine r opts
(n2pia a)
+                  mapAdd r' as

It seems that the m l i vs. i l m stuff has something to do with the r
vs. t changes.  If I buy the later change, then it seems like I sohuld
go for this change as well.  Hmm...

 
 finalize_pending :: RepoPatch p => Repository p C(r u t) -> IO ()
 finalize_pending (Repo dir opts _ rt)
hunk ./src/Darcs/Repository/Merge.hs 90
              doChanges usi
              setTentativePending r (effect pend' +>+ pw_resolution)
      return $ seal (effect pwprim +>+ pw_resolution)
-  where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
-> [IO ()]
-        mapAdd _ NilFL = []
-        mapAdd r'@(Repo dir df rf dr) (a:>:as) =
-               -- we construct a new Repository object on the recursive
case so that the
-               -- recordedstate of the repository can match the fact
that we just wrote a patch
-               tentativelyAddPatch_ DontUpdatePristine r' opts a :
mapAdd (Repo dir df rf dr) as
+  where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
-> IO (Repository p C(m l j))
+        mapAdd repo NilFL = return repo
+        mapAdd repo (a:>:as) =
+               do repo' <- tentativelyAddPatch_ DontUpdatePristine repo
opts a
+                  mapAdd repo' as

Same change as above, but any reason to not include the comment?

         applyps :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
-> IO ()
         applyps repo ps = do debugMessage "Adding patches to inventory..."
hunk ./src/Darcs/Repository/Merge.hs 97
-                             sequence_ $ mapAdd repo ps
+                             mapAdd repo ps

Looks like the sequence is now absorbed into the locally defined
mapAdd.  Not really sure why, but I won't contest the point :)

                              debugMessage "Applying patches to pristine..."
                              applyToTentativePristine repo ps
 
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] hunk ./src/Darcs/Witnesses/Sealed.hs 1
--- Copyright (C) 2007 David Roundy
+-- Copyright (C) 2007 David Roundy, 2009 Ganesh Sittampalam

While you're at it, my name could be there too :)

 --
 -- This program is free software; you can redistribute it and/or modify
 -- it under the terms of the GNU General Public License as published by
hunk ./src/Darcs/Witnesses/Sealed.hs 30
 #endif
                       Sealed2(..), seal2, unseal2, mapSeal2,
                       FlippedSeal(..), flipSeal, unsealFlipped, mapFlipped,
-                      unsealM, liftSM
+                      unsealM, liftSM,
+                      Gap(..), FreeLeft, unFreeLeft, FreeRight, unFreeRight

New exports.

                     ) where
 
 import GHC.Base ( unsafeCoerce# )
hunk ./src/Darcs/Witnesses/Sealed.hs 106
 instance Show2 a => Show (Sealed2 a) where
     showsPrec d (Sealed2 x) = showParen (d > app_prec) $ showString
"Sealed2 " . showsPrec2 (app_prec + 1) x
 
+newtype Poly a = Poly { unPoly :: FORALL(x) a C(x) }

Polymorphic?

+
+newtype Stepped f a C(x) = Stepped { unStepped :: f (a C(x)) }

What does stepped mean?

+
+newtype FreeLeft p = FLInternal (Poly (Stepped Sealed p))
+newtype FreeRight p = FRInternal (Poly (FlippedSeal p))

Now I'm confused :)  These wrappers confuse me.

+
+unFreeLeft :: FreeLeft p -> Sealed (p C(x))
+unFreeLeft (FLInternal x) = unStepped (unPoly x)
+
+unFreeRight :: FreeRight p -> FlippedSeal p C(x)
+unFreeRight (FRInternal x) = unPoly x

Unwrappers.

+
+class Gap w where
+  emptyGap :: (FORALL(x) p C(x x)) -> w p
+  freeGap :: (FORALL(x y) p C(x y)) -> w p
+  joinGap :: (FORALL(x y z) p C(x y) -> q C(y z) -> r C(x z)) -> w p ->
w q -> w r

What is a gap?

+
+instance Gap FreeLeft where
+  emptyGap e = FLInternal (Poly (Stepped (Sealed e)))
+  freeGap e =  FLInternal (Poly (Stepped (Sealed e)))
+  joinGap op (FLInternal p) (FLInternal q)
+    = FLInternal (Poly (case unPoly p of Stepped (Sealed p') -> case
unPoly q of Stepped (Sealed q') -> Stepped (Sealed (p' `op` q'))))
+
+instance Gap FreeRight where
+  emptyGap e = FRInternal (Poly (FlippedSeal e))
+  freeGap e =  FRInternal (Poly (FlippedSeal e))
+  joinGap op (FRInternal p) (FRInternal q)
+    = FRInternal (Poly (case unPoly q of FlippedSeal q' -> case unPoly
p of FlippedSeal p' -> FlippedSeal (p' `op` q')))

This code is very abstract :)

[add docs to Gap and related types
Ganesh Sittampalam <ganesh@earth.li>**20100212180627
 Ignore-this: 9013feebb49e489e1d1c7c5770d191da
] hunk ./src/Darcs/Witnesses/Sealed.hs 106
 instance Show2 a => Show (Sealed2 a) where
     showsPrec d (Sealed2 x) = showParen (d > app_prec) $ showString
"Sealed2 " . showsPrec2 (app_prec + 1) x
 
+-- |'Poly' is similar to 'Sealed', but the type argument is
+-- universally quantified instead of being existentially quantified.
 newtype Poly a = Poly { unPoly :: FORALL(x) a C(x) }
 
hunk ./src/Darcs/Witnesses/Sealed.hs 110
+-- |'Stepped' is a type level composition operator.
+-- For example, 'Stepped Sealed p' is equivalent to 'lambda x . Sealed
(p x)'
 newtype Stepped f a C(x) = Stepped { unStepped :: f (a C(x)) }
 
hunk ./src/Darcs/Witnesses/Sealed.hs 114
+-- |'FreeLeft p' is '\forall x . \exists y . p x y'
+-- In other words the caller is free to specify the left witness,
+-- and then the right witness is an existential.
+-- Note that the order of the type constructors is important for ensuring
+-- that 'y' is dependent on the 'x' that is supplied.
+-- This is why 'Stepped' is needed, rather than writing the more obvious
+-- 'Sealed (Poly p)' which would notionally have the same quantification
+-- of the type witnesses.

Clever.

 newtype FreeLeft p = FLInternal (Poly (Stepped Sealed p))
hunk ./src/Darcs/Witnesses/Sealed.hs 123
+
+-- |'FreeLeft p' is '\forall y . \exists x . p x y'
+-- In other words the caller is free to specify the right witness,
+-- and then the left witness is an existential.
+-- Note that the order of the type constructors is important for ensuring
+-- that 'x' is dependent on the 'y' that is supplied.
 newtype FreeRight p = FRInternal (Poly (FlippedSeal p))
 
hunk ./src/Darcs/Witnesses/Sealed.hs 131
+-- |Unwrap a 'FreeLeft' value
 unFreeLeft :: FreeLeft p -> Sealed (p C(x))
 unFreeLeft (FLInternal x) = unStepped (unPoly x)
 
hunk ./src/Darcs/Witnesses/Sealed.hs 135
+-- |Unwrap a 'FreeRight' value
 unFreeRight :: FreeRight p -> FlippedSeal p C(x)
 unFreeRight (FRInternal x) = unPoly x
 
hunk ./src/Darcs/Witnesses/Sealed.hs 139
+-- |'Gap' abstracts over 'FreeLeft' and 'FreeRight' for code
constructing these values
 class Gap w where
hunk ./src/Darcs/Witnesses/Sealed.hs 141
+  -- |An empty 'Gap', e.g. 'NilFL' or 'NilRL'
   emptyGap :: (FORALL(x) p C(x x)) -> w p
hunk ./src/Darcs/Witnesses/Sealed.hs 143
+  -- |A 'Gap' constructed from a completely polymorphic value, for
example the constructors
+  -- for primitive patches
   freeGap :: (FORALL(x y) p C(x y)) -> w p
hunk ./src/Darcs/Witnesses/Sealed.hs 146
+  -- |Compose two 'Gap' values together, e.g. 'joinGap (+>+)' or
'joinGap (:>:)'
   joinGap :: (FORALL(x y z) p C(x y) -> q C(y z) -> r C(x z)) -> w p ->
w q -> w r

Makes more sense with the haddocks.  Thanks for adding those.
 
 instance Gap FreeLeft where
[add TypeOperators to witnesses build
Ganesh Sittampalam <ganesh@earth.li>**20091221190333
 Ignore-this: 22808f3dad964cb930d44436080c93e2
] hunk ./darcs.cabal 140
     RankNTypes
     GADTs
     ImpredicativeTypes
+    TypeOperators
 
   if !flag(type-witnesses)
     buildable: False
[reduce conditionalisation on witnesses in Darcs.Patch.Commute
Ganesh Sittampalam <ganesh@earth.li>**20100126201933
 Ignore-this: 6ba0e070aff1bbac7a0f4d508aced1cb
] hunk ./src/Darcs/Patch.lhs 58
                thing, things,
                isSimilar, primIsAddfile, primIsHunk, primIsSetpref,
 #ifndef GADT_WITNESSES
-               merger, isMerger, merge,
+               merger,
+#endif
+               isMerger, merge,
                commute, listTouchedFiles, hunkMatches,
                -- for PatchTest
hunk ./src/Darcs/Patch.lhs 63
-               unravel, elegantMerge,
-#else
-               Commute(..),
+#ifndef GADT_WITNESSES
+               unravel,
 #endif
hunk ./src/Darcs/Patch.lhs 66
+               elegantMerge,
                resolveConflicts,
                Effect, effect,
                primIsBinary, gzWritePatch, writePatch, primIsAdddir,
hunk ./src/Darcs/Patch.lhs 93
                           flattenFL,
                           adddeps, namepatch,
                           anonymous,
-#ifndef GADT_WITNESSES
                           isMerger,
hunk ./src/Darcs/Patch.lhs 94
-#endif
                           getdeps,
                           isNullPatch, nullP, infopatch,
                           patch2patchinfo, patchname, patchcontents )
hunk ./src/Darcs/Patch.lhs 104
                             thing, things,
                             commuteFL, commuteRL, apply,
                             description, summary,
-#ifndef GADT_WITNESSES
-                            commute, listTouchedFiles, hunkMatches,
-#else
-                            Commute(..)
-#endif
+                            commute, listTouchedFiles, hunkMatches
                           )
 import Darcs.Patch.Viewing ( xmlSummary, plainSummary )
 import Darcs.Patch.Apply ( applyToPop, patchChanges, emptyMarkedupFile,
hunk ./src/Darcs/Patch.lhs 113
                            LineMark(..), MarkedUpFile, applyToTree )
 import Darcs.Patch.Commute ( modernizePatch,
 #ifndef GADT_WITNESSES
-                             unravel,
-                             merger, merge, elegantMerge,
+                             merger, unravel,
 #endif
hunk ./src/Darcs/Patch.lhs 115
+                             merge, elegantMerge,
                             )
 import Darcs.Patch.Prim ( FromPrims, fromPrims, joinPatches, FromPrim,
fromPrim,
                           Conflict, Effect(effect),
listConflictedFiles, resolveConflicts,
hunk ./src/Darcs/Patch/Commute.lhs 28
 
 module Darcs.Patch.Commute ( fromPrims,
                              modernizePatch,
-#ifndef GADT_WITNESSES
                              merge, elegantMerge,
hunk ./src/Darcs/Patch/Commute.lhs 29
+#ifndef GADT_WITNESSES
                              merger, unravel,
 #endif
                              public_unravel, mangle_unravelled,
[add witnesses to treeDiff
Ganesh Sittampalam <ganesh@earth.li>**20100210184308
 Ignore-this: 2d73685b18d3132b6d27eb47a9239ca1
] hunk ./src/Darcs/Commands/Changes.lhs 121
   withRepositoryDirectory opts repodir $- \repository -> do
   unless (Debug `elem` opts) $ setProgressMode False
   files <- sort `fmap` fixSubPaths opts args
-  unrec <- if null files then return identity
-             else unrecordedChanges opts repository files
-           `catch` \_ -> return identity -- this is triggered when
repository is remote
+  Sealed unrec <- if null files then return (Sealed identity)
+                  else Sealed `fmap` unrecordedChanges opts repository
files
+                  `catch` \_ -> return (Sealed identity) -- this is
triggered when repository is remote

Seems fine.  Just sealing/unsealing as needed.

   let filez = map (fn2fp . norm_path . fp2fn) $ applyToFilepaths
(invert unrec) $ map toFilePath files
       filtered_changes p = maybe_reverse $ getChangesInfo opts filez p
   debugMessage "About to read the repository..."
hunk ./src/Darcs/Commands/Check.lhs 39
                           testRecorded, readRecorded )
 import Darcs.Patch ( RepoPatch, showPatch )
 import Darcs.Witnesses.Ordered ( FL(..) )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction )
 import Darcs.Diff( treeDiff )
 import Printer ( text, ($$), (<+>) )
hunk ./src/Darcs/Commands/Check.lhs 109
          putInfo opts $ text "Looks like we have a difference..."
          mc <- readRecorded repository
          ftf <- filetypeFunction
-         diff <- treeDiff ftf newpris mc
+         Sealed diff <- unFreeLeft `fmap` treeDiff ftf newpris mc

Unsealing as needed.

          putInfo opts $ case diff of
                         NilFL -> text "Nothing"
                         patch -> text "Difference: " <+> showPatch patch
hunk ./src/Darcs/Commands/Remove.lhs 42
 import Darcs.Patch ( RepoPatch, Prim, adddir, rmdir, addfile, rmfile )
 import Darcs.Patch.FileName( fn2fp )
 import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
-import Darcs.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction )
 import Storage.Hashed.Tree( TreeItem(..), find, modifyTree, expand )
 import Storage.Hashed.AnchoredPath( anchorPath )
hunk ./src/Darcs/Commands/Remove.lhs 110
               (Just (SubTree _), Just (SubTree _)) ->
                   return . Sealed $ rmdir f_fp :>: rest
               (Just (File _), Just (File _)) ->
-                  do diff <- treeDiff ftf unrecorded unrecorded'
+                  do Sealed diff <- unFreeLeft `fmap` treeDiff ftf
unrecorded unrecorded'

More unsealing.

                      return . Sealed $ diff +>+ rest
               (Just (File _), _) ->
                   return . Sealed $ addfile f_fp :>: rmfile f_fp :>: rest
hunk ./src/Darcs/Commands/Replace.lhs 49
 import Darcs.Patch.FileName( fn2fp )
 import Darcs.Patch.Patchy ( Apply )
 import Darcs.Witnesses.Ordered ( FL(..), unsafeFL, (+>+), concatFL )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Patch.RegChars ( regChars )
 import Data.Char ( isSpace )
 import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
hunk ./src/Darcs/Commands/Replace.lhs 207
                 tree' = modifyTree tree path (File . makeBlobBS <$>
newcontent)
             case newcontent of
               Nothing -> bug "weird forcing bug in replace."
-              Just _ -> do pfix <- treeDiff ftf tree tree'
+              Just _ -> do Sealed pfix <- unFreeLeft `fmap` treeDiff
ftf tree tree'

More unsealing.

                            return $ pfix +>+ (tokreplace f_fp toks old
new :>: NilFL)
             where f_fp = toFilePath f
 
hunk ./src/Darcs/Commands/WhatsNew.lhs 51
 import Darcs.Patch.FileName ( fn2fp )
 import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
 import Darcs.Witnesses.Ordered ( FL(..), mapFL_FL, reverseRL,
reverseFL, (:>)(..), nullFL )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Diff( treeDiff )
 
 import Storage.Hashed.Monad( virtualTreeIO, exists )
hunk ./src/Darcs/Commands/WhatsNew.lhs 145
 
     cho_adds_t <- applyToTree (reverseRL cho_adds) pristine
     cha_t <- applyToTree (reverseRL cha) pristine
-    chn <- treeDiff ftf cho_adds_t cha_t
+    Sealed chn <- unFreeLeft `fmap` treeDiff ftf cho_adds_t cha_t

More unsealing.
 
     exitOnNoChanges (chn, chold)
     putDocLn $ plainSummary chold
hunk ./src/Darcs/Diff.hs 25
 
 module Darcs.Diff( treeDiff ) where
 import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
+import Darcs.Witnesses.Sealed ( Gap(..) )
 import Darcs.Repository.Prefs ( FileType(..) )
 import Darcs.Patch ( Prim, hunk, canonize, binary
                    , addfile, rmfile, adddir, rmdir, invert)
hunk ./src/Darcs/Diff.hs 41
 
 #include "gadts.h"
 
-treeDiff :: (FilePath -> FileType) -> Tree IO -> Tree IO -> IO (FL Prim
C(x y))
-#ifdef GADT_WITNESSES
-treeDiff = undefined -- Sigh.
-#else
+treeDiff :: Gap w => (FilePath -> FileType) -> Tree IO -> Tree IO -> IO
(w (FL Prim))
 treeDiff ft t1 t2 = do
   (from, to) <- diffTrees t1 t2
   diffs <- sequence $ zipTrees diff from to
hunk ./src/Darcs/Diff.hs 45
-  return $ foldr (+>+) NilFL diffs
-    where diff :: AnchoredPath -> Maybe (TreeItem IO) -> Maybe
(TreeItem IO)
-               -> IO (FL Prim)
-          diff _ (Just (SubTree _)) (Just (SubTree _)) = return NilFL
+  return $ foldr (joinGap (+>+)) (emptyGap NilFL) diffs
+    where diff :: Gap w
+               => AnchoredPath -> Maybe (TreeItem IO) -> Maybe
(TreeItem IO)
+               -> IO (w (FL Prim))
+          diff _ (Just (SubTree _)) (Just (SubTree _)) = return
(emptyGap NilFL)

I don't understand the above, because I haven't taken the time to
really understand Gap.  That said, the transformation seems to follow
naturally from the Gap definition.

           diff p (Just (SubTree _)) Nothing =
hunk ./src/Darcs/Diff.hs 51
-              return $ rmdir (anchorPath "" p) :>: NilFL
+              return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)

Again, seems natural.

           diff p Nothing (Just (SubTree _)) =
hunk ./src/Darcs/Diff.hs 53
-              return $ adddir (anchorPath "" p) :>: NilFL
+              return $ freeGap (adddir (anchorPath "" p) :>: NilFL)

Here too.

           diff p Nothing b'@(Just (File _)) =
               do diff' <- diff p (Just (File emptyBlob)) b'
hunk ./src/Darcs/Diff.hs 56
-                 return $ addfile (anchorPath "" p) :>: diff'
+                 return $ joinGap (:>:) (freeGap (addfile (anchorPath
"" p))) diff'

And this.

           diff p a'@(Just (File _)) Nothing =
               do diff' <- diff p a' (Just (File emptyBlob))
hunk ./src/Darcs/Diff.hs 59
-                 return $ diff' +>+ (rmfile (anchorPath "" p) :>: NilFL)
+                 return $ joinGap (+>+) diff' (freeGap (rmfile
(anchorPath "" p) :>: NilFL))

Sure....

           diff p (Just (File a')) (Just (File b')) =
               do a <- readBlob a'
                  b <- readBlob b'
hunk ./src/Darcs/Diff.hs 68
                    TextFile | no_bin a && no_bin b ->
                                 return $ text_diff path a b
                    _ -> return $ if a /= b
-                                    then binary path (strict a) (strict
b) :>: NilFL
-                                    else NilFL
+                                    then freeGap (binary path (strict
a) (strict b) :>: NilFL)
+                                    else emptyGap NilFL

If you say so :)

           diff p _ _ = fail $ "Missing case at path " ++ show p
           text_diff p a b
hunk ./src/Darcs/Diff.hs 72
-              | BL.null a && BL.null b = NilFL
-              | BL.null a = diff_from_empty p b
-              | BL.null b = diff_to_empty p a
-              | otherwise = line_diff p (linesB a) (linesB b)
+              | BL.null a && BL.null b = emptyGap NilFL
+              | BL.null a = freeGap (diff_from_empty p b)
+              | BL.null b = freeGap (diff_to_empty p a)
+              | otherwise = freeGap (line_diff p (linesB a) (linesB b))

Gap gap gap.

           line_diff p a b = canonize (hunk p 1 a b)
           diff_to_empty p x | BLC.last x == '\n' = line_diff p (init $
linesB x) []
                             | otherwise = line_diff p (linesB x) [BS.empty]
hunk ./src/Darcs/Diff.hs 83
           no_bin = not . is_funky . strict . BL.take 4096
           linesB = map strict . BLC.split '\n'
           strict = BS.concat . BL.toChunks
-#endif
 
hunk ./src/Darcs/Repository/Repair.hs 21
 
 import Darcs.Witnesses.Ordered ( FL(..), RL(..), lengthFL, reverseFL,
reverseRL, concatRL,
                      mapRL )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Patch.Patchy ( applyAndTryToFix )
 import Darcs.Patch.Info ( PatchInfo( .. ), human_friendly )
 import Darcs.Patch.Set ( PatchSet )
hunk ./src/Darcs/Repository/Repair.hs 130
 
   debugMessage "Checking pristine against slurpy"
   ftf <- filetypeFunction
-  is_same <- do diff <- treeDiff ftf pris newpris
+  is_same <- do Sealed diff <- unFreeLeft `fmap` treeDiff ftf pris newpris

More unsealing.

                 return $ case diff of
                            NilFL -> True
                            _ -> False
hunk ./src/Darcs/Repository/State.hs 51
                    , sortCoalesceFL )
 import Darcs.Patch.TouchesFiles ( choose_touching )
 import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
-import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal )
+import Darcs.Witnesses.Ordered ( unsafeCoerceP, EqCheck(IsEq) )
+import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, FreeLeft,
unFreeLeft )
 import Darcs.Diff ( treeDiff )
 import Darcs.Flags ( DarcsFlag( LookForAdds ), willIgnoreTimes )
 import Darcs.Utils ( filterPaths )
hunk ./src/Darcs/Repository/State.hs 130
 -- is very inefficient, although in extremely rare cases, the index
could go
 -- out of sync (file is modified, index is updated and file is modified
again
 -- within a single second).
-unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t)
-                  -> [SubPath] -> IO (FL Prim C(t y))
+unrecordedChanges :: FORALL(p r u t) (RepoPatch p)
+                  => [DarcsFlag] -> Repository p C(r u t)
+                  -> [SubPath] -> IO (FL Prim C(t u))

This changed a lot.  Used to return something from the tentative to
the unknown and now it returns something from tentative to unrecorded.
The latter seems to fit the name better.

 unrecordedChanges opts repo paths = do
   (all_current, _) <- readPending repo
hunk ./src/Darcs/Repository/State.hs 135
-  Sealed pending <- pendingChanges repo paths
+  Sealed (pending :: FL Prim C(t x)) <- pendingChanges repo paths

Making things explicit.
 
   relevant <- restrictSubpaths repo paths
   let getIndex = I.updateIndex =<< (relevant <$> readIndex repo)
hunk ./src/Darcs/Repository/State.hs 153
                  return $ if ignoretimes then plain else plain
`overlay` index
 
   ft <- filetypeFunction
-  diff <- treeDiff ft current working
+  Sealed (diff :: FL Prim C(x y)) <- (unFreeLeft `fmap` treeDiff ft
current working) :: IO (Sealed (FL Prim C(x)))

Wow.  Hmm...Probably just making it more explicit.

+  IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(y u))

You're unsafeCoercing an EqCheck?  You're telling the type checker
that y = u from now on?  I'm sure you have a good reason, so please
explain.

   return $ sortCoalesceFL (pending +>+ diff)
 
 -- | Obtains a Tree corresponding to the "recorded" state of the
repository:
hunk ./src/Darcs/Resolution.lhs 48
 import Darcs.Hopefully ( hopefully )
 import Darcs.Utils ( askUser, filterFilePaths )
 import Darcs.Patch.Set ( PatchSet, Origin )
-import Darcs.Witnesses.Sealed ( seal )
-import Darcs.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction )
 import Exec ( exec, Redirect(..) )
 import Darcs.Lock ( withTempDir )
hunk ./src/Darcs/Resolution.lhs 198
              sc <- readPlainTree dc
              sfixed <- readPlainTree dm
              ftf <- filetypeFunction
-             seal `fmap` treeDiff ftf sc sfixed
+             unFreeLeft `fmap` treeDiff ftf sc sfixed

Resealing.

 
 externally_resolve_file :: String -> String -> String -> String -> String
                         -> (FilePath, FilePath, FilePath, FilePath)
[add witnessed variant of PatchInfo
Ganesh Sittampalam <ganesh@earth.li>**20100210185926
 Ignore-this: b9f54295d9eca8687a4a785b5d8e9028
] hunk ./src/Darcs/Hopefully.hs 24
 #include "gadts.h"
 
 module Darcs.Hopefully ( Hopefully, PatchInfoAnd,
+                         WPatchInfo, unWPatchInfo, compareWPatchInfo,
                          piap, n2pia, patchInfoAndPatch,
hunk ./src/Darcs/Hopefully.hs 26
-                         conscientiously, hopefully, info,
+                         conscientiously, hopefully, info, winfo,
                          hopefullyM, createHashed, extractHash,
                          actually, unavailable ) where
 
hunk ./src/Darcs/Hopefully.hs 30
+import Data.Function ( on )
 import System.IO.Unsafe ( unsafeInterleaveIO )
 
 import Darcs.SignalHandler ( catchNonSignal )
hunk ./src/Darcs/Hopefully.hs 40
 import Darcs.Patch.Prim ( Effect(..), Conflict(..) )
 import Darcs.Patch.Patchy ( Patchy, ReadPatch(..), Apply(..), Invert(..),
                             ShowPatch(..), Commute(..) )
-import Darcs.Witnesses.Ordered ( MyEq, unsafeCompare, (:>)(..),
(:\/:)(..), (:/\:)(..) )
+import Darcs.Witnesses.Ordered ( MyEq, EqCheck(..), unsafeCoerceP,
unsafeCompare, (:>)(..), (:\/:)(..), (:/\:)(..) )
 import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, mapSeal )
 import Darcs.Utils ( prettyException )
 
hunk ./src/Darcs/Hopefully.hs 63
 -- know its info.
 data PatchInfoAnd p C(a b) = PIAP !PatchInfo (Hopefully (Named p) C(a b))
 
+-- | @'WPatchInfo' C(a b)@ represents the info of a patch, marked with
+-- the patch's witnesses.
+newtype WPatchInfo C(a b) = WPatchInfo { unWPatchInfo :: PatchInfo }

Please use this newtype constructor with caution!

+
+-- This is actually unsafe if we ever commute patches and then compare them
+-- using this function. TODO: consider adding an extra existential to
WPatchInfo
+-- (as with TaggedPatch in Darcs.Patch.Choices)
+compareWPatchInfo :: WPatchInfo C(a b) -> WPatchInfo C(c d) -> EqCheck
C((a, b) (c, d))
+compareWPatchInfo (WPatchInfo x) (WPatchInfo y) = if x == y then
unsafeCoerceP IsEq else NotEq

Should the above TODO be in the bug tracker or somewhere else?  Does it
need doing?

+
+instance MyEq WPatchInfo where
+   WPatchInfo x `unsafeCompare` WPatchInfo y = x == y
+
 fmapH :: (a C(x y) -> b C(w z)) -> Hopefully a C(x y) -> Hopefully b C(w z)
 fmapH f (Hopefully sh) = Hopefully (ff sh)
     where ff (Actually a) = Actually (f a)
hunk ./src/Darcs/Hopefully.hs 87
 info :: PatchInfoAnd p C(a b) -> PatchInfo
 info (PIAP i _) = i
 
+winfo :: PatchInfoAnd p C(a b) -> WPatchInfo C(a b)
+winfo (PIAP i _) = WPatchInfo i
+
 -- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.
 piap :: PatchInfo -> Named p C(a b) -> PatchInfoAnd p C(a b)
 piap i p = PIAP i (Hopefully $ Actually p)
[add witnesses to Darcs.Repository.Repair
Ganesh Sittampalam <ganesh@earth.li>**20100210190716
 Ignore-this: 23432ed7f437a4d7fc964ec4e6f8db99
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
[add witnessed variant of PatchInfo
Ganesh Sittampalam <ganesh@earth.li>**20091214150555
 Ignore-this: ffbb9a86bde95b31043608bae1ee2640
] 
> hunk ./src/Darcs/Repository/Repair.hs 2
 {-# OPTIONS_GHC -cpp #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, PatternGuards #-}
 
 module Darcs.Repository.Repair ( replayRepository, checkIndex
                                , RepositoryConsistency(..) )
hunk ./src/Darcs/Repository/Repair.hs 17
 import System.Directory ( createDirectoryIfMissing )
 
 import Darcs.Lock( rm_recursive )
-import Darcs.Hopefully ( PatchInfoAnd, info )
+import Darcs.Hopefully ( PatchInfoAnd, info, winfo, WPatchInfo,
unWPatchInfo, compareWPatchInfo )
 
 import Darcs.Witnesses.Ordered ( FL(..), RL(..), lengthFL, reverseFL,
reverseRL, concatRL,
hunk ./src/Darcs/Repository/Repair.hs 20
-                     mapRL )
-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
+                     mapRL, nullFL, (:||:)(..), EqCheck(..) )
+import Darcs.Witnesses.Sealed ( Sealed2(..), Sealed(..), unFreeLeft )
 import Darcs.Patch.Patchy ( applyAndTryToFix )
 import Darcs.Patch.Info ( PatchInfo( .. ), human_friendly )
hunk ./src/Darcs/Repository/Repair.hs 24
-import Darcs.Patch.Set ( PatchSet )
+import Darcs.Patch.Set ( PatchSet, Origin )
 import Darcs.Patch ( RepoPatch )
 
 import Darcs.Repository.Format ( identifyRepoFormat, 
hunk ./src/Darcs/Repository/Repair.hs 57
 import qualified Data.ByteString.Char8 as BS
 
 #include "impossible.h"
+#include "gadts.h"
 
hunk ./src/Darcs/Repository/Repair.hs 59
-replaceInFL :: FL (PatchInfoAnd a)
-            -> [(PatchInfo, PatchInfoAnd a)]
-            -> FL (PatchInfoAnd a)
+replaceInFL :: FL (PatchInfoAnd a) C(x y)
+            -> [Sealed2 (WPatchInfo :||: PatchInfoAnd a)]

When was :||: introduced?

+            -> FL (PatchInfoAnd a) C(x y)
 replaceInFL orig [] = orig
 replaceInFL NilFL _ = impossible
hunk ./src/Darcs/Repository/Repair.hs 64
-replaceInFL (o:>:orig) ch@((o',c):ch_rest)
-    | info o == o' = c:>:replaceInFL orig ch_rest
+replaceInFL (o:>:orig) ch@(Sealed2 (o':||:c):ch_rest)
+    | IsEq <- winfo o `compareWPatchInfo` o' = c:>:replaceInFL orig ch_rest
     | otherwise = o:>:replaceInFL orig ch
 
hunk ./src/Darcs/Repository/Repair.hs 68
-applyAndFix :: forall p. RepoPatch p => Repository p -> FL
(PatchInfoAnd p) -> TreeIO (FL (PatchInfoAnd p), Bool)
+applyAndFix :: forall p C(r u t x y). RepoPatch p => Repository p C(r u
t) -> FL (PatchInfoAnd p) C(Origin r) -> TreeIO (FL (PatchInfoAnd p)
C(Origin r), Bool)
 applyAndFix _ NilFL = return (NilFL, True)
 applyAndFix r psin =
     do liftIO $ beginTedious k
hunk ./src/Darcs/Repository/Repair.hs 78
        orig <- liftIO $ (reverseRL . concatRL) `fmap` read_repo r
        return (replaceInFL orig repaired, ok)
     where k = "Replaying patch"
-          aaf :: FL (PatchInfoAnd p) -> TreeIO ([(PatchInfo,
PatchInfoAnd p)], Bool)
+          aaf :: FL (PatchInfoAnd p) C(w z) -> TreeIO ([Sealed2
(WPatchInfo :||: PatchInfoAnd p)], Bool)
           aaf NilFL = return ([], True)
           aaf (p:>:ps) = do
             mp' <- applyAndTryToFix p
hunk ./src/Darcs/Repository/Repair.hs 82
-            let !infp = info p -- assure that 'p' can be garbage collected.
-            liftIO $ finishedOneIO k $ show $ human_friendly $ infp
+            let !winfp = winfo p -- assure that 'p' can be garbage
collected.
+            liftIO $ finishedOneIO k $ show $ human_friendly $
unWPatchInfo winfp
             (ps', restok) <- aaf ps
             case mp' of
               Nothing -> return (ps', restok)
hunk ./src/Darcs/Repository/Repair.hs 89
               Just (e,pp) -> do liftIO $ putStrLn e
                                 p' <- liftIO $ makePatchLazy r pp
-                                return ((infp, p'):ps', False)
+                                return (Sealed2 (winfp :||: p'):ps', False)
 
hunk ./src/Darcs/Repository/Repair.hs 91
-data RepositoryConsistency p =
+data RepositoryConsistency p C(x) =
     RepositoryConsistent
   | BrokenPristine (Tree IO)
hunk ./src/Darcs/Repository/Repair.hs 94
-  | BrokenPatches (Tree IO) (PatchSet p)
+  | BrokenPatches (Tree IO) (PatchSet p C(Origin x))
 
hunk ./src/Darcs/Repository/Repair.hs 96
-check_uniqueness :: RepoPatch p => (Doc -> IO ()) -> (Doc -> IO ()) ->
Repository p -> IO ()
+check_uniqueness :: RepoPatch p => (Doc -> IO ()) -> (Doc -> IO ()) ->
Repository p C(r u t) -> IO ()
 check_uniqueness putVerbose putInfo repository =
     do putVerbose $ text "Checking that patch names are unique..."
        r <- read_repo repository
hunk ./src/Darcs/Repository/Repair.hs 112
           hd [] = Nothing
           hd (x1:x2:xs) | x1 == x2 = Just x1
                         | otherwise = hd (x2:xs)
-replayRepository' :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO
(RepositoryConsistency p)
+replayRepository' :: (RepoPatch p)
+                  => Repository p C(r u t) -> [DarcsFlag] -> IO
(RepositoryConsistency p C(r))
 replayRepository' repo opts = do
   let putVerbose s = when (Verbose `elem` opts) $ putDocLn s
       putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s
hunk ./src/Darcs/Repository/Repair.hs 133
   debugMessage "Checking pristine against slurpy"
   ftf <- filetypeFunction
   is_same <- do Sealed diff <- unFreeLeft `fmap` treeDiff ftf pris newpris
-                return $ case diff of
-                           NilFL -> True
-                           _ -> False
+                return $ nullFL diff
               `catchall` return False
   -- TODO is the latter condition needed? Does a broken patch imply
pristine
   -- difference? Why, or why not?
hunk ./src/Darcs/Repository/Repair.hs 143
             then BrokenPristine newpris
             else BrokenPatches newpris newpatches)
 
-cleanupRepositoryReplay :: Repository p -> IO ()
+cleanupRepositoryReplay :: Repository p C(r u t) -> IO ()
 cleanupRepositoryReplay r = do
   let c = extractCache r
   rf_or_e <- identifyRepoFormat "."
hunk ./src/Darcs/Repository/Repair.hs 155
        current <- readHashedPristineRoot r
        clean_hashdir c HashedPristineDir $ catMaybes [current]
 
-replayRepository :: (RepoPatch p) => Repository p -> [DarcsFlag] ->
(RepositoryConsistency p -> IO a) -> IO a
+replayRepository :: (RepoPatch p) => Repository p C(r u t) ->
[DarcsFlag] -> (RepositoryConsistency p C(r) -> IO a) -> IO a
 replayRepository r opt f = run `finally` cleanupRepositoryReplay r
     where run = do
             st <- replayRepository' r opt
hunk ./src/Darcs/Repository/Repair.hs 161
             f st
 
-checkIndex :: (RepoPatch p) => Repository p -> Bool -> IO Bool
+checkIndex :: (RepoPatch p) => Repository p C(r u t) -> Bool -> IO Bool
 checkIndex repo quiet = do
   index <- updateIndex =<< readIndex repo
   pristine <- expand =<< readRecordedAndPending repo
[add witnesses to Darcs.Commands.Check
Ganesh Sittampalam <ganesh@earth.li>**20100210191307
 Ignore-this: 4d197c1f543741abaa78d9dac26573b7
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Commands/Check.lhs 37
                               , RepositoryConsistency(..) )
 import Darcs.Repository ( Repository, amInRepository, withRepository,
                           testRecorded, readRecorded )
-import Darcs.Patch ( RepoPatch, showPatch )
+import Darcs.Patch ( RepoPatch, showPatch, Prim )
 import Darcs.Witnesses.Ordered ( FL(..) )
 import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction )
hunk ./src/Darcs/Commands/Check.lhs 44
 import Darcs.Diff( treeDiff )
 import Printer ( text, ($$), (<+>) )
 
+#include "gadts.h"
 
 checkDescription :: String
 checkDescription = "Check the repository for consistency."
hunk ./src/Darcs/Commands/Check.lhs 85
 checkCmd :: [DarcsFlag] -> [String] -> IO ()
 checkCmd opts _ = withRepository opts (check' opts)
 
-check' :: (RepoPatch p) => [DarcsFlag] -> Repository p -> IO ()
+check'
+  :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> Repository p
C(r u t) -> IO ()
 check' opts repository = do
     failed <- replayRepository repository (testByDefault opts) $ \
state -> do
       case state of
hunk ./src/Darcs/Commands/Check.lhs 111
          putInfo opts $ text "Looks like we have a difference..."
          mc <- readRecorded repository
          ftf <- filetypeFunction
-         Sealed diff <- unFreeLeft `fmap` treeDiff ftf newpris mc
+         Sealed (diff :: FL Prim C(r r2)) <- unFreeLeft `fmap` treeDiff
ftf newpris mc :: IO (Sealed (FL Prim C(r)))
          putInfo opts $ case diff of
                         NilFL -> text "Nothing"
                         patch -> text "Difference: " <+> showPatch patch
hunk ./src/witnesses.hs 21
 -- import Darcs.Commands.AmendRecord -- depends on Darcs.Commands.Record
 import Darcs.Commands.Apply
 import Darcs.Commands.Changes
--- import Darcs.Commands.Check
+import Darcs.Commands.Check
 -- import Darcs.Commands.Convert
 import Darcs.Commands.Diff
 import Darcs.Commands.Dist
[add witnesses to Darcs.Commands.Move
Ganesh Sittampalam <ganesh@earth.li>**20100210191544
 Ignore-this: c55d6910e4d79a2a8bfe47f1cdc150ad
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Commands/Move.lhs 24
 {-# LANGUAGE CPP #-}
 
 module Darcs.Commands.Move ( move, mv ) where
+import Control.Applicative ( (<$>) )
 import Control.Monad ( when, unless, zipWithM_ )
 import Data.Maybe ( catMaybes )
 import Darcs.SignalHandler ( withSignalsBlocked )
hunk ./src/Darcs/Commands/Move.lhs 42
 import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
                     slurp_pending, add_to_pending,
                   )
-import Darcs.Witnesses.Ordered ( FL(..), unsafeFL )
+import Darcs.Witnesses.Ordered ( FL(..), toFL )
+import Darcs.Witnesses.Sealed ( Sealed(..), unseal, freeGap, FreeLeft,
unFreeLeft )
 import Darcs.Global ( debugMessage )
 import qualified Darcs.Patch
 import Darcs.Patch ( RepoPatch, Prim )
hunk ./src/Darcs/Commands/Move.lhs 53
 import qualified System.FilePath.Windows as WindowsFilePath
 
 #include "impossible.h"
+#include "gadts.h"
 
 moveDescription :: String
 moveDescription = "Move or rename files."
hunk ./src/Darcs/Commands/Move.lhs 105
     cur <- slurp_pending repository
     addpatch <- check_new_and_old_filenames opts cur work (old_fp,new_fp)
     withSignalsBlocked $ do
-      case addpatch of
+      case unFreeLeft <$> addpatch of
         Nothing -> add_to_pending repository (Darcs.Patch.move old_fp
new_fp :>: NilFL)
hunk ./src/Darcs/Commands/Move.lhs 107
-        Just p -> add_to_pending repository (p :>: Darcs.Patch.move
old_fp new_fp :>: NilFL)
+        Just (Sealed p) -> add_to_pending repository (p :>:
Darcs.Patch.move old_fp new_fp :>: NilFL)
       moveFileOrDir work old_fp new_fp
 
 moveCmd opts args =
hunk ./src/Darcs/Commands/Move.lhs 117
          finaldir = last relpaths
      moveToDir repository opts moved finaldir
 
-moveToDir :: RepoPatch p => Repository p -> [DarcsFlag] -> [FilePath]
-> FilePath -> IO ()
+moveToDir :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] ->
[FilePath] -> FilePath -> IO ()
 moveToDir repository opts moved finaldir =
   let movefns = map takeFileName moved
       movetargets = map (finaldir </>) movefns
hunk ./src/Darcs/Commands/Move.lhs 121
-      movepatches = zipWith Darcs.Patch.move moved movetargets
+      movepatches = zipWith (\a b -> freeGap (Darcs.Patch.move a b))
moved movetargets
   in do
     cur <- slurp_pending repository
     work <- slurp "."
hunk ./src/Darcs/Commands/Move.lhs 127
     addpatches <- mapM (check_new_and_old_filenames opts cur work) $
zip moved movetargets
     withSignalsBlocked $ do
-      add_to_pending repository $ unsafeFL $ catMaybes addpatches ++
movepatches
+      unseal (add_to_pending repository) $ toFL $ catMaybes addpatches
++ movepatches
       zipWithM_ (moveFileOrDir work) moved movetargets
 
 check_new_and_old_filenames
hunk ./src/Darcs/Commands/Move.lhs 131
-    :: [DarcsFlag] -> Slurpy -> Slurpy -> (FilePath, FilePath) -> IO
(Maybe Prim)
+    :: [DarcsFlag] -> Slurpy -> Slurpy -> (FilePath, FilePath) -> IO
(Maybe (FreeLeft Prim))
 check_new_and_old_filenames opts cur work (old,new) = do
   unless (doAllowWindowsReserved opts || WindowsFilePath.isValid new) $
      fail $ "The filename " ++ new ++ " is not valid under Windows.\n" ++
hunk ./src/Darcs/Commands/Move.lhs 145
              when (it_has new work) $ fail $ already_exists "working
directory"
              return Nothing
      else do unless (slurp_has new work) $ fail $ doesnt_exist "working
directory"
-             return $ Just $ Darcs.Patch.addfile old
+             return (Just (freeGap (Darcs.Patch.addfile old)))
   if slurp_has old cur
      then do unless (slurp_hasdir (superName $ fp2fn new) cur) $
                     fail $ "The target directory " ++
hunk ./src/witnesses.hs 30
 -- import Darcs.Commands.Help -- depends on Darcs.TheCommands
 import Darcs.Commands.Init
 -- import Darcs.Commands.MarkConflicts
--- import Darcs.Commands.Move
+import Darcs.Commands.Move
 -- import Darcs.Commands.Optimize
 import Darcs.Commands.Pull
 import Darcs.Commands.Push
[add witnessed toFL operation
Ganesh Sittampalam <ganesh@earth.li>**20100210193104
 Ignore-this: f1585c7f0d8e15edb216b9750e591ddb
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Witnesses/Ordered.hs 38
                              reverseFL, reverseRL, (+>+), (+<+),
                              nullFL, concatFL, concatRL,
concatReverseFL, headRL,
                              MyEq, unsafeCompare, (=\/=), (=/\=),
-                             consRLSealed, nullRL,
+                             consRLSealed, nullRL, toFL,
                              unsafeCoerceP, unsafeCoerceP2
                            ) where
 
hunk ./src/Darcs/Witnesses/Ordered.hs 45
 #include "impossible.h"
 import GHC.Base (unsafeCoerce#)
 import Darcs.Witnesses.Show
-import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, Sealed2(..) )
+import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, Sealed(..),
FreeLeft, unFreeLeft, Sealed2(..) )
 
 data EqCheck C(a b) where
     IsEq :: EqCheck C(a a)
hunk ./src/Darcs/Witnesses/Ordered.hs 273
 consRLSealed :: a C(y z) -> FlippedSeal (RL a) C(y) -> FlippedSeal (RL
a) C(z)
 consRLSealed a (FlippedSeal as) = flipSeal $ a :<: as
 
+toFL :: [FreeLeft a] -> Sealed (FL a C(x))
+toFL [] = Sealed NilFL
+toFL (x:xs) = case unFreeLeft x of Sealed y -> case toFL xs of Sealed
ys -> Sealed (y :>: ys)
+
 #ifndef GADT_WITNESSES
 -- These are useful for interfacing with modules which do not yet use
type witnesses
 unsafeUnFL :: FL a -> [a]
[add witnesses to Darcs.Commands.Record
Ganesh Sittampalam <ganesh@earth.li>**20100210193209
 Ignore-this: ef01c3841210514485e13621ca5f5a12
] hunk ./src/Darcs/Commands/Record.lhs 33
 import Data.Char ( ord )
 import System.Exit ( exitWith, exitFailure, ExitCode(..) )
 import System.Directory ( doesFileExist, doesDirectoryExist, removeFile )
-import Data.Maybe ( isJust )
+import Data.Maybe ( isJust, catMaybes )
 import qualified Data.ByteString as B ( hPut )
 
 import Darcs.Lock ( readLocaleFile, writeLocaleFile,
world_readable_temp, appendToFile )
hunk ./src/Darcs/Commands/Record.lhs 37
-import Darcs.Hopefully ( info, n2pia )
+import Darcs.Hopefully ( info, n2pia, PatchInfoAnd )
 import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
                           withGutsOf,
                     read_repo,
hunk ./src/Darcs/Commands/Record.lhs 47
 import Darcs.Patch ( RepoPatch, Patch, Prim, namepatch, summary, anonymous,
                      adddeps, fromPrims )
 import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+),
-                             unsafeUnFL, unsafeCompare,
+                             unsafeCompare,
                              reverseRL, mapFL, mapFL_FL, nullFL )
hunk ./src/Darcs/Commands/Record.lhs 49
+import Darcs.Witnesses.Sealed
 import Darcs.Patch.Info ( PatchInfo )
 import Darcs.Patch.Split ( primSplitter )
 import Darcs.SlurpDirectory ( slurp_hasfile, slurp_hasdir )
hunk ./src/Darcs/Commands/Record.lhs 79
 import Printer ( hPutDocLn, text, wrap_text, ($$) )
 import ByteStringUtils ( encodeLocale )
 #include "impossible.h"
+#include "gadts.h"
 
 recordDescription :: String
 recordDescription = "Create a patch from unrecorded changes."
hunk ./src/Darcs/Commands/Record.lhs 162
                        then putStrLn "No changes in selected files or
directories!"
                        else putStrLn "No changes!"
       Just ch -> doRecord repository opts existing_files ch
-    where allow_empty_with_askdeps NilFL
+    where allow_empty_with_askdeps :: FL p C(x y) -> Maybe (FL p C(x y))
+          allow_empty_with_askdeps NilFL
               | AskDeps `elem` opts = Just NilFL
               | otherwise = Nothing
           allow_empty_with_askdeps p = Just p
hunk ./src/Darcs/Commands/Record.lhs 190
             else return ()
 
 
-doRecord :: RepoPatch p => Repository p -> [DarcsFlag] -> [SubPath] ->
FL Prim -> IO ()
+doRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag] ->
[SubPath] -> FL Prim C(r x) -> IO ()
 doRecord repository opts files ps = do
     let make_log = world_readable_temp "darcs-record"
     date <- getDate opts
hunk ./src/Darcs/Commands/Record.lhs 219
                                       -- a "partial tag" patch; see below.
               | otherwise = nullFL l
 
-doActualRecord :: RepoPatch p => Repository p -> [DarcsFlag] -> String
-> String -> String
+doActualRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag]
-> String -> String -> String
                  -> [String] -> Maybe String
hunk ./src/Darcs/Commands/Record.lhs 221
-                 -> [PatchInfo] -> FL Prim -> IO ()
+                 -> [PatchInfo] -> FL Prim C(r x) -> IO ()
 doActualRecord repository opts name date my_author my_log logf deps chs =
               do debugMessage "Writing the patch file..."
                  mypatch <- namepatch date name my_author my_log $
hunk ./src/Darcs/Commands/Record.lhs 268
 
 data PName = FlagPatchName String | PriorPatchName String | NoPatchName
 
-getLog :: [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL
Prim ->
+getLog :: FORALL(x y) [DarcsFlag] -> Maybe (String, [String]) -> IO
String -> FL Prim C(x y) ->
            IO (String, [String], Maybe String)
 getLog opts m_old make_log chs = gl opts
     where patchname_specified = patchname_helper opts
hunk ./src/Darcs/Commands/Record.lhs 369
                             $$ text ""
                             $$ text "This patch contains the following
changes:"
                             $$ text ""
-                            $$ summary (fromPrims chs :: Patch)
+                            $$ summary (fromPrims chs :: Patch C(x y))
 
 eod :: String
 eod = "***END OF DESCRIPTION***"
hunk ./src/Darcs/Commands/Record.lhs 401
 depended-upon patches.
 
 \begin{code}
-askAboutDepends :: RepoPatch p => Repository p -> FL Prim ->
[DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
+askAboutDepends :: forall p C(r u x y) . RepoPatch p => Repository p
C(r u r) -> FL Prim C(r y) -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
 askAboutDepends repository pa' opts olddeps = do
   -- ideally we'd just default the olddeps to yes but still ask about them.
   -- SelectChanges doesn't currently (17/12/09) offer a way to do this
so would
hunk ./src/Darcs/Commands/Record.lhs 408
   -- have to have this support added first.
   pps <- read_repo repository
   pa <- n2pia `fmap` anonymous (fromPrims pa')
-  let ps = (reverseRL $ headRL pps)+>+(pa:>:NilFL)
-      (pc, tps) = patchChoicesTps ps
-      tas = case filter (\tp -> pa `unsafeCompare` tpPatch tp || info
(tpPatch tp) `elem` olddeps) $ unsafeUnFL tps of
+  FlippedSeal ps <- return
+                      ((case pps of
+                          x:<:_ -> FlippedSeal ((reverseRL
x)+>+(pa:>:NilFL))
+                          NilRL -> impossible) :: FlippedSeal (FL
(PatchInfoAnd p)) C(y))
+  let (pc, tps) = patchChoicesTps ps
+      tas = case catMaybes (mapFL (\tp -> if pa `unsafeCompare`
(tpPatch tp) || info (tpPatch tp) `elem` olddeps
+                                          then Just (tag tp) else
Nothing) tps) of
                 [] -> error "askAboutDepends: []"
hunk ./src/Darcs/Commands/Record.lhs 416
-                tps' -> map tag tps'
-      ps' = mapFL_FL tpPatch $ middle_choice $ forceFirsts tas pc
+                tgs -> tgs
+  Sealed2 ps' <- return $ case getChoices (forceFirsts tas pc) of _ :>
mc :> _ -> Sealed2 $ mapFL_FL tpPatch mc
   with_selected_changes_reversed "depend on" (filter askdep_allowed
opts) Nothing ps'
              $ \(deps:>_) -> return $ olddeps `union` mapFL info deps
hunk ./src/Darcs/Commands/Record.lhs 420
- where headRL (x:<:_) = x
-       headRL NilRL = impossible
+ where
        askdep_allowed = not . patchSelectFlag
hunk ./src/Darcs/Commands/Record.lhs 422
-       middle_choice p = mc where (_ :> mc :> _) = getChoices p
 
 
 onlySuccessfulExits :: ExitCode -> Maybe ()
hunk ./src/witnesses.hs 18
 import Darcs.Repository.Internal
 -- import Darcs.Commands.Add
 import Darcs.Commands.Annotate
--- import Darcs.Commands.AmendRecord -- depends on Darcs.Commands.Record
+-- import Darcs.Commands.AmendRecord
 import Darcs.Commands.Apply
 import Darcs.Commands.Changes
 import Darcs.Commands.Check
hunk ./src/witnesses.hs 35
 import Darcs.Commands.Pull
 import Darcs.Commands.Push
 -- import Darcs.Commands.Put
--- import Darcs.Commands.Record
+import Darcs.Commands.Record
 -- import Darcs.Commands.Remove -- depends on Darcs.Commands.Add
 -- import Darcs.Commands.Repair
 -- import Darcs.Commands.Replace
[add witnesses to Darcs.Commands.Add
Ganesh Sittampalam <ganesh@earth.li>**20100210203754
 Ignore-this: dcb548d2e96b50c3cccede82e84758da
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Commands/Add.lhs 38
 import Darcs.Repository ( amInRepository, withRepoLock, ($-),
                     slurp_pending, add_to_pending )
 import Darcs.Patch ( Prim, applyToSlurpy, addfile, adddir, move )
-import Darcs.Witnesses.Ordered ( FL(..), unsafeFL, concatFL, nullFL )
+import Darcs.Witnesses.Ordered ( FL(..), (+>+), nullFL, RL(..), reverseRL )
+import Darcs.Witnesses.Sealed ( Sealed(..), unseal, Gap(..), FreeLeft,
unFreeLeft )
 import Darcs.SlurpDirectory ( Slurpy, slurp_has_anycase, slurp_has,
                         isFileReallySymlink, doesDirectoryReallyExist, 
                         doesFileReallyExist, slurp_hasdir,
hunk ./src/Darcs/Commands/Add.lhs 53
 import qualified System.FilePath.Windows as WindowsFilePath
 import Printer( text )
 
+#include "gadts.h"
+
 addDescription :: String
 addDescription = "Add one or more new files or directories."
 
hunk ./src/Darcs/Commands/Add.lhs 120
     mapM_ (putWarning fixedOpts . text . ((msg_skipping msgs ++ "
boring file ")++)) $
       flist \\ nboring flist
     date <- getIsoDateTime
-    ps <- addp msgs fixedOpts date cur $ nboring flist
+    Sealed ps <- fmap unFreeLeft $ addp msgs fixedOpts date cur $
nboring flist
     when (nullFL ps && not (null args)) $
         fail "No files were added"
     unless gotDryRun $ add_to_pending repository ps
hunk ./src/Darcs/Commands/Add.lhs 129
     msgs | gotDryRun = dryRunMessages
          | otherwise = normalMessages
 
-addp :: AddMessages -> [DarcsFlag] -> String -> Slurpy -> [FilePath] ->
IO (FL Prim)
+addp :: AddMessages -> [DarcsFlag] -> String -> Slurpy -> [FilePath] ->
IO (FreeLeft (FL Prim))
 addp msgs opts date cur0 files = do
     (ps, dups) <-
         foldr
hunk ./src/Darcs/Commands/Add.lhs 170
                         "The following files " ++ msg_are msgs ++ "
already in the repository")
        putWarning opts . text $ dupMsg ++ caseMsg
        mapM_ (putWarning opts . text) uniq_dups
-    return $ concatFL $ unsafeFL ps
+    return $ foldr (joinGap (+>+)) (emptyGap NilFL) ps
  where
hunk ./src/Darcs/Commands/Add.lhs 172
-  addp' :: Slurpy -> FilePath -> IO (Slurpy, Maybe (FL Prim), Maybe
FilePath)
+  addp' :: Slurpy -> FilePath -> IO (Slurpy, Maybe (FreeLeft (FL
Prim)), Maybe FilePath)
   addp' cur f =
     if already_has
     then return (cur, Nothing, Just f)
hunk ./src/Darcs/Commands/Add.lhs 199
                           else slurp_has_anycase f cur
             is_badfilename = not (gotAllowWindowsReserved ||
WindowsFilePath.isValid f)
             add_failure = (cur, Nothing, Nothing)
+            trypatch :: FreeLeft (FL Prim) -> IO (Slurpy, Maybe
(FreeLeft (FL Prim)), Maybe FilePath)
             trypatch p =
hunk ./src/Darcs/Commands/Add.lhs 201
-                case applyToSlurpy p cur of
+                case unseal (flip applyToSlurpy cur) (unFreeLeft p) of
                 Nothing -> do putWarning opts . text $ msg_skipping
msgs ++ " '" ++ f ++ "' ... " ++ parent_error
                               return (cur, Nothing, Nothing)
                 Just s' -> do putVerbose opts . text $ msg_adding
msgs++" '"++f++"'"
hunk ./src/Darcs/Commands/Add.lhs 213
                            else "couldn't add parent directory
'"++parentdir++
                                 "' to repository."
             myadddir d = if gotFancyMoveAdd
-                         then adddir (d++"-"++date) :>:
-                              move (d++"-"++date) d :>: NilFL
-                         else adddir d :>: NilFL
+                         then freeGap (adddir (d++"-"++date) :>:
+                                       move (d++"-"++date) d :>: NilFL)
+                         else freeGap (adddir d :>: NilFL)
             myaddfile d = if gotFancyMoveAdd
hunk ./src/Darcs/Commands/Add.lhs 217
-                          then addfile (d++"-"++date) :>:
-                               move (d++"-"++date) d :>: NilFL
-                          else addfile d :>: NilFL
+                          then freeGap (addfile (d++"-"++date) :>:
+                                        move (d++"-"++date) d :>: NilFL)
+                          else freeGap (addfile d :>: NilFL)
   gotFancyMoveAdd = FancyMoveAdd `elem` opts
   gotAllowCaseOnly = doAllowCaseOnly opts
   gotAllowWindowsReserved = doAllowWindowsReserved opts
hunk ./src/witnesses.hs 16
 import Darcs.Repository.Pristine
 import Darcs.Repository.DarcsRepo
 import Darcs.Repository.Internal
--- import Darcs.Commands.Add
+import Darcs.Commands.Add
 import Darcs.Commands.Annotate
 -- import Darcs.Commands.AmendRecord
 import Darcs.Commands.Apply
hunk ./src/witnesses.hs 36
 import Darcs.Commands.Push
 -- import Darcs.Commands.Put
 import Darcs.Commands.Record
--- import Darcs.Commands.Remove -- depends on Darcs.Commands.Add
+-- import Darcs.Commands.Remove
 -- import Darcs.Commands.Repair
 -- import Darcs.Commands.Replace
 -- import Darcs.Commands.Revert
[add witnesses to Darcs.Commands.Get
Ganesh Sittampalam <ganesh@earth.li>**20100210205723
 Ignore-this: 485a129fd292695b5b8e4f5cf714be70
] hunk ./src/Darcs/Commands/Get.lhs 51
 import qualified Darcs.Repository.DarcsRepo as DR ( read_repo )
 import Darcs.Repository ( PatchSet, SealedPatchSet, copy_oldrepo_patches,
                         createRepository)
+import Darcs.Patch.Set ( Origin )
 import Darcs.Repository.ApplyPatches ( apply_patches )
 import Darcs.Repository.Checkpoint ( write_checkpoint_patch,
get_checkpoint )
 import Darcs.Patch ( RepoPatch, Patch, apply, patch2patchinfo, invert,
hunk ./src/Darcs/Commands/Get.lhs 70
 import Printer ( text, vcat, errorDoc, ($$) )
 import Darcs.Lock ( writeBinFile )
 import Darcs.RepoPath ( toFilePath, toPath, ioAbsoluteOrRemote)
-import Darcs.Witnesses.Sealed ( Sealed(..), unsafeUnflippedseal )
+import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )
 import Darcs.Global ( darcsdir )
 import English ( englishNum, Noun(..) )
 #include "impossible.h"
hunk ./src/Darcs/Commands/Get.lhs 74
+#include "gadts.h"
 
 getDescription :: String
 getDescription = "Create a local copy of a repository."
hunk ./src/Darcs/Commands/Get.lhs 170
                         Right x -> return x
   if formatHas HashedInventory rf -- refactor this into repository
     then writeBinFile (darcsdir++"/hashed_inventory") ""
-    else write_inventory "." (NilRL:<:NilRL :: PatchSet Patch)
+    else write_inventory "." (NilRL:<:NilRL :: PatchSet Patch C(Origin
Origin))
 
   if not (null [p | OnePattern p <- opts]) -- --to-match given
      && not (Partial `elem` opts) && not (Lazy `elem` opts)
hunk ./src/Darcs/Commands/Get.lhs 278
                       then return $ Right ()
                       else return . Left $ "Context file "++toFilePath
f++" does not exist"
 
-goToChosenVersion :: RepoPatch p => Repository p
+goToChosenVersion :: RepoPatch p => Repository p C(r u r)
                      -> [DarcsFlag] -> IO ()
 goToChosenVersion repository opts =
     when (havePatchsetMatch opts) $ do
hunk ./src/Darcs/Commands/Get.lhs 285
        debugMessage "Going to specified version..."
        patches <- read_repo repository
        Sealed context <- getOnePatchset repository opts
-       let (_,us':\/:them') = get_common_and_uncommon (patches, context)
-       case them' of
+       (_,us':\/:them') <- return (get_common_and_uncommon (patches,
context))
+       (case them' of
            NilRL -> return ()
            _ -> errorDoc $ text "Missing these patches from context:"
hunk ./src/Darcs/Commands/Get.lhs 289
-                        $$ (vcat $ mapRL description them')
+                        $$ (vcat $ mapRL description them')) :: IO ()
        let ps = patchSetToPatches (us':<:NilRL)
        putInfo opts $ text $ "Unapplying " ++ (show $ lengthFL ps) ++ "
" ++
                    (englishNum (lengthFL ps) (Noun "patch") "")
hunk ./src/Darcs/Commands/Get.lhs 311
  "For modern darcs-2 repositories, --partial is a deprecated alias
for\n" ++
  "the --lazy option.\n"
 
-copyRepoOldFashioned :: RepoPatch p => Repository p -> [DarcsFlag] ->
String -> IO ()
+copyRepoOldFashioned :: RepoPatch p => Repository p C(r u t) ->
[DarcsFlag] -> String -> IO ()
 copyRepoOldFashioned repository opts repodir = do
   myname <- getCurrentDirectory
   fromrepo <- identifyRepositoryFor repository repodir
hunk ./src/Darcs/Commands/Get.lhs 322
   debugMessage "Copying patches..."
   copy_oldrepo_patches opts fromrepo "."
   debugMessage "Patches copied"
-  Sealed local_patches <- DR.read_repo opts "." :: IO (SealedPatchSet
Patch)
+  Sealed local_patches <- DR.read_repo opts "." :: IO (SealedPatchSet
Patch C(Origin))
   debugMessage "Repo read"
   repo_is_local <- doesDirectoryExist repodir
   debugMessage $ "Repo local: " ++ formatPath (show repo_is_local)
hunk ./src/Darcs/Commands/Get.lhs 343
      else do
        setCurrentDirectory myname
        if Partial `elem` opts && isJust mch
-          then let Sealed p_ch = fromJust mch
-                   pi_ch = patch2patchinfo p_ch
-                   needed_patches = reverseRL $ unsafeUnflippedseal $
-                                    get_patches_beyond_tag pi_ch
local_patches
-                   in do write_checkpoint_patch p_ch
-                         apply opts p_ch `catch`
-                             \e -> fail ("Bad checkpoint!!!\n" ++
prettyError e)
-                         apply_patches opts needed_patches
+          then do Sealed p_ch <- return (fromJust mch)
+                  let pi_ch = patch2patchinfo p_ch
+                  FlippedSeal needed_patches <- return
(get_patches_beyond_tag pi_ch local_patches)
+                  write_checkpoint_patch p_ch
+                  apply opts p_ch `catch`
+                      \e -> fail ("Bad checkpoint!!!\n" ++ prettyError e)
+                  apply_patches opts (reverseRL needed_patches)
           else apply_patches opts $ reverseRL $ concatRL local_patches
   debugMessage "Writing the pristine"
   pristine <- identifyPristine
hunk ./src/witnesses.hs 25
 -- import Darcs.Commands.Convert
 import Darcs.Commands.Diff
 import Darcs.Commands.Dist
--- import Darcs.Commands.Get
+import Darcs.Commands.Get
 import Darcs.Commands.GZCRCs
 -- import Darcs.Commands.Help -- depends on Darcs.TheCommands
 import Darcs.Commands.Init
[fix witnesses in Darcs.Commands.Remove using gaps
Ganesh Sittampalam <ganesh@earth.li>**20100210210003
 Ignore-this: 352fa85ba57dd1d1a907a42ced4324f7
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Commands/Remove.lhs 42
 import Darcs.Patch ( RepoPatch, Prim, adddir, rmdir, addfile, rmfile )
 import Darcs.Patch.FileName( fn2fp )
 import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
+import Darcs.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction )
 import Storage.Hashed.Tree( TreeItem(..), find, modifyTree, expand )
 import Storage.Hashed.AnchoredPath( anchorPath )
hunk ./src/Darcs/Commands/Remove.lhs 99
                           do recorded <- expand =<<
readRecordedAndPending repository
                              unrecorded <- readUnrecorded repository
                              ftf <- filetypeFunction
-                             mrp ftf recorded unrecorded $ map
(floatPath . fn2fp . sp2fn) files
+                             fmap unFreeLeft $ mrp ftf recorded
unrecorded $ map (floatPath . fn2fp . sp2fn) files
     where mrp ftf recorded unrecorded (f:fs) = do
             let recorded' = modifyTree recorded f Nothing
                 unrecorded' = modifyTree unrecorded f Nothing
hunk ./src/Darcs/Commands/Remove.lhs 103
-            Sealed rest <- mrp ftf recorded' unrecorded' fs
+            rest <- mrp ftf recorded' unrecorded' fs
             let f_fp = anchorPath "" f
 
hunk ./src/Darcs/Commands/Remove.lhs 106
-            case (find recorded f, find unrecorded f) of
+            local <- case (find recorded f, find unrecorded f) of
               (Just (SubTree _), Just (SubTree _)) ->
hunk ./src/Darcs/Commands/Remove.lhs 108
-                  return . Sealed $ rmdir f_fp :>: rest
+                  return $ freeGap (rmdir f_fp :>: NilFL)
               (Just (File _), Just (File _)) ->
hunk ./src/Darcs/Commands/Remove.lhs 110
-                  do Sealed diff <- unFreeLeft `fmap` treeDiff ftf
unrecorded unrecorded'
-                     return . Sealed $ diff +>+ rest
+                  treeDiff ftf unrecorded unrecorded'
               (Just (File _), _) ->
hunk ./src/Darcs/Commands/Remove.lhs 112
-                  return . Sealed $ addfile f_fp :>: rmfile f_fp :>: rest
+                  return $ freeGap (addfile f_fp :>: rmfile f_fp :>: NilFL)
               (Just (SubTree _), _) ->
hunk ./src/Darcs/Commands/Remove.lhs 114
-                  return . Sealed $ adddir f_fp :>: rmdir f_fp :>: rest
+                  return $ freeGap (adddir f_fp :>: rmdir f_fp :>: NilFL)
               (_, _) -> do putWarning opts . text $ "Can't remove " ++ f_fp
hunk ./src/Darcs/Commands/Remove.lhs 116
-                           return $ Sealed rest
+                           return rest
                             
 
hunk ./src/Darcs/Commands/Remove.lhs 119
-          mrp _ _ _ [] = return (Sealed NilFL)
+            return $ joinGap (+>+) local rest
+
+          mrp _ _ _ [] = return $ emptyGap NilFL
 
 rmDescription :: String
 rmDescription = "Help newbies find `darcs remove'."
hunk ./src/witnesses.hs 36
 import Darcs.Commands.Push
 -- import Darcs.Commands.Put
 import Darcs.Commands.Record
--- import Darcs.Commands.Remove
+import Darcs.Commands.Remove
 -- import Darcs.Commands.Repair
 -- import Darcs.Commands.Replace
 -- import Darcs.Commands.Revert
[add witnesses to Darcs.Commands.Replace
Ganesh Sittampalam <ganesh@earth.li>**20100210210633
 Ignore-this: 96da24a06dde4b3eba357230cf054c7a
] 
<
[add concept of gaps
Ganesh Sittampalam <ganesh@earth.li>**20091211010754
 Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
] 
> hunk ./src/Darcs/Commands/Replace.lhs 48
 import Darcs.Patch.Apply ( forceTokReplace )
 import Darcs.Patch.FileName( fn2fp )
 import Darcs.Patch.Patchy ( Apply )
-import Darcs.Witnesses.Ordered ( FL(..), unsafeFL, (+>+), concatFL )
-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
+import Darcs.Witnesses.Ordered ( FL(..), (+>+), concatFL, toFL )
+import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal, FreeLeft, Gap(..) )
 import Darcs.Patch.RegChars ( regChars )
 import Data.Char ( isSpace )
 import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
hunk ./src/Darcs/Commands/Replace.lhs 61
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString as BS
 #include "impossible.h"
+#include "gadts.h"
 
 replaceDescription :: String
 replaceDescription = "Substitute one word for another."
hunk ./src/Darcs/Commands/Replace.lhs 174
   work <- readUnrecorded repository
   cur <- readRecordedAndPending repository
   files <- filterM (exists work) fs
-  pswork <- concatFL . unsafeFL <$> mapM (repl toks cur work) files
+  Sealed pswork <- mapSeal concatFL . toFL <$> mapM (repl toks cur
work) files
   add_to_pending repository pswork
   applyToWorking repository opts pswork `catch` \e ->
       fail $ "Can't do replace on working!\n"
hunk ./src/Darcs/Commands/Replace.lhs 186
                               then return True
                               else do putStrLn $ skipmsg file
                                       return False
-        repl :: String -> Tree IO -> Tree IO -> SubPath -> IO (FL Prim)
+        repl :: String -> Tree IO -> Tree IO -> SubPath -> IO (FreeLeft
(FL Prim))
         repl toks cur work f =
           do work_replaced <- maybeApplyToTree replace_patch work
              cur_replaced <- maybeApplyToTree replace_patch cur
hunk ./src/Darcs/Commands/Replace.lhs 196
                         putStrLn $ "Perhaps the recorded version of
this " ++
                                    "file already contains '" ++new++"'?"
                         putStrLn $ "Use the --force option to override."
-                        return NilFL
+                        return (emptyGap NilFL)
           where f_fp = toFilePath f
                 replace_patch = tokreplace f_fp toks old new
 
hunk ./src/Darcs/Commands/Replace.lhs 200
-        get_force_replace :: SubPath -> String -> Tree IO -> IO (FL Prim)
+        get_force_replace :: SubPath -> String -> Tree IO -> IO
(FreeLeft (FL Prim))
         get_force_replace f toks tree = do
             let path = floatSubPath f
             content <- readBlob $ fromJust $ findFile tree path
hunk ./src/Darcs/Commands/Replace.lhs 208
                 tree' = modifyTree tree path (File . makeBlobBS <$>
newcontent)
             case newcontent of
               Nothing -> bug "weird forcing bug in replace."
-              Just _ -> do Sealed pfix <- unFreeLeft `fmap` treeDiff
ftf tree tree'
-                           return $ pfix +>+ (tokreplace f_fp toks old
new :>: NilFL)
+              Just _ -> do pfix <- treeDiff ftf tree tree'
+                           return $ joinGap (+>+) pfix (freeGap
(tokreplace f_fp toks old new :>: NilFL))
             where f_fp = toFilePath f
 
 replaceCmd _ _ = fail "Usage: darcs replace OLD NEW [FILES]"
hunk ./src/Darcs/Commands/Replace.lhs 217
 floatSubPath :: SubPath -> AnchoredPath
 floatSubPath = floatPath . fn2fp . sp2fn
 
-maybeApplyToTree :: Apply p => p -> Tree IO -> IO (Maybe (Tree IO))
+maybeApplyToTree :: Apply p => p C(x y) -> Tree IO -> IO (Maybe (Tree IO))
 maybeApplyToTree patch tree = catch (Just `fmap` applyToTree patch tree)
                                     (\_ -> return Nothing)
 
hunk ./src/witnesses.hs 38
 import Darcs.Commands.Record
 import Darcs.Commands.Remove
 -- import Darcs.Commands.Repair
--- import Darcs.Commands.Replace
+import Darcs.Commands.Replace
 -- import Darcs.Commands.Revert
 -- import Darcs.Commands.Rollback -- depends on Darcs.Commands.Rollback
 import Darcs.Commands.Send
[return new repo from applyToWorking
Ganesh Sittampalam <ganesh@earth.li>**20100211110410
 Ignore-this: b5aea13a912440abfe4e645f8a9c80ef
] hunk ./src/Darcs/Commands/Apply.lhs 199
     withSignalsBlocked $ do finalizeRepositoryChanges repository
                             applyToWorking repository opts pw `catch`
\(e :: SomeException) ->
                                 fail ("Error applying patch to working
dir:\n" ++ show e)
+                            return ()
     putStrLn "Finished applying..."
 
 cannotApplyMissing :: PatchInfo -> a
hunk ./src/Darcs/Commands/MarkConflicts.lhs 95
                  when (yorn /= 'y') $ exitWith ExitSuccess
                  applyToWorking repository opts (invert pend) `catch` \e ->
                     bug ("Can't undo pending changes!" ++ show e)
+                 return ()
   withSignalsBlocked $
     do add_to_pending repository res
        applyToWorking repository opts res `catch` \e ->
hunk ./src/Darcs/Commands/MarkConflicts.lhs 100
            bug ("Problem marking conflicts in mark-conflicts!" ++ show e)
+       return ()
   putStrLn "Finished marking conflicts."
 markconflictsCmd _ _ = impossible
 
hunk ./src/Darcs/Commands/Pull.lhs 161
            invalidateIndex repository
            withGutsOf repository $ do finalizeRepositoryChanges repository
                                       revertable $ applyToWorking
repository opts pw
+                                      return ()
            putInfo opts $ text "Finished pulling and applying."
 
 pullCmd _ [] = fail "No default repository to pull from, please specify
one"
hunk ./src/Darcs/Commands/Replace.lhs 180
       fail $ "Can't do replace on working!\n"
           ++ "Perhaps one of the files already contains '"++ new++"'?\n"
           ++ show e
+  return ()
   where ftf _ = TextFile
         skipmsg f = "Skipping file '" ++ toFilePath f ++ "' which isn't
in the repository."
         exists tree file = if isJust $ findFile tree (floatSubPath file)
hunk ./src/Darcs/Commands/Revert.lhs 110
                  when (Debug `elem` opts) $ putStrLn "About to apply to
the working directory."
                  applyToWorking repository opts (invert p) `catch` \e ->
                      fail ("Unable to apply inverse patch!" ++ show e)
+                 return ()
   putStrLn "Finished reverting."
 \end{code}
 
hunk ./src/Darcs/Commands/Rollback.lhs 142
               finalizeRepositoryChanges repository
               debugMessage "About to apply rolled-back changes to
working directory."
               revertable $ applyToWorking repository opts pw
+              return ()
             when (isJust logf) $ removeFile (fromJust logf)
             putStrLn "Finished rolling back."
           where revertable x = x `clarifyErrors` unlines
hunk ./src/Darcs/Commands/Unrecord.lhs 312
                                 debugMessage "Applying patches to
working directory..."
                                 applyToWorking repository opts (invert
p_after_pending) `catch` \e ->
                                     fail ("Couldn't undo patch in
working dir.\n" ++ show e)
+                                return ()
         putStrLn $ "Finished " ++ presentParticiple cmdname ++ "."
 
 matchingHead :: Patchy p => [DarcsFlag] -> PatchSet p C(Origin r)
hunk ./src/Darcs/Repository/Internal.hs 396
 unrevertUrl :: Repository p C(r u t) -> String
 unrevertUrl (Repo r _ _ (DarcsRepository _ _)) = r ++
"/"++darcsdir++"/patches/unrevert"
 
-applyToWorking :: Patchy p => Repository p1 C(r u t) -> [DarcsFlag] ->
p C(u y) -> IO ()
-applyToWorking (Repo r _ _ (DarcsRepository _ _)) opts patch =
-    withCurrentDirectory r $ if Quiet `elem` opts
-                             then runSilently $ apply opts patch
-                             else runTolerantly $ apply opts patch
+applyToWorking :: Patchy p => Repository p1 C(r u t) -> [DarcsFlag] ->
p C(u y) -> IO (Repository p1 C(r y t))
+applyToWorking (Repo r ropts rf (DarcsRepository t c)) opts patch =
+    do withCurrentDirectory r $ if Quiet `elem` opts
+                                then runSilently $ apply opts patch
+                                else runTolerantly $ apply opts patch
+       return (Repo r ropts rf (DarcsRepository t c))
 
 handle_pend_for_add :: forall p q C(r u t x y). (RepoPatch p, Effect q)
                     => Repository p C(r u t) -> q C(x y) -> IO ()
[add witnesses to Darcs.Commands.Put
Ganesh Sittampalam <ganesh@earth.li>**20100211111204
 Ignore-this: 2fa39ac0cd590d9fd6051a201605b7c6
] hunk ./src/Darcs/Commands/Put.lhs 22
 import Darcs.Repository.Format ( identifyRepoFormat,
                                  RepoProperty ( Darcs2, HashedInventory
), formatHas )
 import Darcs.Patch.Bundle ( make_bundle2 )
-import Darcs.Witnesses.Ordered ( FL(..) )
+import Darcs.Patch.Set ( PatchSet, Origin )
+import Darcs.Witnesses.Ordered ( FL(..), nullFL, EqCheck(..),
unsafeCoerceP )
 import Darcs.Match ( havePatchsetMatch, getOnePatchset )
 import Darcs.Repository.Prefs ( getPreflist, setDefaultrepo )
 import Darcs.URL ( is_url, is_file )
hunk ./src/Darcs/Commands/Put.lhs 37
 import Darcs.Witnesses.Sealed ( Sealed(..), seal )
 import Printer ( text )
 #include "impossible.h"
+#include "gadts.h"
 
 putDescription :: String 
 putDescription =
hunk ./src/Darcs/Commands/Put.lhs 101
              remoteInit req_absolute_repo_dir initopts
 
  withCurrentDirectory cur_absolute_repo_dir $
-                      withRepoReadLock opts $- \repository -> do
+                      withRepoReadLock opts $- \repository -> (do
   setDefaultrepo req_absolute_repo_dir opts
hunk ./src/Darcs/Commands/Put.lhs 103
-  Sealed patchset <- if havePatchsetMatch opts
-                     then getOnePatchset repository opts  -- todo: make
sure getOnePatchset has the right type
-                     else read_repo repository >>= (return . seal)
-  Sealed patchset2 <- if havePatchsetMatch opts
-                      then getOnePatchset repository opts  -- todo:
make sure getOnePatchset has the right type
-                      else read_repo repository >>= (return . seal)
+  let doRead = if havePatchsetMatch opts
+               then getOnePatchset repository opts  -- todo: make sure
getOnePatchset has the right type
+               else read_repo repository >>= (return . seal)
+  Sealed (patchset :: PatchSet p C(Origin x1)) <- doRead
+  Sealed (patchset2 :: PatchSet p C(Origin x2)) <- doRead
+  IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(x1 x2))
   let patches = patchSetToPatches patchset
       patches2 = patchSetToPatches patchset2
hunk ./src/Darcs/Commands/Put.lhs 111
-      nullFL NilFL = True
-      nullFL _ = False
   when (nullFL patches) $ do
           putInfo opts $ text "No patches were selected to put. Nothing
to be done."
           exitWith ExitSuccess
hunk ./src/Darcs/Commands/Put.lhs 122
   rval <- remote_apply opts req_absolute_repo_dir message
   case rval of ExitFailure ec -> do putStrLn $ "Apply failed!"
                                     exitWith (ExitFailure ec)
-               ExitSuccess -> putInfo opts $ text "Put successful."
+               ExitSuccess -> putInfo opts $ text "Put successful.") ::
IO ()
 putCmd _ _ = impossible
 
 remoteInit :: FilePath -> [DarcsFlag] -> IO ()
hunk ./src/witnesses.hs 34
 -- import Darcs.Commands.Optimize
 import Darcs.Commands.Pull
 import Darcs.Commands.Push
--- import Darcs.Commands.Put
+import Darcs.Commands.Put
 import Darcs.Commands.Record
 import Darcs.Commands.Remove
 -- import Darcs.Commands.Repair
[add witnesses to Darcs.Commands.Optimize
Ganesh Sittampalam <ganesh@earth.li>**20100211111941
 Ignore-this: c89c41e7e3a33186df876c8139b065e4
] hunk ./src/Darcs/Commands/Optimize.lhs 31
 
 import Storage.Hashed.Darcs( decodeDarcsSize )
 
-import Darcs.Hopefully ( hopefully, info )
+import Darcs.Hopefully ( hopefully, info, PatchInfoAnd )
 import Darcs.Commands ( DarcsCommand(..), nodefaults )
 import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,
                                     Compress, UnCompress,
hunk ./src/Darcs/Commands/Optimize.lhs 45
                         workingRepoDir, umaskOption, optimizePristine
                       )
 import Darcs.Repository.Prefs ( getPreflist )
-import Darcs.Repository ( Repository, PatchSet, withRepoLock, ($-),
withGutsOf,
+import Darcs.Repository ( Repository, PatchSet, SealedPatchSet,
+                          withRepoLock, ($-), withGutsOf,
                           read_repo, optimizeInventory, slurp_recorded,
                           tentativelyReplacePatches, cleanRepository,
                           amInRepository, finalizeRepositoryChanges,
replacePristine )
hunk ./src/Darcs/Commands/Optimize.lhs 50
-import Darcs.Witnesses.Ordered ( RL(..), unsafeUnRL, (+<+), mapFL_FL,
reverseRL, mapRL, concatRL )
+import Darcs.Witnesses.Ordered ( RL(..), headRL, (+<+), mapFL_FL,
reverseRL, mapRL, concatRL, EqCheck(IsEq), unsafeCoerceP )
 import Darcs.Patch.Info ( PatchInfo, just_name )
 import Darcs.Patch ( RepoPatch )
 import ByteStringUtils ( gzReadFilePS )
hunk ./src/Darcs/Commands/Optimize.lhs 63
 import Progress ( debugMessage )
 import Darcs.SlurpDirectory ( slurp, list_slurpy_files )
 import Darcs.Repository.Pristine ( identifyPristine, pristineDirectory )
-import Darcs.Witnesses.Sealed ( FlippedSeal(..), unsafeUnseal )
+import Darcs.Witnesses.Sealed ( FlippedSeal(..), mapFlipped,
Sealed(..), mapSeal )
 import Darcs.Global ( darcsdir )
 #include "impossible.h"
 -- imports for optimize --upgrade; to be tidied
hunk ./src/Darcs/Commands/Optimize.lhs 156
  "remote command needs to download.  It should also reduce the CPU
time\n" ++
  "needed for some operations.\n"
 
-doOptimizeInventory :: RepoPatch p => Repository p -> IO ()
+doOptimizeInventory :: RepoPatch p => Repository p C(r u t) -> IO ()
 doOptimizeInventory repository = do
     debugMessage "Writing out a nice copy of the inventory."
     optimizeInventory repository
hunk ./src/Darcs/Commands/Optimize.lhs 208
  "generally SHOULD NOT be used.  It results in a relatively small
space\n" ++
  "saving at the cost of making many Darcs commands MUCH slower.\n"
 
-doOptimizePristine :: RepoPatch p => Repository p -> IO ()
+doOptimizePristine :: RepoPatch p => Repository p C(r u t) -> IO ()
 doOptimizePristine repo = do
   hashed <- doesFileExist $ "_darcs" </> "hashed_inventory"
   when hashed $ do
hunk ./src/Darcs/Commands/Optimize.lhs 222
                                       readRecorded repo >>=
replacePristine repo
                                       cleanRepository repo
 
-doRelink :: RepoPatch p => [DarcsFlag] -> Repository p -> IO ()
+doRelink :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t) -> IO ()
 doRelink opts repository =
     do some_siblings <- return (flagsToSiblings opts)
        defrepolist <- getPreflist "defaultrepo"
hunk ./src/Darcs/Commands/Optimize.lhs 282
 --  "of the default optimization.  It reorders patches with respect to
ALL\n" ++
 --  "tags, rather than just the latest tag.\n"
 
-doReorder :: RepoPatch p => [DarcsFlag] -> Repository p -> IO ()
+doReorder :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO ()
 doReorder opts _ | not (Reorder `elem` opts) = return ()
 doReorder opts repository = do
     debugMessage "Reordering the inventory."
hunk ./src/Darcs/Commands/Optimize.lhs 287
     psnew <- chooseOrder `fmap` read_repo repository
-    let ps = mapFL_FL hopefully $ reverseRL $ head $ unsafeUnRL psnew
+    FlippedSeal ps <- return $ mapFlipped (mapFL_FL hopefully .
reverseRL) $ headRL psnew
     withGutsOf repository $ do tentativelyReplacePatches repository opts ps
                                finalizeRepositoryChanges repository
     debugMessage "Done reordering the inventory."
hunk ./src/Darcs/Commands/Optimize.lhs 292
 
-chooseOrder :: RepoPatch p => PatchSet p -> PatchSet p
+chooseOrder :: forall p C(s x) . RepoPatch p => PatchSet p C(s x) ->
PatchSet p C(s x)
 chooseOrder ps | isJust last_tag =
hunk ./src/Darcs/Commands/Optimize.lhs 294
-    case slightly_optimize_patchset $ unsafeUnseal $ get_patches_in_tag
lt ps of 
-    ((t:<:NilRL):<:pps) -> case get_patches_beyond_tag lt ps of
-                           FlippedSeal p -> (p+<+(t:<:NilRL)) :<: pps
+    case (mapSeal slightly_optimize_patchset $ get_patches_in_tag lt ps
:: SealedPatchSet p C(s)
+         ,get_patches_beyond_tag lt ps
+         ) of
+    (Sealed (((t :: PatchInfoAnd p C(a b)) :<:NilRL):<:pps),
FlippedSeal (p :: RL (PatchInfoAnd p) C(c x)))
+      -> case unsafeCoerceP IsEq :: EqCheck C(b c) of
+         IsEq -> (p+<+(t:<:NilRL)) :<: pps
     _ -> impossible             
     where last_tag = case filter isTag $ mapRL info $ concatRL ps of
                      (t:_) -> Just t
hunk ./src/witnesses.hs 31
 import Darcs.Commands.Init
 -- import Darcs.Commands.MarkConflicts
 import Darcs.Commands.Move
--- import Darcs.Commands.Optimize
+import Darcs.Commands.Optimize
 import Darcs.Commands.Pull
 import Darcs.Commands.Push
 import Darcs.Commands.Put
[use tentative repo in askAboutDepends
Ganesh Sittampalam <ganesh@earth.li>**20100211113157
 Ignore-this: d1937b4194d0a5e32fd543ebb7139457
] hunk ./src/Darcs/Commands/Record.lhs 40
 import Darcs.Hopefully ( info, n2pia, PatchInfoAnd )
 import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
                           withGutsOf,
-                    read_repo,
+                    readTentativeRepo,
                     slurp_recorded,
                     tentativelyAddPatch, finalizeRepositoryChanges
                         , invalidateIndex, unrecordedChanges )
hunk ./src/Darcs/Commands/Record.lhs 401
 depended-upon patches.
 
 \begin{code}
-askAboutDepends :: forall p C(r u x y) . RepoPatch p => Repository p
C(r u r) -> FL Prim C(r y) -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
+askAboutDepends :: forall p C(r u t x y) . RepoPatch p => Repository p
C(r u t) -> FL Prim C(t y) -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
 askAboutDepends repository pa' opts olddeps = do
   -- ideally we'd just default the olddeps to yes but still ask about them.
   -- SelectChanges doesn't currently (17/12/09) offer a way to do this
so would
hunk ./src/Darcs/Commands/Record.lhs 406
   -- have to have this support added first.
-  pps <- read_repo repository
+  pps <- readTentativeRepo repository
   pa <- n2pia `fmap` anonymous (fromPrims pa')
   FlippedSeal ps <- return
                       ((case pps of
hunk ./src/Darcs/Repository.hs 31
     , amNotInRepository, slurp_pending, replacePristine, slurp_recorded
     , slurp_recorded_and_unrecorded, withRecorded, read_repo, prefsUrl
     , add_to_pending, tentativelyAddPatch, tentativelyRemovePatches
-    , tentativelyAddToPending, tentativelyReplacePatches
+    , tentativelyAddToPending, tentativelyReplacePatches, readTentativeRepo
     , tentativelyMergePatches, considerMergeToWorking,
revertRepositoryChanges
     , finalizeRepositoryChanges, createRepository, copyRepository
     , copy_oldrepo_patches, patchSetToRepository, unrevertUrl,
applyToWorking
hunk ./src/Darcs/Repository.hs 60
      slurp_pending,
      slurp_recorded, slurp_recorded_and_unrecorded,
      withRecorded,
-     read_repo,
+     read_repo, readTentativeRepo,
      prefsUrl,
      withRepoLock, withRepoReadLock, withRepository,
withRepositoryDirectory, withGutsOf,
      tentativelyAddPatch, tentativelyRemovePatches,
tentativelyAddToPending,
hunk ./src/Darcs/Repository/Internal.hs 32
                     announce_merge_conflicts, setTentativePending,
                     check_unrecorded_conflicts,
                     withRecorded,
-                    read_repo,
+                    read_repo, readTentativeRepo,
                     prefsUrl, makePatchLazy,
                     withRepoLock, withRepoReadLock,
                     withRepository, withRepositoryDirectory, withGutsOf,
[add witnesses to Darcs.Commands.AmendRecord
Ganesh Sittampalam <ganesh@earth.li>**20100211113324
 Ignore-this: 8e4866806ec8fd82ee57e8385fd7bc12
] hunk ./src/Darcs/Commands/AmendRecord.lhs 62
                       )
 import Darcs.Utils ( askUser, clarifyErrors )
 import Printer ( putDocLn )
+#include "gadts.h"
 
 amendrecordDescription :: String
 amendrecordDescription =
hunk ./src/Darcs/Commands/AmendRecord.lhs 125
 
 amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()
 amendrecordCmd opts args =
-    withRepoLock (testByDefault opts) $- \repository -> do
+    withRepoLock (testByDefault opts) $- \(repository :: Repository p
C(r u r)) -> do
     files  <- sort `fmap` fixSubPaths opts args
     when (areFileArgs files) $
          putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
hunk ./src/Darcs/Commands/AmendRecord.lhs 131
     with_selected_patch_from_repo "amend" repository opts $ \ (_ :>
oldp) -> do
         ch <- unrecordedChanges opts repository files
-        case ch of
-          NilFL | not (hasEditMetadata opts) -> putStrLn "No changes!"
-          _ ->
+
+        let handleChanges :: FL Prim C(r y) -> IO ()
+            handleChanges NilFL | not (hasEditMetadata opts) = putStrLn
"No changes!"
+            handleChanges ch =
                with_selected_changes_to_files' "add" (filter (==All)
opts) (Just primSplitter)
                 (map toFilePath files) ch $ addChangesToPatch opts
repository oldp
hunk ./src/Darcs/Commands/AmendRecord.lhs 137
+        handleChanges ch
 
hunk ./src/Darcs/Commands/AmendRecord.lhs 139
-addChangesToPatch :: forall t p . (RepoPatch p) => [DarcsFlag] ->
Repository p -> PatchInfoAnd p
-                  -> (FL Prim :> t) -> IO ()
+addChangesToPatch :: forall p C(r u t x y) . (RepoPatch p)
+                  => [DarcsFlag] -> Repository p C(r u t) ->
PatchInfoAnd p C(x t)
+                  -> (FL Prim :> FL Prim) C(t y) -> IO ()
 addChangesToPatch opts repository oldp (chs:>_) =    
                   if (nullFL chs && not (hasEditMetadata opts))
                   then putStrLn "You don't want to record anything!"
hunk ./src/Darcs/Commands/AmendRecord.lhs 146
                   else do
-                       (mlogf, newp) <- updatePatchHeader opts
repository oldp chs
-                       defineChanges newp
                        invalidateIndex repository
                        withGutsOf repository $ do
hunk ./src/Darcs/Commands/AmendRecord.lhs 148
-                         tentativelyRemovePatches repository opts
(hopefully oldp :>: NilFL)
-                         tentativelyAddPatch repository opts newp
+                         repository' <- tentativelyRemovePatches
repository opts (hopefully oldp :>: NilFL)
+                         (mlogf, newp) <- updatePatchHeader opts
repository' oldp chs
+                         defineChanges newp
+                         repository'' <- tentativelyAddPatch
repository' opts newp
                          let failmsg = maybe "" (\lf -> "\nLogfile left
in "++lf++".") mlogf
hunk ./src/Darcs/Commands/AmendRecord.lhs 153
-                         finalizeRepositoryChanges repository
`clarifyErrors` failmsg
-                       maybe (return ()) removeFile mlogf
-                       putStrLn "Finished amending patch:"
-                       putDocLn $ description newp
+                         finalizeRepositoryChanges repository''
`clarifyErrors` failmsg
+                         maybe (return ()) removeFile mlogf
+                         putStrLn "Finished amending patch:"
+                         putDocLn $ description newp
 
hunk ./src/Darcs/Commands/AmendRecord.lhs 158
-updatePatchHeader :: forall p. (RepoPatch p) => [DarcsFlag] ->
Repository p -> PatchInfoAnd p -> FL Prim
-                  -> IO (Maybe String, PatchInfoAnd p)
+updatePatchHeader :: forall p C(x y r u t) . (RepoPatch p)
+                  => [DarcsFlag] -> Repository p C(r u t)
+                  -> PatchInfoAnd p C(t x) -> FL Prim C(x y)
+                  -> IO (Maybe String, PatchInfoAnd p C(t y))
 updatePatchHeader opts repository oldp chs = do
 
                        let newchs = canonizeFL (effect oldp +>+ chs)
hunk ./src/witnesses.hs 18
 import Darcs.Repository.Internal
 import Darcs.Commands.Add
 import Darcs.Commands.Annotate
--- import Darcs.Commands.AmendRecord
+import Darcs.Commands.AmendRecord
 import Darcs.Commands.Apply
 import Darcs.Commands.Changes
 import Darcs.Commands.Check
[add witnesses to Darcs.Commands.Revert
Ganesh Sittampalam <ganesh@earth.li>**20100211113418
 Ignore-this: 8c04a7f6c4f43e21b43235e2cff49901
] hunk ./src/Darcs/Commands/Revert.lhs 46
 import Darcs.SelectChanges ( with_selected_last_changes_to_files' )
 import Darcs.Patch.TouchesFiles ( choose_touching )
 import Darcs.Commands.Unrevert ( writeUnrevert )
-import Darcs.Witnesses.Sealed ( unsafeUnseal )
+import Darcs.Witnesses.Sealed ( Sealed(..) )
+
+#include "gadts.h"
 
 revertDescription :: String
 revertDescription = "Discard unrecorded changes."
hunk ./src/Darcs/Commands/Revert.lhs 89
   changes <- unrecordedChanges opts repository files
   let pre_changed_files = applyToFilepaths (invert changes) (map
toFilePath files)
   rec <- readRecorded repository
-  case unsafeUnseal $ choose_touching pre_changed_files changes of
+  Sealed touching_changes <- return (choose_touching pre_changed_files
changes)
+  (case touching_changes of
     NilFL -> putStrLn "There are no changes to revert!"
     _ -> with_selected_last_changes_to_files' "revert" opts Nothing
                pre_changed_files changes $ \ (norevert:>p) ->
hunk ./src/Darcs/Commands/Revert.lhs 113
                  when (Debug `elem` opts) $ putStrLn "About to apply to
the working directory."
                  applyToWorking repository opts (invert p) `catch` \e ->
                      fail ("Unable to apply inverse patch!" ++ show e)
-                 return ()
+                 return ()) :: IO ()
   putStrLn "Finished reverting."
 \end{code}
 
hunk ./src/witnesses.hs 39
 import Darcs.Commands.Remove
 -- import Darcs.Commands.Repair
 import Darcs.Commands.Replace
--- import Darcs.Commands.Revert
+import Darcs.Commands.Revert
 -- import Darcs.Commands.Rollback -- depends on Darcs.Commands.Rollback
 import Darcs.Commands.Send
 import Darcs.Commands.SetPref
[add witnesses to Darcs.Commands.MarkConflicts
Ganesh Sittampalam <ganesh@earth.li>**20100211113510
 Ignore-this: 6ab56b2f81bf05be63b1ea68f90604f9
] hunk ./src/Darcs/Commands/MarkConflicts.lhs 32
 import Darcs.Arguments ( DarcsFlag, ignoretimes, workingRepoDir,
umaskOption )
 import Darcs.Repository ( withRepoLock, ($-), amInRepository,
add_to_pending,
                     applyToWorking,
-                    read_repo, unrecordedChanges
+                    read_repo, unrecordedChanges, Repository
                     )
hunk ./src/Darcs/Commands/MarkConflicts.lhs 34
-import Darcs.Patch ( invert )
+import Darcs.Patch ( invert, Prim )
 import Darcs.Witnesses.Ordered ( FL(..) )
 import Darcs.Witnesses.Sealed ( Sealed(Sealed) )
 import Darcs.Resolution ( patchset_conflict_resolutions )
hunk ./src/Darcs/Commands/MarkConflicts.lhs 40
 import Darcs.Utils ( promptYorn )
 #include "impossible.h"
+#include "gadts.h"
 
 markconflictsDescription :: String
 markconflictsDescription =
hunk ./src/Darcs/Commands/MarkConflicts.lhs 81
                                                       workingRepoDir]}
 
 markconflictsCmd :: [DarcsFlag] -> [String] -> IO ()
-markconflictsCmd opts [] = withRepoLock opts $- \repository -> do
+markconflictsCmd opts [] = withRepoLock opts $- \(repository ::
Repository p C(r u r)) -> do
   pend <- unrecordedChanges opts repository []
   r <- read_repo repository
   Sealed res <- return $ patchset_conflict_resolutions r
hunk ./src/Darcs/Commands/MarkConflicts.lhs 85
-  case res of NilFL -> do putStrLn "No conflicts to mark."
-                          exitWith ExitSuccess
-              _ -> return ()
-  case pend of
-    NilFL -> return ()
-    _ ->      do putStrLn ("This will trash any unrecorded changes"++
+  (case res of NilFL -> do putStrLn "No conflicts to mark."
+                           exitWith ExitSuccess
+               _ -> return ()) :: IO ()
+  let undoUnrec :: FL Prim C(r u) -> IO (Repository p C(r r r))
+      undoUnrec NilFL = return repository
+      undoUnrec pend =
+              do putStrLn ("This will trash any unrecorded changes"++
                           " in the working directory.")
                  yorn <- promptYorn "Are you sure? "
                  when (yorn /= 'y') $ exitWith ExitSuccess
hunk ./src/Darcs/Commands/MarkConflicts.lhs 97
                  applyToWorking repository opts (invert pend) `catch` \e ->
                     bug ("Can't undo pending changes!" ++ show e)
-                 return ()
+  repository' <- undoUnrec pend
   withSignalsBlocked $
hunk ./src/Darcs/Commands/MarkConflicts.lhs 99
-    do add_to_pending repository res
-       applyToWorking repository opts res `catch` \e ->
+    do add_to_pending repository' res
+       applyToWorking repository' opts res `catch` \e ->
            bug ("Problem marking conflicts in mark-conflicts!" ++ show e)
        return ()
   putStrLn "Finished marking conflicts."
hunk ./src/witnesses.hs 29
 import Darcs.Commands.GZCRCs
 -- import Darcs.Commands.Help -- depends on Darcs.TheCommands
 import Darcs.Commands.Init
--- import Darcs.Commands.MarkConflicts
+import Darcs.Commands.MarkConflicts
 import Darcs.Commands.Move
 import Darcs.Commands.Optimize
 import Darcs.Commands.Pull
[add witnesses to Darcs.Commands.Convert
Ganesh Sittampalam <ganesh@earth.li>**20100211181613
 Ignore-this: c248f20a43b06b92b45c3c01ddbd93f9
] hunk ./src/Darcs/Commands/Convert.lhs 54
                      adddeps, getdeps, effect, flattenFL, isMerger,
patchcontents )
 import Darcs.Witnesses.Ordered ( FL(..), RL(..), EqCheck(..), (=/\=),
bunchFL, mapFL, mapFL_FL,
                              concatFL, concatRL, mapRL )
-import Darcs.Patch.Info ( pi_rename, pi_tag, is_tag )
+import Darcs.Patch.Info ( pi_rename, pi_tag, is_tag, PatchInfo )
 import Darcs.Patch.Commute ( public_unravel )
 import Darcs.Patch.Real ( mergeUnravelled )
hunk ./src/Darcs/Commands/Convert.lhs 57
+import Darcs.Patch.Set ( PatchSet )
 import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )
 import Darcs.Repository.Format(identifyRepoFormat, formatHas,
RepoProperty(Darcs2))
 import Darcs.Repository.Motd ( show_motd )
hunk ./src/Darcs/Commands/Convert.lhs 72
 import qualified Data.ByteString as B (isPrefixOf, readFile)
 import qualified Data.ByteString.Char8 as BC (pack)
 
+#include "gadts.h"
+
 convertDescription :: String
 convertDescription = "Convert a repository from a legacy format."
 
hunk ./src/Darcs/Commands/Convert.lhs 165
       -- "universal" functions to do the conversion, but that's also
       -- unsatisfying.
 
-      let repository = unsafeCoerce# repositoryfoo :: Repository (FL
RealPatch)
-          themrepo = unsafeCoerce# themrepobar :: Repository Patch
+      let repository = unsafeCoerce# repositoryfoo :: Repository (FL
RealPatch) C(r u t)
+          themrepo = unsafeCoerce# themrepobar :: Repository Patch C(r u t)
       theirstuff <- read_repo themrepo
       let patches = mapFL_FL convertNamed $ patchSetToPatches theirstuff
           inOrderTags = iot theirstuff
hunk ./src/Darcs/Commands/Convert.lhs 170
-              where iot ((t:<:NilRL):<:r) = info t : iot r
+              where iot :: PatchSet p C(s x) -> [PatchInfo]
+                    iot ((t:<:NilRL):<:r) = info t : iot r
                     iot (NilRL:<:r) = iot r
                     iot NilRL = []
                     iot ((_:<:x):<:y) = iot (x:<:y)
hunk ./src/Darcs/Commands/Convert.lhs 182
           fixDep p = case lookup p outOfOrderTags of
                      Just d -> p : concatMap fixDep d
                      Nothing -> [p]
-          convertOne :: Patch -> FL RealPatch
+          convertOne :: Patch C(x y) -> FL RealPatch C(x y)
           convertOne x | isMerger x = case mergeUnravelled $
public_unravel $ modernizePatch x of
                                        Just (FlippedSeal y) ->
                                            case effect y =/\= effect x of
hunk ./src/Darcs/Commands/Convert.lhs 199
                                      NilFL -> NilFL
                                      (x':>:NilFL) -> fromPrims $ effect x'
                                      xs -> concatFL $ mapFL_FL
convertOne xs
-          convertNamed :: Named Patch -> PatchInfoAnd (FL RealPatch)
+          convertNamed :: Named Patch C(x y) -> PatchInfoAnd (FL
RealPatch) C(x y)
           convertNamed n = n2pia $
                            adddeps (infopatch (convertInfo $
patch2patchinfo n) $
                                               convertOne $ patchcontents n)
hunk ./src/witnesses.hs 22
 import Darcs.Commands.Apply
 import Darcs.Commands.Changes
 import Darcs.Commands.Check
--- import Darcs.Commands.Convert
+import Darcs.Commands.Convert
 import Darcs.Commands.Diff
 import Darcs.Commands.Dist
 import Darcs.Commands.Get
[add witnesses to Darcs.Commands.Rollback
Ganesh Sittampalam <ganesh@earth.li>**20100211184435
 Ignore-this: 160f72201755ce5b42ac23ade377fccd
] hunk ./src/Darcs/Commands/Rollback.lhs 63
 import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )
 import IsoDate ( getIsoDateTime )
 #include "impossible.h"
+#include "gadts.h"
 
 rollbackDescription :: String
 rollbackDescription =
hunk ./src/Darcs/Commands/Rollback.lhs 121
                (rollItBackNow opts repository ps)
 
 rollItBackNow :: (RepoPatch p1, RepoPatch p) =>
-                [DarcsFlag] -> Repository p1 ->  FL (PatchInfoAnd p)
-                            -> (t :> FL Prim) -> IO ()
+                [DarcsFlag] -> Repository p1 C(r u t) ->  FL
(PatchInfoAnd p) C(x y)
+                            -> (q :> FL Prim) C(a t) -> IO ()
 rollItBackNow opts repository  ps (_ :> ps'') =
          do when (nullFL ps'') $ do putStrLn "No changes selected!"
                                     exitWith ExitSuccess
hunk ./src/witnesses.hs 40
 -- import Darcs.Commands.Repair
 import Darcs.Commands.Replace
 import Darcs.Commands.Revert
--- import Darcs.Commands.Rollback -- depends on Darcs.Commands.Rollback
+import Darcs.Commands.Rollback
 import Darcs.Commands.Send
 import Darcs.Commands.SetPref
 import Darcs.Commands.Show
[everything now compiles with witnesses
Ganesh Sittampalam <ganesh@earth.li>**20100211184608
 Ignore-this: 78389082d81bcf4d56b6ca17c83a9344
 Note that because of some bits of conditional compilation, this doesn't
 mean we can turn witnesses on for the real build yet.
 
] hunk ./src/witnesses.hs 2
 import Version
--- import Preproc -- imports Darcs.Commands.Help
--- import Darcs.ArgumentDefaults -- imports Darcs.Commands.Help
+import Preproc
+import Darcs.ArgumentDefaults
 import Darcs.Patch.Real
 import Darcs.Patch.Properties
 import Darcs.Patch.Bundle
hunk ./src/witnesses.hs 27
 import Darcs.Commands.Dist
 import Darcs.Commands.Get
 import Darcs.Commands.GZCRCs
--- import Darcs.Commands.Help -- depends on Darcs.TheCommands
+import Darcs.Commands.Help
 import Darcs.Commands.Init
 import Darcs.Commands.MarkConflicts
 import Darcs.Commands.Move
hunk ./src/witnesses.hs 37
 import Darcs.Commands.Put
 import Darcs.Commands.Record
 import Darcs.Commands.Remove
--- import Darcs.Commands.Repair
+import Darcs.Commands.Repair
 import Darcs.Commands.Replace
 import Darcs.Commands.Revert
 import Darcs.Commands.Rollback
hunk ./src/witnesses.hs 44
 import Darcs.Commands.Send
 import Darcs.Commands.SetPref
 import Darcs.Commands.Show
--- import Darcs.Commands.Tag -- depends on Darcs.Commands.Tag
+import Darcs.Commands.Tag
 import Darcs.Commands.TrackDown
 import Darcs.Commands.TransferMode
 import Darcs.Commands.Unrevert
hunk ./src/witnesses.hs 51
 import Darcs.Commands.Unrecord
 import Darcs.Commands.WhatsNew
 
--- import Darcs.RunCommand -- imports Darcs.Commands.Help
--- import Darcs.TheCommands -- pulls in all other commands
+import Darcs.RunCommand
+import Darcs.TheCommands
 
 main = return ()

On Tue, 23 Feb 2010, Jason Dagit wrote:

> See below for my comments.

Thanks!

> I only made it about 40% of the way through before I had to start
> skimming.  The amount of stuff to look at is quite big.  My emacs buffer
> claims to have over 2500 lines.

I guess my hope is that the patches do stand alone reasonably well, so can 
be reviewed and applied one at a time. Please don't feel pressured into 
applying anything that you're not happy with, though.

> The introduction of the new Gap stuff is hard for me to review because
> it's new to me and I don't understand it.  That's really the only thing
> that would make me want to reject this patch.  If I understood it
> better, perhaps I wouldn't feel so uneasy about it.
>
> Maybe someone else can take a stab at it?

I think more eyes on the Gap stuff in particular would definitely be very 
helpful.

First one general comment on a recurring theme:

I believe the general change from 'recorded' to 'tentative' is a 
correctness fix, in that the witnesses were previously incorrect, but this 
wasn't picked up because the repository witnesses were not updated as 
things changed.

As you say, there's a transaction going on here. 'tentative' starts out 
the same as 'recorded', but as we modify it, all further modifications are 
also written to the tentative state, as if it were the real recorded 
state. If I recall correctly, I was simply unable to make some complicated 
multi-stage operations typecheck without this fix.

> check_unrecorded_conflicts opts _ | NoUpdateWorking `elem` opts =
> return False
> check_unrecorded_conflicts opts pc =
>     do repository <- identifyDarcs1Repository opts "."
> hunk ./src/Darcs/Repository/Internal.hs 472
>        cuc repository
>     where cuc :: Repository Patch C(r u t) -> IO Bool
> -          cuc r = do Sealed mpend <- read_pending r :: IO (Sealed (FL
> Prim C(r)))
> +          cuc r = do Sealed mpend <- read_pending r :: IO (Sealed (FL
> Prim C(t)))
>
> If the pending is to represent the current "transaction" then this
> change makes sense to me aswell.

> hunk ./src/Darcs/Repository/LowLevel.hs 38
> pendingName :: RepoType p -> String
> pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending"
>
> -read_pending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL
> Prim C(r)))
> +read_pending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL
> Prim C(t)))
>
> Pending returns the tentative state.  Makes sense.
>
> read_pending (Repo r _ _ tp) =
>     withCurrentDirectory r (read_pendingfile (pendingName tp))

Hmm. Looking at the code for read_pending, this is actually fishy, because 
it refers to _darcs/patches/pending, not _darcs/patches/pending.tentative.

My witnesses work shouldn't change any behaviour, so if this really is 
wrong it isn't a new bug, but it's one that witnesses should possibly have 
caught downstream if primitive operations like this were "correct".

Reading the code some more, I'm now just confused about what's going on 
with "pending" and "pending.tentative". I think that perhaps the issue is 
that, as the comments already pointed out, we don't track pending state in 
witnesses, so it's all just a mess. I think perhaps this issue is 
something to be returned to in future - perhaps some more witnesses could 
untangle what's going on, and the cost of yet longer type signatures.

> hunk ./src/Darcs/Repository/Internal.hs 588
>
> tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p =>
> Repository p C(r u t) -> [DarcsFlag]
>                           -> FL (Named p) C(x t) -> IO ()
> -tentativelyReplacePatches repository@(Repo x y z w) opts ps =
> -    -- tentativelyRemovePatches_ leaves the repository in state C(x u t)
> -    do tentativelyRemovePatches_ DontUpdatePristine repository opts ps
> -       -- Now we add the patches back so that the repo again has state
> C(r u t)
> -       sequence_ $ mapAdd ((Repo x y z w) :: Repository p C(x u t)) ps
> -  where mapAdd :: Repository p C(i l m) -> FL (Named p) C(i j) -> [IO ()]
> +tentativelyReplacePatches repository opts ps =
> +    do repository' <- tentativelyRemovePatches_ DontUpdatePristine
> repository opts ps
> +       sequence_ $ mapAdd repository' ps
> +  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> [IO ()]
>
> The reordering of witnesses (i l m) to (m l i) here looks suspicious.
> What is the reason?

The old code matched the recorded state against the initial state of the 
FL. The new code does the same with the tentative state, and otherwise 
leaves the witnesses unchanged.

Happy to use other names instead, but C(i l m) ... C(m j) looks worse to 
me than what I did do.

> Is it too bothersome to ask that you put the comments back in?

The comment as originally there is wrong for the new code because the 
witnesses have changed. I also found it confusing with respect to the old 
code because it really documented what we thought the witnesses should be, 
rather than what they actually were - the rebuilding of the Repository 
reflected the fact that they needed coercing to the 'correct' ones.

I could put something similar back, though IMO it doesn't add much given 
that the witnesses are now actually correct and don't need hacking, so the 
types explain it all.

> tentativelyReplacePatches repository opts ps =
>     do repository' <- tentativelyRemovePatches_ DontUpdatePristine
> repository opts ps
> hunk ./src/Darcs/Repository/Internal.hs 591
> -       sequence_ $ mapAdd repository' ps
> -  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> [IO ()]
> -        mapAdd _ NilFL = []
> -        mapAdd r@(Repo dir df rf dr) (a:>:as) =
> -               -- we construct a new Repository object on the recursive
> case so that the
> -               -- recordedstate of the repository can match the fact
> that we just wrote a patch
> -               tentativelyAddPatch_ DontUpdatePristine r opts (n2pia a)
> : mapAdd (Repo dir df rf dr) as
> +       mapAdd repository' ps
> +  where mapAdd :: Repository p C(m l i) -> FL (Named p) C(i j) -> IO
> (Repository p C(m l j))
> +        mapAdd r NilFL = return r
> +        mapAdd r (a:>:as) =
> +               do r' <- tentativelyAddPatch_ DontUpdatePristine r opts
> (n2pia a)
> +                  mapAdd r' as
>
> It seems that the m l i vs. i l m stuff has something to do with the r
> vs. t changes.  If I buy the later change, then it seems like I sohuld
> go for this change as well.  Hmm...

Yeah, as per my explanation above.

>
>
> finalize_pending :: RepoPatch p => Repository p C(r u t) -> IO ()
> finalize_pending (Repo dir opts _ rt)
> hunk ./src/Darcs/Repository/Merge.hs 90
>              doChanges usi
>              setTentativePending r (effect pend' +>+ pw_resolution)
>      return $ seal (effect pwprim +>+ pw_resolution)
> -  where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
> -> [IO ()]
> -        mapAdd _ NilFL = []
> -        mapAdd r'@(Repo dir df rf dr) (a:>:as) =
> -               -- we construct a new Repository object on the recursive
> case so that the
> -               -- recordedstate of the repository can match the fact
> that we just wrote a patch
> -               tentativelyAddPatch_ DontUpdatePristine r' opts a :
> mapAdd (Repo dir df rf dr) as
> +  where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
> -> IO (Repository p C(m l j))
> +        mapAdd repo NilFL = return repo
> +        mapAdd repo (a:>:as) =
> +               do repo' <- tentativelyAddPatch_ DontUpdatePristine repo
> opts a
> +                  mapAdd repo' as
>
> Same change as above, but any reason to not include the comment?

Again, I viewed as explaining the hack that was needed to work around the 
incorrect witnesses. The hack is now gone (or at least moved to the more 
primitive operations).

>
>         applyps :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j)
> -> IO ()
>         applyps repo ps = do debugMessage "Adding patches to inventory..."
> hunk ./src/Darcs/Repository/Merge.hs 97
> -                             sequence_ $ mapAdd repo ps
> +                             mapAdd repo ps
>
> Looks like the sequence is now absorbed into the locally defined
> mapAdd.  Not really sure why, but I won't contest the point :)

The type of sequence_ is wrong for the new type of mapAdd. I could have 
used foldM or similar but I find explicit recursion clearer in many 
cases like this one.


>                              debugMessage "Applying patches to pristine..."
>                              applyToTentativePristine repo ps
>
> [add concept of gaps
> Ganesh Sittampalam <ganesh@earth.li>**20091211010754
> Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
> ] hunk ./src/Darcs/Witnesses/Sealed.hs 1
> --- Copyright (C) 2007 David Roundy
> +-- Copyright (C) 2007 David Roundy, 2009 Ganesh Sittampalam
>
> While you're at it, my name could be there too :)

Probably best as a separate patch.

BTW the reason I bothered there is that I added a substantial chunk of 
code and it ties in with my BSD-dedication for my contributions. Normally 
keeping copyright notices up to date is a losing battle, I think :-)

> +newtype Poly a = Poly { unPoly :: FORALL(x) a C(x) }
>
> Polymorphic?

Yeah.


> +
> +newtype Stepped f a C(x) = Stepped { unStepped :: f (a C(x)) }
>
> What does stepped mean?

It's sort of moving things sidewise. It's not a good name, but I couldn't 
think of a better one.

> Now I'm confused :)  These wrappers confuse me.
> [...]
> What is a gap?
> [...]
> This code is very abstract :)
>
> [...]
> Makes more sense with the haddocks.  Thanks for adding those.

As I said in my submission email, I'm aware that this is a confusing area. 
If you can ask some more specific questions in light of the haddock, I can 
try to improve the docs.

> unrecordedChanges opts repo paths = do
>   (all_current, _) <- readPending repo
> hunk ./src/Darcs/Repository/State.hs 135
> -  Sealed pending <- pendingChanges repo paths
> +  Sealed (pending :: FL Prim C(t x)) <- pendingChanges repo paths
>
> Making things explicit.
>
>   relevant <- restrictSubpaths repo paths
>   let getIndex = I.updateIndex =<< (relevant <$> readIndex repo)
> hunk ./src/Darcs/Repository/State.hs 153
>                  return $ if ignoretimes then plain else plain
> `overlay` index
>
>   ft <- filetypeFunction
> -  diff <- treeDiff ft current working
> +  Sealed (diff :: FL Prim C(x y)) <- (unFreeLeft `fmap` treeDiff ft
> current working) :: IO (Sealed (FL Prim C(x)))
>
> Wow.  Hmm...Probably just making it more explicit.

Just persuading the type-checker to accept my code. I wouldn't write those 
signatures for fun!

>   Sealed (diff :: FL Prim C(x y)) <- (unFreeLeft `fmap` treeDiff ft current working) :: IO (Sealed (FL Prim C(x)))
> +  IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(y u))
>
> You're unsafeCoercing an EqCheck?  You're telling the type checker
> that y = u from now on?  I'm sure you have a good reason, so please
> explain.

Yeah, this needs documenting. This is a key "assertion" step required by 
the way we model repositories and by the way I've chosen to deal with 
freshly constructed patches.

Our approach is to say that we *know* what the unrecorded state of the 
repo is when we build one - that's why the 'u' variable is existential (or 
rather that all the functions passed to withRepository etc have to be 
polymorphic in 'u', which amounts to the same thing).

I'm now also saying that a freshly constructed patch has one end sealed 
and the other end free. So if it's a diff against recorded, then we can 
say that the free end is unified with 'r'. But that leaves the other end 
sealed, but we know because of what we just diffed that it must actually 
be 'u'. So we have to assert it.

There's actually another level of dodginess here, in that the caller can 
restrict the scope of the diff by passing in a list of subpaths. So two 
successive calls to unrecordedChanges could be used to construct two diffs 
that are both C(r u), and then you could "prove" that two different states 
are equal. I can sort of see this happening by accident, but I hope it's 
unlikely, and I can't see any nice way to guard against it.

> +
> +-- This is actually unsafe if we ever commute patches and then compare them
> +-- using this function. TODO: consider adding an extra existential to
> WPatchInfo
> +-- (as with TaggedPatch in Darcs.Patch.Choices)
> +compareWPatchInfo :: WPatchInfo C(a b) -> WPatchInfo C(c d) -> EqCheck
> C((a, b) (c, d))
> +compareWPatchInfo (WPatchInfo x) (WPatchInfo y) = if x == y then
> unsafeCoerceP IsEq else NotEq
>
> Should the above TODO be in the bug tracker or somewhere else?  Does it
> need doing?

It would be nice to do it, yes. It needs some infrastructure for a new 
kind of witnesses lists though. I don't know if we want to track wishlist 
code improvements on the bugtracker or not - grepping for TODO seems 
reasonable too.

> hunk ./src/Darcs/Repository/Repair.hs 59
> -replaceInFL :: FL (PatchInfoAnd a)
> -            -> [(PatchInfo, PatchInfoAnd a)]
> -            -> FL (PatchInfoAnd a)
> +replaceInFL :: FL (PatchInfoAnd a) C(x y)
> +            -> [Sealed2 (WPatchInfo :||: PatchInfoAnd a)]
>
> When was :||: introduced?

A few months ago by my hunk editing work. I used it in doing substitution 
on TaggedPatch - there's quite a similar pattern between the two chunks of 
code, in fact. Perhaps some abstraction is possible.

Cheers,

Ganesh

Ganesh,

I'm ready to apply these patches now, but when I try to apply them I get conflicts.  I'm 
terribly sorry that I took so long reviewing them (and now there are conflicts).  Could 
you please send new ones with the conflicts resolved?

Maybe it gives another chance to try out your new rebase? :)

Thanks,
Jason

The conflicts weren't nasty so I've just resolved them in new patches
rather than amending or rebasing the old ones.

30 patches for repository http://darcs.net:

Fri Nov 27 17:43:38 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * make tentativelyRemove return the new repo state

Fri Nov 27 17:44:39 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * adding patches should affect the tentative state

Wed Dec  2 19:18:33 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * return new repository state from tentativelyAdd etc

Fri Dec 11 01:07:54 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * add concept of gaps

Fri Feb 12 18:06:27 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add docs to Gap and related types

Mon Dec 21 19:03:33 GMT 2009  Ganesh Sittampalam <ganesh@earth.li>
  * add TypeOperators to witnesses build

Tue Jan 26 20:19:33 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * reduce conditionalisation on witnesses in Darcs.Patch.Commute

Wed Feb 10 18:59:26 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnessed variant of PatchInfo

Wed Feb 10 19:15:44 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Move

Wed Feb 10 19:31:04 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnessed toFL operation

Wed Feb 10 19:32:09 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Record

Wed Feb 10 20:37:54 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Add

Wed Feb 10 20:57:23 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Get

Thu Feb 11 11:04:10 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * return new repo from applyToWorking

Thu Feb 11 11:12:04 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Put

Thu Feb 11 11:19:41 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Optimize

Thu Feb 11 11:31:57 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * use tentative repo in askAboutDepends

Thu Feb 11 11:33:24 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.AmendRecord

Thu Feb 11 11:34:18 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Revert

Thu Feb 11 11:35:10 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.MarkConflicts

Thu Feb 11 18:16:13 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Convert

Thu Feb 11 18:44:35 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Rollback

Thu Feb 11 18:46:08 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * everything now compiles with witnesses
  Note that because of some bits of conditional compilation, this doesn't
  mean we can turn witnesses on for the real build yet.
  

Wed Feb 10 18:43:08 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to treeDiff

Wed Feb 10 19:07:16 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Repository.Repair

Wed Feb 10 19:13:07 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Check

Wed Feb 10 21:00:03 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * fix witnesses in Darcs.Commands.Remove using gaps

Wed Feb 10 21:06:33 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * add witnesses to Darcs.Commands.Replace

Sat Mar  6 18:52:42 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * resolve conflict between witness addition and issue1749 fix

Sat Mar  6 18:55:27 GMT 2010  Ganesh Sittampalam <ganesh@earth.li>
  * resolve conflict between witnesses and Origin import

Attachments

• make-tentativelyremove-return-the-new-repo-state.dpatch
• unnamed

Could I get a volunteer to eye ball the conflict resolution and push the
changes?  I'm a bit water logged at the moment but these were ready to
go in pre-conflict resolution.

I hate making Ganesh wait but I'm not near my stagging repo at the moment.

Thanks!

I heard a rumor that these have been applied but our automated
notification is no longer working.

Thanks Ganesh and Petr!

This patch bundle (with 37 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-44d11c072c99d64fc595d5ad32ffd184dbc62403

This patch bundle (with 35 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-350817f7d1c33249114dd1dd694039e815ca9a4f

This patch bundle (with 35 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-350817f7d1c33249114dd1dd694039e815ca9a4f

This patch bundle (with 37 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-44d11c072c99d64fc595d5ad32ffd184dbc62403