module Darcs.Patch.Named
( Named(..)
, infopatch
, adddeps
, anonymous
, HasDeps(..)
, patch2patchinfo
, patchname
, patchcontents
, fmapNamed
, fmapFL_Named
, mergerIdNamed
, ShowDepsFormat(..)
, showDependencies
) where
import Darcs.Prelude
import Data.List.Ordered ( nubSort )
import qualified Data.Set as S
import Darcs.Patch.CommuteFn ( MergeFn, commuterIdFL, mergerIdFL )
import Darcs.Patch.Conflict ( Conflict(..) )
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.Effect ( Effect(effect) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo, patchinfo,
piName, displayPatchInfo, makePatchname )
import Darcs.Patch.Merge ( CleanMerge(..), Merge(..) )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId, IdEq2(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.FromPrim ( PrimPatchBase(..), FromPrim(..) )
import Darcs.Util.Parser ( Parser, option, lexChar,
choice, skipWhile, anyChar )
import Darcs.Patch.Repair ( mapMaybeSnd, Repair(..), RepairToFL, Check(..) )
import Darcs.Patch.Show
( ShowContextPatch(..)
, ShowPatch(..)
, ShowPatchBasic(..)
, ShowPatchFor(..)
, displayPatch
)
import Darcs.Patch.Summary
( Summary(..)
, plainSummaryFL
)
import Darcs.Patch.Unwind ( Unwind(..), squashUnwound )
import Darcs.Patch.Viewing ()
import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Ordered
( (:>)(..), (:\/:)(..), (:/\:)(..)
, FL(..), RL(..), mapFL, mapFL_FL, mapRL_RL
, (+>+), concatRLFL, reverseFL
, (+<<+), (+>>+), concatFL
)
import Darcs.Patch.Witnesses.Sealed ( Sealed, mapSeal )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Util.IsoDate ( showIsoDateTime, theBeginning )
import Darcs.Util.Printer
( Doc, ($$), (<+>), text, vcat, cyanText, blueText )
data Named p wX wY where
NamedP :: !PatchInfo
-> ![PatchInfo]
-> !(FL p wX wY)
-> Named p wX wY
deriving Int -> Named p wX wY -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: * -> * -> *) wX wY.
Show2 p =>
Int -> Named p wX wY -> ShowS
forall (p :: * -> * -> *) wX wY.
Show2 p =>
[Named p wX wY] -> ShowS
forall (p :: * -> * -> *) wX wY. Show2 p => Named p wX wY -> String
showList :: [Named p wX wY] -> ShowS
$cshowList :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
[Named p wX wY] -> ShowS
show :: Named p wX wY -> String
$cshow :: forall (p :: * -> * -> *) wX wY. Show2 p => Named p wX wY -> String
showsPrec :: Int -> Named p wX wY -> ShowS
$cshowsPrec :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
Int -> Named p wX wY -> ShowS
Show
instance PrimPatchBase p => PrimPatchBase (Named p) where
type PrimOf (Named p) = PrimOf p
instance Effect p => Effect (Named p) where
effect :: forall wX wY. Named p wX wY -> FL (PrimOf (Named p)) wX wY
effect (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wX wY
p
type instance PatchId (Named p) = PatchInfo
instance Ident (Named p) where
ident :: forall wX wY. Named p wX wY -> PatchId (Named p)
ident = forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo
instance IdEq2 (Named p)
instance IsHunk (Named p) where
isHunk :: forall wX wY. Named p wX wY -> Maybe (FileHunk wX wY)
isHunk Named p wX wY
_ = forall a. Maybe a
Nothing
instance PatchListFormat (Named p)
instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p) where
readPatch' :: forall wX. Parser (Sealed (Named p wX))
readPatch' = forall (p :: * -> * -> *) wX.
(ReadPatch p, PatchListFormat p) =>
Parser (Sealed (Named p wX))
readNamed
readNamed :: (ReadPatch p, PatchListFormat p) => Parser (Sealed (Named p wX))
readNamed :: forall (p :: * -> * -> *) wX.
(ReadPatch p, PatchListFormat p) =>
Parser (Sealed (Named p wX))
readNamed = do PatchInfo
n <- Parser PatchInfo
readPatchInfo
[PatchInfo]
d <- Parser [PatchInfo]
readDepends
Sealed (FL p wX)
p <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
`mapSeal` Sealed (FL p wX)
p
readDepends :: Parser [PatchInfo]
readDepends :: Parser [PatchInfo]
readDepends =
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] forall a b. (a -> b) -> a -> b
$ do Char -> Parser ()
lexChar Char
'<'
Parser [PatchInfo]
readPis
readPis :: Parser [PatchInfo]
readPis :: Parser [PatchInfo]
readPis = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ do PatchInfo
pi <- Parser PatchInfo
readPatchInfo
[PatchInfo]
pis <- Parser [PatchInfo]
readPis
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
piforall a. a -> [a] -> [a]
:[PatchInfo]
pis)
, do (Char -> Bool) -> Parser ()
skipWhile (forall a. Eq a => a -> a -> Bool
/= Char
'>')
Char
_ <- Parser Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
return [] ]
instance Apply p => Apply (Named p) where
type ApplyState (Named p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
Named p wX wY -> m ()
apply (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL p wX wY
p
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
Named p wX wY -> m ()
unapply (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL p wX wY
p
instance RepairToFL p => Repair (Named p) where
applyAndTryToFix :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
Named p wX wY -> m (Maybe (String, Named p wX wY))
applyAndTryToFix (NamedP PatchInfo
n [PatchInfo]
d FL p wX wY
p) = forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix FL p wX wY
p
anonymous :: FromPrim p => FL (PrimOf p) wX wY -> IO (Named p wX wY)
anonymous :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
FL (PrimOf p) wX wY -> IO (Named p wX wY)
anonymous FL (PrimOf p) wX wY
ps = do
PatchInfo
info <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo (CalendarTime -> String
showIsoDateTime CalendarTime
theBeginning) String
"anonymous" String
"unknown" [String
"anonymous"]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
info FL (PrimOf p) wX wY
ps
infopatch :: forall p wX wY. FromPrim p => PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
pi FL (PrimOf p) wX wY
ps = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pi [] (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY
fromPrims PatchInfo
pi FL (PrimOf p) wX wY
ps) where
adddeps :: Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps :: forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps (NamedP PatchInfo
pi [PatchInfo]
_ FL p wX wY
p) [PatchInfo]
ds = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pi [PatchInfo]
ds FL p wX wY
p
class HasDeps p where
getdeps :: p wX wY -> [PatchInfo]
instance HasDeps (Named p) where
getdeps :: forall wX wY. Named p wX wY -> [PatchInfo]
getdeps (NamedP PatchInfo
_ [PatchInfo]
ds FL p wX wY
_) = [PatchInfo]
ds
patch2patchinfo :: Named p wX wY -> PatchInfo
patch2patchinfo :: forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo (NamedP PatchInfo
i [PatchInfo]
_ FL p wX wY
_) = PatchInfo
i
patchname :: Named p wX wY -> String
patchname :: forall (p :: * -> * -> *) wX wY. Named p wX wY -> String
patchname (NamedP PatchInfo
i [PatchInfo]
_ FL p wX wY
_) = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
i
patchcontents :: Named p wX wY -> FL p wX wY
patchcontents :: forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY
p
patchcontentsRL :: RL (Named p) wX wY -> RL p wX wY
patchcontentsRL :: forall (p :: * -> * -> *) wX wY. RL (Named p) wX wY -> RL p wX wY
patchcontentsRL = forall (p :: * -> * -> *) wX wY. RL (FL p) wX wY -> RL p wX wY
concatRLFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents
fmapNamed :: (forall wA wB . p wA wB -> q wA wB) -> Named p wX wY -> Named q wX wY
fmapNamed :: forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> Named p wX wY -> Named q wX wY
fmapNamed forall wA wB. p wA wB -> q wA wB
f (NamedP PatchInfo
i [PatchInfo]
deps FL p wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wA wB. p wA wB -> q wA wB
f FL p wX wY
p)
fmapFL_Named :: (FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named :: forall (p :: * -> * -> *) wA wB (q :: * -> * -> *) wC wD.
(FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named FL p wA wB -> FL q wC wD
f (NamedP PatchInfo
i [PatchInfo]
deps FL p wA wB
p) = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps (FL p wA wB -> FL q wC wD
f FL p wA wB
p)
instance Eq2 (Named p) where
unsafeCompare :: forall wA wB wC wD. Named p wA wB -> Named p wC wD -> Bool
unsafeCompare (NamedP PatchInfo
n1 [PatchInfo]
_ FL p wA wB
_) (NamedP PatchInfo
n2 [PatchInfo]
_ FL p wC wD
_) = PatchInfo
n1 forall a. Eq a => a -> a -> Bool
== PatchInfo
n2
instance Commute p => Commute (Named p) where
commute :: forall wX wY.
(:>) (Named p) (Named p) wX wY
-> Maybe ((:>) (Named p) (Named p) wX wY)
commute (NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wX wZ
p1 :> NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wZ wY
p2) =
if PatchInfo
n2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d1 Bool -> Bool -> Bool
|| PatchInfo
n1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d2
then forall a. Maybe a
Nothing
else do (FL p wX wZ
p2' :> FL p wZ wY
p1') <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL p wX wZ
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wZ wY
p2)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wZ wY
p1')
instance CleanMerge p => CleanMerge (Named p) where
cleanMerge :: forall wX wY.
(:\/:) (Named p) (Named p) wX wY
-> Maybe ((:/\:) (Named p) (Named p) wX wY)
cleanMerge (NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wZ wX
p1 :\/: NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wZ wY
p2)
| PatchInfo
n1 forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = forall a. HasCallStack => String -> a
error String
"cannot cleanMerge identical Named patches"
| Bool
otherwise = do
FL p wX wZ
p2' :/\: FL p wY wZ
p1' <- forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL p wZ wX
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p wZ wY
p2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wY wZ
p1'
instance Merge p => Merge (Named p) where
merge :: forall wX wY.
(:\/:) (Named p) (Named p) wX wY
-> (:/\:) (Named p) (Named p) wX wY
merge (NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wZ wX
p1 :\/: NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wZ wY
p2)
| PatchInfo
n1 forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = forall a. HasCallStack => String -> a
error String
"cannot merge identical Named patches"
| Bool
otherwise =
case forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (FL p wZ wX
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p wZ wY
p2) of
(FL p wX wZ
p2' :/\: FL p wY wZ
p1') -> forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p wY wZ
p1'
mergerIdNamed :: MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed MergeFn p1 p2
merger (p1 wZ wX
p1 :\/: NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wZ wY
p2) =
case forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (FL p2)
mergerIdFL MergeFn p1 p2
merger (p1 wZ wX
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p2 wZ wY
p2) of
FL p2 wX wZ
p2' :/\: p1 wY wZ
p1' -> forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wX wZ
p2' forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: p1 wY wZ
p1'
instance (Commute p, Conflict p) => Conflict (Named p) where
resolveConflicts :: forall wO wX wY.
RL (Named p) wO wX
-> RL (Named p) wX wY -> [ConflictDetails (PrimOf (Named p)) wY]
resolveConflicts RL (Named p) wO wX
context RL (Named p) wX wY
patches =
case forall w1 w2 w3 w4.
Set PatchInfo
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate forall a. Set a
S.empty RL (Named p) wX wY
patches forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a :: * -> * -> *) wX. FL a wX wX
NilFL of
FL p wX wZ
deps :> FL p wZ wY
nondeps ->
forall (p :: * -> * -> *) wO wX wY.
Conflict p =>
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
resolveConflicts (forall (p :: * -> * -> *) wX wY. RL (Named p) wX wY -> RL p wX wY
patchcontentsRL RL (Named p) wO wX
context forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> RL p wX wZ
+<<+ FL p wX wZ
deps) (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wZ wY
nondeps)
where
separate :: S.Set PatchInfo
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (FL p :> FL p) w1 w4
separate :: forall w1 w2 w3 w4.
Set PatchInfo
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate Set PatchInfo
acc_deps (RL (Named p) w1 wY
ps :<: NamedP PatchInfo
name [PatchInfo]
deps FL p wY w2
contents) FL p w2 w3
resolved FL p w3 w4
unresolved
| PatchInfo
name forall a. Ord a => a -> Set a -> Bool
`S.member` Set PatchInfo
acc_deps =
forall w1 w2 w3 w4.
Set PatchInfo
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate (Set PatchInfo
acc_deps forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
+| [PatchInfo]
deps) RL (Named p) w1 wY
ps (FL p wY w2
contents forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL p w2 w3
resolved) FL p w3 w4
unresolved
| Bool
otherwise =
case forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Commute p =>
(forall wA wB. (:>) p q wA wB -> Maybe ((:>) q p wA wB))
-> (:>) (RL p) q wX wY -> (:>) (RL p) (q :> RL p) wX wY
genCommuteWhatWeCanRL (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute)
(forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wY w2
contents forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p w2 w3
resolved) of
RL p wY wZ
dragged :> FL p wZ wZ
resolved' :> RL p wZ w3
more_unresolved ->
forall w1 w2 w3 w4.
Set PatchInfo
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate (Set PatchInfo
acc_deps forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
+| [PatchInfo]
deps) RL (Named p) w1 wY
ps
(RL p wY wZ
dragged forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> FL p wX wZ
+>>+ FL p wZ wZ
resolved') (RL p wZ w3
more_unresolved forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> FL p wX wZ
+>>+ FL p w3 w4
unresolved)
separate Set PatchInfo
_ RL (Named p) w1 w2
NilRL FL p w2 w3
resolved FL p w3 w4
unresolved = FL p w2 w3
resolved forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p w3 w4
unresolved
Set a
some +| :: Set a -> t a -> Set a
+| t a
more = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => a -> Set a -> Set a
S.insert Set a
some t a
more
instance (PrimPatchBase p, Unwind p) => Unwind (Named p) where
fullUnwind :: forall wX wY. Named p wX wY -> Unwound (PrimOf (Named p)) wX wY
fullUnwind (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
ps) = forall (prim :: * -> * -> *) wX wY.
(Show2 prim, Commute prim, Eq2 prim, Invert prim) =>
FL (Unwound prim) wX wY -> Unwound prim wX wY
squashUnwound (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (p :: * -> * -> *) wX wY.
Unwind p =>
p wX wY -> Unwound (PrimOf p) wX wY
fullUnwind FL p wX wY
ps)
instance PatchInspect p => PatchInspect (Named p) where
listTouchedFiles :: forall wX wY. Named p wX wY -> [AnchoredPath]
listTouchedFiles (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL p wX wY
p
hunkMatches :: forall wX wY. (ByteString -> Bool) -> Named p wX wY -> Bool
hunkMatches ByteString -> Bool
f (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL p wX wY
p
instance Summary p => Summary (Named p) where
conflictedEffect :: forall wX wY.
Named p wX wY -> [IsConflictedPrim (PrimOf (Named p))]
conflictedEffect = forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents
instance Check p => Check (Named p) where
isInconsistent :: forall wX wY. Named p wX wY -> Maybe Doc
isInconsistent (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent FL p wX wY
p
showNamedPrefix :: ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix :: ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForStorage PatchInfo
n [] Doc
p =
ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n forall a. Semigroup a => a -> a -> a
<> Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForStorage PatchInfo
n [PatchInfo]
d Doc
p =
ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
Doc -> Doc -> Doc
$$ String -> Doc
blueText String
"<"
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f) [PatchInfo]
d)
Doc -> Doc -> Doc
$$ String -> Doc
blueText String
">"
Doc -> Doc -> Doc
<+> Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForDisplay PatchInfo
n [] Doc
p =
ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
Doc -> Doc -> Doc
$$ Doc
p
showNamedPrefix f :: ShowPatchFor
f@ShowPatchFor
ForDisplay PatchInfo
n [PatchInfo]
d Doc
p =
ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
Doc -> Doc -> Doc
$$ ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsVerbose [PatchInfo]
d
Doc -> Doc -> Doc
$$ Doc
p
instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Named p) where
showPatch :: forall wX wY. ShowPatchFor -> Named p wX wY -> Doc
showPatch ShowPatchFor
f (NamedP PatchInfo
n [PatchInfo]
d FL p wX wY
p) = ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix ShowPatchFor
f PatchInfo
n [PatchInfo]
d forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f FL p wX wY
p
instance (Apply p, IsHunk p, PatchListFormat p,
ShowContextPatch p) => ShowContextPatch (Named p) where
showContextPatch :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
ShowPatchFor -> Named p wX wY -> m Doc
showContextPatch ShowPatchFor
f (NamedP PatchInfo
n [PatchInfo]
d FL p wX wY
p) =
ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
showNamedPrefix ShowPatchFor
f PatchInfo
n [PatchInfo]
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
f FL p wX wY
p
data ShowDepsFormat = ShowDepsVerbose | ShowDepsSummary
deriving (ShowDepsFormat -> ShowDepsFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
$c/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
== :: ShowDepsFormat -> ShowDepsFormat -> Bool
$c== :: ShowDepsFormat -> ShowDepsFormat -> Bool
Eq)
showDependencies :: ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies :: ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
format [PatchInfo]
deps = [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> Doc
showDependency [PatchInfo]
deps)
where
showDependency :: PatchInfo -> Doc
showDependency PatchInfo
d =
Doc
mark Doc -> Doc -> Doc
<+>
String -> Doc
cyanText (forall a. Show a => a -> String
show (PatchInfo -> SHA1
makePatchname PatchInfo
d)) Doc -> Doc -> Doc
$$ Doc
asterisk Doc -> Doc -> Doc
<+> String -> Doc
text (PatchInfo -> String
piName PatchInfo
d)
mark :: Doc
mark
| ShowDepsFormat
format forall a. Eq a => a -> a -> Bool
== ShowDepsFormat
ShowDepsVerbose = String -> Doc
blueText String
"depend"
| Bool
otherwise = String -> Doc
text String
"D"
asterisk :: Doc
asterisk = String -> Doc
text String
" *"
instance (Summary p, PatchListFormat p,
PrimPatchBase p, ShowPatch p) => ShowPatch (Named p) where
description :: forall wX wY. Named p wX wY -> Doc
description (NamedP PatchInfo
n [PatchInfo]
_ FL p wX wY
_) = PatchInfo -> Doc
displayPatchInfo PatchInfo
n
summary :: forall wX wY. Named p wX wY -> Doc
summary (NamedP PatchInfo
_ [PatchInfo]
ds FL p wX wY
ps) =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds Doc -> Doc -> Doc
$$ forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL FL p wX wY
ps
summaryFL :: forall wX wY. FL (Named p) wX wY -> Doc
summaryFL FL (Named p) wX wY
nps =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds Doc -> Doc -> Doc
$$ forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL FL p wX wY
ps
where
ds :: [PatchInfo]
ds = forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps FL (Named p) wX wY
nps
ps :: FL p wX wY
ps = forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents FL (Named p) wX wY
nps
content :: forall wX wY. Named p wX wY -> Doc
content (NamedP PatchInfo
_ [PatchInfo]
ds FL p wX wY
ps) =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsVerbose [PatchInfo]
ds Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL p wX wY
ps
instance Show2 p => Show1 (Named p wX)
instance Show2 p => Show2 (Named p)
instance PatchDebug p => PatchDebug (Named p)