[darcs-users] [patch159] make tentativelyRemove return the new re... (and 27 more)
Jason Dagit
bugs at darcs.net
Tue Feb 23 22:43:55 UTC 2010
Jason Dagit <dagitj at gmail.com> added the comment:
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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at earth.li>**20100210190716
Ignore-this: 23432ed7f437a4d7fc964ec4e6f8db99
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at earth.li>**20091211010754
Ignore-this: afe3115fd2333f00cb5a4c8a1f7ec281
]
[add witnessed variant of PatchInfo
Ganesh Sittampalam <ganesh at 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 at earth.li>**20100210191307
Ignore-this: 4d197c1f543741abaa78d9dac26573b7
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at earth.li>**20100210191544
Ignore-this: c55d6910e4d79a2a8bfe47f1cdc150ad
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at earth.li>**20100210193104
Ignore-this: f1585c7f0d8e15edb216b9750e591ddb
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at 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 at earth.li>**20100210203754
Ignore-this: dcb548d2e96b50c3cccede82e84758da
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at 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 at earth.li>**20100210210003
Ignore-this: 352fa85ba57dd1d1a907a42ced4324f7
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at earth.li>**20100210210633
Ignore-this: 96da24a06dde4b3eba357230cf054c7a
]
<
[add concept of gaps
Ganesh Sittampalam <ganesh at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 ()
----------
status: needs-review -> review-in-progress
__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch159>
__________________________________
More information about the darcs-users
mailing list