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
[Named p wX wY] -> ShowS
Named p wX wY -> String
(Int -> Named p wX wY -> ShowS)
-> (Named p wX wY -> String)
-> ([Named p wX wY] -> ShowS)
-> Show (Named p wX wY)
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 :: Named p wX wY -> FL (PrimOf (Named p)) wX wY
effect (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> FL (PrimOf (FL p)) wX wY
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 :: Named p wX wY -> PatchId (Named p)
ident = Named p wX wY -> PatchId (Named p)
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo
instance IdEq2 (Named p)
instance IsHunk (Named p) where
isHunk :: Named p wX wY -> Maybe (FileHunk wX wY)
isHunk Named p wX wY
_ = Maybe (FileHunk wX wY)
forall a. Maybe a
Nothing
instance PatchListFormat (Named p)
instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p) where
readPatch' :: Parser (Sealed (Named p wX))
readPatch' = Parser (Sealed (Named p wX))
forall (p :: * -> * -> *) wX.
(ReadPatch p, PatchListFormat p) =>
Parser (Sealed (Named p wX))
readNamed
readNamed :: (ReadPatch p, PatchListFormat p) => Parser (Sealed (Named p wX))
readNamed :: Parser (Sealed (Named p wX))
readNamed = do PatchInfo
n <- Parser PatchInfo
readPatchInfo
[PatchInfo]
d <- Parser [PatchInfo]
readDepends
Sealed (FL p wX)
p <- Parser (Sealed (FL p wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
Sealed (Named p wX) -> Parser (Sealed (Named p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (Named p wX) -> Parser (Sealed (Named p wX)))
-> Sealed (Named p wX) -> Parser (Sealed (Named p wX))
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> [PatchInfo] -> FL p wX wX -> Named p wX wX
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) (forall wX. FL p wX wX -> Named p wX wX)
-> Sealed (FL p wX) -> Sealed (Named p wX)
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 =
[PatchInfo] -> Parser [PatchInfo] -> Parser [PatchInfo]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser [PatchInfo] -> Parser [PatchInfo])
-> Parser [PatchInfo] -> Parser [PatchInfo]
forall a b. (a -> b) -> a -> b
$ do Char -> Parser ()
lexChar Char
'<'
Parser [PatchInfo]
readPis
readPis :: Parser [PatchInfo]
readPis :: Parser [PatchInfo]
readPis = [Parser [PatchInfo]] -> Parser [PatchInfo]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ do PatchInfo
pi <- Parser PatchInfo
readPatchInfo
[PatchInfo]
pis <- Parser [PatchInfo]
readPis
[PatchInfo] -> Parser [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
piPatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
:[PatchInfo]
pis)
, do (Char -> Bool) -> Parser ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>')
Char
_ <- Parser Char
anyChar
[PatchInfo] -> Parser [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [] ]
instance Apply p => Apply (Named p) where
type ApplyState (Named p) = ApplyState p
apply :: Named p wX wY -> m ()
apply (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL p wX wY
p
unapply :: Named p wX wY -> m ()
unapply (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> m ()
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 :: Named p wX wY -> m (Maybe (String, Named p wX wY))
applyAndTryToFix (NamedP PatchInfo
n [PatchInfo]
d FL p wX wY
p) = (FL p wX wY -> Named p wX wY)
-> Maybe (String, FL p wX wY) -> Maybe (String, Named p wX wY)
forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd (PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
d) (Maybe (String, FL p wX wY) -> Maybe (String, Named p wX wY))
-> m (Maybe (String, FL p wX wY))
-> m (Maybe (String, Named p wX wY))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FL p wX wY -> m (Maybe (String, FL p wX wY))
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 :: 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"]
Named p wX wY -> IO (Named p wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wY -> IO (Named p wX wY))
-> Named p wX wY -> IO (Named p wX wY)
forall a b. (a -> b) -> a -> b
$ PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
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 :: PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
pi FL (PrimOf p) wX wY
ps = PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pi [] (PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY
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 :: Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps (NamedP PatchInfo
pi [PatchInfo]
_ FL p wX wY
p) [PatchInfo]
ds = PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
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 :: Named p wX wY -> [PatchInfo]
getdeps (NamedP PatchInfo
_ [PatchInfo]
ds FL p wX wY
_) = [PatchInfo]
ds
patch2patchinfo :: Named p wX wY -> PatchInfo
patch2patchinfo :: Named p wX wY -> PatchInfo
patch2patchinfo (NamedP PatchInfo
i [PatchInfo]
_ FL p wX wY
_) = PatchInfo
i
patchname :: Named p wX wY -> String
patchname :: Named p wX wY -> String
patchname (NamedP PatchInfo
i [PatchInfo]
_ FL p wX wY
_) = SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname PatchInfo
i
patchcontents :: Named p wX wY -> FL p wX wY
patchcontents :: 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 :: RL (Named p) wX wY -> RL p wX wY
patchcontentsRL = RL (FL p) wX wY -> RL p wX wY
forall (p :: * -> * -> *) wX wY. RL (FL p) wX wY -> RL p wX wY
concatRLFL (RL (FL p) wX wY -> RL p wX wY)
-> (RL (Named p) wX wY -> RL (FL p) wX wY)
-> RL (Named p) wX wY
-> RL p wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. Named p wW wY -> FL p wW wY)
-> RL (Named p) wX wY -> RL (FL p) wX 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 wW wY. Named p wW wY -> FL p wW wY
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 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) = PatchInfo -> [PatchInfo] -> FL q wX wY -> Named q wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
deps ((forall wA wB. p wA wB -> q wA wB) -> FL p wX wY -> FL q wX wY
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 :: (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) = PatchInfo -> [PatchInfo] -> FL q wC wD -> Named q wC wD
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 :: 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 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
n2
instance Commute p => Commute (Named p) where
commute :: (:>) (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 PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d1 Bool -> Bool -> Bool
|| PatchInfo
n1 PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d2
then Maybe ((:>) (Named p) (Named p) wX wY)
forall a. Maybe a
Nothing
else do (FL p wX wZ
p2' :> FL p wZ wY
p1') <- (:>) (FL p) (FL p) wX wY -> Maybe ((:>) (FL p) (FL p) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL p wX wZ
p1 FL p wX wZ -> FL p wZ wY -> (:>) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p wZ wY
p2)
(:>) (Named p) (Named p) wX wY
-> Maybe ((:>) (Named p) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> [PatchInfo] -> FL p wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' Named p wX wZ -> Named p wZ wY -> (:>) (Named p) (Named p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo -> [PatchInfo] -> FL p wZ wY -> Named p wZ 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 :: (:\/:) (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 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = String -> Maybe ((:/\:) (Named p) (Named p) wX wY)
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' <- (:\/:) (FL p) (FL p) wX wY -> Maybe ((:/\:) (FL p) (FL p) wX wY)
forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL p wZ wX
p1 FL p wZ wX -> FL p wZ wY -> (:\/:) (FL p) (FL p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL p wZ wY
p2)
(:/\:) (Named p) (Named p) wX wY
-> Maybe ((:/\:) (Named p) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:/\:) (Named p) (Named p) wX wY
-> Maybe ((:/\:) (Named p) (Named p) wX wY))
-> (:/\:) (Named p) (Named p) wX wY
-> Maybe ((:/\:) (Named p) (Named p) wX wY)
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [PatchInfo] -> FL p wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' Named p wX wZ -> Named p wY wZ -> (:/\:) (Named p) (Named p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: PatchInfo -> [PatchInfo] -> FL p wY wZ -> Named p wY wZ
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 :: (:\/:) (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 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = String -> (:/\:) (Named p) (Named p) wX wY
forall a. HasCallStack => String -> a
error String
"cannot merge identical Named patches"
| Bool
otherwise =
case (:\/:) (FL p) (FL p) wX wY -> (:/\:) (FL p) (FL p) wX wY
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (FL p wZ wX
p1 FL p wZ wX -> FL p wZ wY -> (:\/:) (FL p) (FL p) wX wY
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') -> PatchInfo -> [PatchInfo] -> FL p wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p wX wZ
p2' Named p wX wZ -> Named p wY wZ -> (:/\:) (Named p) (Named p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: PatchInfo -> [PatchInfo] -> FL p wY wZ -> Named p wY wZ
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 :: 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 MergeFn p1 p2 -> (:\/:) p1 (FL p2) wX wY -> (:/\:) (FL p2) p1 wX wY
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (FL p2)
mergerIdFL MergeFn p1 p2
merger (p1 wZ wX
p1 p1 wZ wX -> FL p2 wZ wY -> (:\/:) p1 (FL p2) wX wY
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' -> PatchInfo -> [PatchInfo] -> FL p2 wX wZ -> Named p2 wX wZ
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wX wZ
p2' Named p2 wX wZ -> p1 wY wZ -> (:/\:) (Named p2) p1 wX wY
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 :: 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 Set PatchInfo
-> RL (Named p) wX wY
-> FL p wY wY
-> FL p wY wY
-> (:>) (FL p) (FL p) wX wY
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
forall a. Set a
S.empty RL (Named p) wX wY
patches FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL of
FL p wX wZ
deps :> FL p wZ wY
nondeps ->
RL p wO wZ -> RL p wZ wY -> [ConflictDetails (PrimOf p) wY]
forall (p :: * -> * -> *) wO wX wY.
Conflict p =>
RL p wO wX -> RL p wX wY -> [ConflictDetails (PrimOf p) wY]
resolveConflicts (RL (Named p) wO wX -> RL p wO wX
forall (p :: * -> * -> *) wX wY. RL (Named p) wX wY -> RL p wX wY
patchcontentsRL RL (Named p) wO wX
context RL p wO wX -> FL p wX wZ -> RL p wO wZ
forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> RL p wX wZ
+<<+ FL p wX wZ
deps) (FL p wZ wY -> RL p wZ wY
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 :: 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 PatchInfo -> Set PatchInfo -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PatchInfo
acc_deps =
Set PatchInfo
-> RL (Named p) w1 wY
-> FL p wY w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
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 Set PatchInfo -> [PatchInfo] -> Set PatchInfo
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 FL p wY w2 -> FL p w2 w3 -> FL p wY w3
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 wA wB. (:>) p (FL p) wA wB -> Maybe ((:>) (FL p) p wA wB))
-> (:>) (RL p) (FL p) wY w3 -> (:>) (RL p) (FL p :> RL p) wY w3
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 (CommuteFn p p
-> forall wA wB. (:>) p (FL p) wA wB -> Maybe ((:>) (FL p) p wA wB)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn p p
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute)
(FL p wY w2 -> RL p wY w2
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL p wY w2
contents RL p wY w2 -> FL p w2 w3 -> (:>) (RL p) (FL p) wY w3
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 ->
Set PatchInfo
-> RL (Named p) w1 wY
-> FL p wY wZ
-> FL p wZ w4
-> (:>) (FL p) (FL p) w1 w4
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 Set PatchInfo -> [PatchInfo] -> Set PatchInfo
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 RL p wY wZ -> FL p wZ wZ -> FL p wY wZ
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 RL p wZ w3 -> FL p w3 w4 -> FL p wZ w4
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 FL p w2 w3 -> FL p w3 w4 -> (:>) (FL p) (FL p) w2 w4
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 = (a -> Set a -> Set a) -> Set a -> t a -> Set a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Set a -> Set a
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 :: Named p wX wY -> Unwound (PrimOf (Named p)) wX wY
fullUnwind (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
ps) = FL (Unwound (PrimOf p)) wX wY -> Unwound (PrimOf p) wX wY
forall (prim :: * -> * -> *) wX wY.
(Show2 prim, Commute prim, Eq2 prim, Invert prim) =>
FL (Unwound prim) wX wY -> Unwound prim wX wY
squashUnwound ((forall wW wY. p wW wY -> Unwound (PrimOf p) wW wY)
-> FL p wX wY -> FL (Unwound (PrimOf p)) wX wY
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 wW wY. p wW wY -> Unwound (PrimOf p) wW wY
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 :: Named p wX wY -> [AnchoredPath]
listTouchedFiles (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL p wX wY
p
hunkMatches :: (ByteString -> Bool) -> Named p wX wY -> Bool
hunkMatches ByteString -> Bool
f (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = (ByteString -> Bool) -> FL p wX wY -> Bool
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 :: Named p wX wY -> [IsConflictedPrim (PrimOf (Named p))]
conflictedEffect = FL p wX wY -> [IsConflictedPrim (PrimOf p)]
forall (p :: * -> * -> *) wX wY.
Summary p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect (FL p wX wY -> [IsConflictedPrim (PrimOf p)])
-> (Named p wX wY -> FL p wX wY)
-> Named p wX wY
-> [IsConflictedPrim (PrimOf p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named p wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents
instance Check p => Check (Named p) where
isInconsistent :: Named p wX wY -> Maybe Doc
isInconsistent (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> Maybe Doc
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 Doc -> Doc -> Doc
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 ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
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 :: 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> FL p wX wY -> Doc
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 :: 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 (Doc -> Doc) -> m Doc -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShowPatchFor -> FL p wX wY -> m Doc
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
(ShowDepsFormat -> ShowDepsFormat -> Bool)
-> (ShowDepsFormat -> ShowDepsFormat -> Bool) -> Eq ShowDepsFormat
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 ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
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 (SHA1 -> String
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 ShowDepsFormat -> ShowDepsFormat -> Bool
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 :: Named p wX wY -> Doc
description (NamedP PatchInfo
n [PatchInfo]
_ FL p wX wY
_) = PatchInfo -> Doc
displayPatchInfo PatchInfo
n
summary :: 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
$$ FL p wX wY -> Doc
forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL FL p wX wY
ps
summaryFL :: FL (Named p) wX wY -> Doc
summaryFL FL (Named p) wX wY
nps =
ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds Doc -> Doc -> Doc
$$ FL p wX wY -> 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 = [PatchInfo] -> [PatchInfo]
forall a. Ord a => [a] -> [a]
nubSort ([PatchInfo] -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ [[PatchInfo]] -> [PatchInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PatchInfo]] -> [PatchInfo]) -> [[PatchInfo]] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. Named p wW wZ -> [PatchInfo])
-> FL (Named p) wX wY -> [[PatchInfo]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. Named p wW wZ -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps FL (Named p) wX wY
nps
ps :: FL p wX wY
ps = FL (FL p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL p) wX wY -> FL p wX wY) -> FL (FL p) wX wY -> FL p wX wY
forall a b. (a -> b) -> a -> b
$ (forall wW wY. Named p wW wY -> FL p wW wY)
-> FL (Named p) wX wY -> FL (FL p) wX wY
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 wW wY. Named p wW wY -> FL p wW wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents FL (Named p) wX wY
nps
content :: 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
$$ FL p wX wY -> 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)