module Darcs.Patch.Set
( PatchSet(..)
, Tagged(..)
, SealedPatchSet
, Origin
, progressPatchSet
, tags
, emptyPatchSet
, appendPSFL
, newset2RL
, newset2FL
) where
import Darcs.Patch.Info ( PatchInfo )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Witnesses.Sealed ( Sealed )
import Darcs.Patch.Witnesses.Ordered
( FL, RL(..), (+<+), reverseFL, reverseRL,
mapRL_RL, concatRL, mapRL )
import Darcs.Patch.Witnesses.Show ( Show1(..), Show2(..), ShowDict(ShowDictClass) )
import Darcs.Util.Progress ( progress )
data Origin
type SealedPatchSet p wStart = Sealed ((PatchSet p) wStart)
data PatchSet p wStart wY where
PatchSet :: RL (PatchInfoAnd p) wX wY -> RL (Tagged p) wStart wX
-> PatchSet p wStart wY
deriving instance Show2 p => Show (PatchSet p wStart wY)
instance Show2 p => Show1 (PatchSet p wStart) where
showDict1 = ShowDictClass
instance Show2 p => Show2 (PatchSet p) where
showDict2 = ShowDictClass
emptyPatchSet :: PatchSet p wX wX
emptyPatchSet = PatchSet NilRL NilRL
data Tagged p wX wZ where
Tagged :: PatchInfoAnd p wY wZ -> Maybe String
-> RL (PatchInfoAnd p) wX wY -> Tagged p wX wZ
deriving instance Show2 p => Show (Tagged p wX wZ)
instance Show2 p => Show1 (Tagged p wX) where
showDict1 = ShowDictClass
instance Show2 p => Show2 (Tagged p) where
showDict2 = ShowDictClass
newset2RL :: PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
newset2RL (PatchSet ps ts) = ps +<+ concatRL (mapRL_RL ts2rl ts)
where
ts2rl :: Tagged p wY wZ -> RL (PatchInfoAnd p) wY wZ
ts2rl (Tagged t _ ps2) = t :<: ps2
newset2FL :: PatchSet p wStart wX -> FL (PatchInfoAnd p) wStart wX
newset2FL = reverseRL . newset2RL
appendPSFL :: PatchSet p wStart wX -> FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY
appendPSFL (PatchSet ps ts) newps = PatchSet (reverseFL newps +<+ ps) ts
progressPatchSet :: String -> PatchSet p wStart wX -> PatchSet p wStart wX
progressPatchSet k (PatchSet ps ts) =
PatchSet (mapRL_RL prog ps) $ mapRL_RL progressTagged ts
where
prog = progress k
progressTagged :: Tagged p wY wZ -> Tagged p wY wZ
progressTagged (Tagged t h tps) = Tagged (prog t) h (mapRL_RL prog tps)
tags :: PatchSet p wStart wX -> [PatchInfo]
tags (PatchSet _ ts) = mapRL taggedTagInfo ts
where
taggedTagInfo :: Tagged p wY wZ -> PatchInfo
taggedTagInfo (Tagged t _ _) = info t