module Darcs.Patch.Set
( PatchSet(..)
, Tagged(..)
, SealedPatchSet
, Origin
, progressPatchSet
, patchSetTags
, emptyPatchSet
, appendPSFL
, patchSet2RL
, patchSet2FL
, inOrderTags
, patchSetSnoc
, patchSetSplit
, patchSetDrop
) where
import Darcs.Prelude
import Data.Maybe ( catMaybes )
import Darcs.Patch.Info ( PatchInfo, piTag )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Ordered
( FL, RL(..), (+<+), (+<<+), (:>)(..), reverseRL,
mapRL_RL, concatRL, mapRL )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Util.Progress ( progress )
data Origin
type SealedPatchSet rt p wStart = Sealed ((PatchSet rt p) wStart)
data PatchSet rt p wStart wY where
PatchSet :: RL (Tagged rt p) Origin wX -> RL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p Origin wY
deriving instance Show2 p => Show (PatchSet rt p wStart wY)
instance Show2 p => Show1 (PatchSet rt p wStart)
instance Show2 p => Show2 (PatchSet rt p)
emptyPatchSet :: PatchSet rt p Origin Origin
emptyPatchSet :: PatchSet rt p Origin Origin
emptyPatchSet = RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin Origin
-> PatchSet rt p Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
data Tagged rt p wX wZ where
Tagged :: PatchInfoAnd rt p wY wZ -> Maybe String
-> RL (PatchInfoAnd rt p) wX wY -> Tagged rt p wX wZ
deriving instance Show2 p => Show (Tagged rt p wX wZ)
instance Show2 p => Show1 (Tagged rt p wX)
instance Show2 p => Show2 (Tagged rt p)
patchSet2RL :: PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL :: PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
ps) = RL (RL (PatchInfoAnd rt p)) Origin wX
-> RL (PatchInfoAnd rt p) Origin wX
forall (a :: * -> * -> *) wX wZ. RL (RL a) wX wZ -> RL a wX wZ
concatRL ((forall wW wY. Tagged rt p wW wY -> RL (PatchInfoAnd rt p) wW wY)
-> RL (Tagged rt p) Origin wX
-> RL (RL (PatchInfoAnd rt p)) Origin wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL forall wW wY. Tagged rt p wW wY -> RL (PatchInfoAnd rt p) wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ.
Tagged rt p wY wZ -> RL (PatchInfoAnd rt p) wY wZ
ts2rl RL (Tagged rt p) Origin wX
ts) RL (PatchInfoAnd rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
ps
where
ts2rl :: Tagged rt p wY wZ -> RL (PatchInfoAnd rt p) wY wZ
ts2rl :: Tagged rt p wY wZ -> RL (PatchInfoAnd rt p) wY wZ
ts2rl (Tagged PatchInfoAnd rt p wY wZ
t Maybe String
_ RL (PatchInfoAnd rt p) wY wY
ps2) = RL (PatchInfoAnd rt p) wY wY
ps2 RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wY wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wZ
t
patchSet2FL :: PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL :: PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL = RL (PatchInfoAnd rt p) wStart wX
-> FL (PatchInfoAnd rt p) wStart wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (RL (PatchInfoAnd rt p) wStart wX
-> FL (PatchInfoAnd rt p) wStart wX)
-> (PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX)
-> PatchSet rt p wStart wX
-> FL (PatchInfoAnd rt p) wStart wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL
appendPSFL :: PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY
appendPSFL :: PatchSet rt p wStart wX
-> FL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
appendPSFL (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
ps) FL (PatchInfoAnd rt p) wX wY
newps = RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wX
ps RL (PatchInfoAnd rt p) wX wX
-> FL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> RL p wX wZ
+<<+ FL (PatchInfoAnd rt p) wX wY
newps)
progressPatchSet :: String -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
progressPatchSet :: String -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
progressPatchSet String
k (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
ps) =
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet ((forall wW wY. Tagged rt p wW wY -> Tagged rt p wW wY)
-> RL (Tagged rt p) Origin wX -> RL (Tagged rt p) Origin wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL forall wW wY. Tagged rt p wW wY -> Tagged rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ.
Tagged rt p wY wZ -> Tagged rt p wY wZ
progressTagged RL (Tagged rt p) Origin wX
ts) ((forall wW wY. PatchInfoAnd rt p wW wY -> PatchInfoAnd rt p wW wY)
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL forall a. a -> a
forall wW wY. PatchInfoAnd rt p wW wY -> PatchInfoAnd rt p wW wY
prog RL (PatchInfoAnd rt p) wX wX
ps)
where
prog :: a -> a
prog = String -> a -> a
forall a. String -> a -> a
progress String
k
progressTagged :: Tagged rt p wY wZ -> Tagged rt p wY wZ
progressTagged :: Tagged rt p wY wZ -> Tagged rt p wY wZ
progressTagged (Tagged PatchInfoAnd rt p wY wZ
t Maybe String
h RL (PatchInfoAnd rt p) wY wY
tps) = PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wY wY
-> Tagged rt p wY wZ
forall (rt :: RepoType) (p :: * -> * -> *) wY wZ wX.
PatchInfoAnd rt p wY wZ
-> Maybe String
-> RL (PatchInfoAnd rt p) wX wY
-> Tagged rt p wX wZ
Tagged (PatchInfoAnd rt p wY wZ -> PatchInfoAnd rt p wY wZ
forall a. a -> a
prog PatchInfoAnd rt p wY wZ
t) Maybe String
h ((forall wW wY. PatchInfoAnd rt p wW wY -> PatchInfoAnd rt p wW wY)
-> RL (PatchInfoAnd rt p) wY wY -> RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL forall a. a -> a
forall wW wY. PatchInfoAnd rt p wW wY -> PatchInfoAnd rt p wW wY
prog RL (PatchInfoAnd rt p) wY wY
tps)
patchSetTags :: PatchSet rt p wX wY -> [String]
patchSetTags :: PatchSet rt p wX wY -> [String]
patchSetTags = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> (PatchSet rt p wX wY -> [Maybe String])
-> PatchSet rt p wX wY
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. PatchInfoAnd rt p wW wZ -> Maybe String)
-> RL (PatchInfoAnd rt p) wX wY -> [Maybe String]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (PatchInfo -> Maybe String
piTag (PatchInfo -> Maybe String)
-> (PatchInfoAndG rt (Named p) wW wZ -> PatchInfo)
-> PatchInfoAndG rt (Named p) wW wZ
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt (Named p) wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) (RL (PatchInfoAnd rt p) wX wY -> [Maybe String])
-> (PatchSet rt p wX wY -> RL (PatchInfoAnd rt p) wX wY)
-> PatchSet rt p wX wY
-> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL
inOrderTags :: PatchSet rt p wS wX -> [PatchInfo]
inOrderTags :: PatchSet rt p wS wX -> [PatchInfo]
inOrderTags (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wX
_) = RL (Tagged rt p) Origin wX -> [PatchInfo]
forall (rt :: RepoType) (t1 :: * -> * -> *) wT wY.
RL (Tagged rt t1) wT wY -> [PatchInfo]
go RL (Tagged rt p) Origin wX
ts
where go :: RL(Tagged rt t1) wT wY -> [PatchInfo]
go :: RL (Tagged rt t1) wT wY -> [PatchInfo]
go (RL (Tagged rt t1) wT wY
ts' :<: Tagged PatchInfoAnd rt t1 wY wY
t Maybe String
_ RL (PatchInfoAnd rt t1) wY wY
_) = PatchInfoAnd rt t1 wY wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt t1 wY wY
t PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: RL (Tagged rt t1) wT wY -> [PatchInfo]
forall (rt :: RepoType) (t1 :: * -> * -> *) wT wY.
RL (Tagged rt t1) wT wY -> [PatchInfo]
go RL (Tagged rt t1) wT wY
ts'
go RL (Tagged rt t1) wT wY
NilRL = []
patchSetSnoc :: PatchSet rt p wX wY -> PatchInfoAnd rt p wY wZ -> PatchSet rt p wX wZ
patchSetSnoc :: PatchSet rt p wX wY
-> PatchInfoAnd rt p wY wZ -> PatchSet rt p wX wZ
patchSetSnoc (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wY
ps) PatchInfoAnd rt p wY wZ
p = RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wZ -> PatchSet rt p Origin wZ
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wZ -> RL (PatchInfoAnd rt p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wZ
p)
patchSetSplit :: PatchSet rt p wX wY
-> (PatchSet rt p :> RL (PatchInfoAnd rt p)) wX wY
patchSetSplit :: PatchSet rt p wX wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wX wY
patchSetSplit (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe String
_ RL (PatchInfoAnd rt p) wY wY
ps') RL (PatchInfoAnd rt p) wX wY
ps) =
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts RL (PatchInfoAnd rt p) wY wY
ps' PatchSet rt p Origin wY
-> RL (PatchInfoAnd rt p) wY wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> ((RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t) RL (PatchInfoAnd rt p) wY wX
-> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wY
ps)
patchSetSplit (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wY
ps) = RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin Origin
-> PatchSet rt p Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL PatchSet rt p Origin Origin
-> RL (PatchInfoAnd rt p) Origin wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wX wY
RL (PatchInfoAnd rt p) Origin wY
ps
patchSetDrop :: Int
-> PatchSet rt p wStart wX
-> SealedPatchSet rt p wStart
patchSetDrop :: Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
n PatchSet rt p wStart wX
ps | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p wStart wX
ps
patchSetDrop Int
n (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe String
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL) =
Int -> PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
n (PatchSet rt p Origin wX -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t)
patchSetDrop Int
_ (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) = PatchSet rt p Origin Origin -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (PatchSet rt p Origin Origin -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin Origin -> SealedPatchSet rt p Origin
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin Origin
-> PatchSet rt p Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
patchSetDrop Int
n (PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
_)) = Int -> PatchSet rt p Origin wY -> SealedPatchSet rt p Origin
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (PatchSet rt p Origin wY -> SealedPatchSet rt p Origin)
-> PatchSet rt p Origin wY -> SealedPatchSet rt p Origin
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wY
ps