--  Copyright (C) 2002-2003 David Roundy
--
--  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
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

-- | 'Named' patches group a set of changes with meta data ('PatchInfo') and
-- explicit dependencies (created using `darcs tag` or using --ask-deps).
--
-- While the data constructor 'NamedP' is exported for technical reasons, code
-- outside this modules should (and generally does) treat it as an abstract
-- data type. The only exception is the rebase implementation i.e. the modules
-- under "Darcs.Patch.Rebase".

{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Named
    ( Named(..)
    -- treated as abstract data type except by Darcs.Patch.Rebase
    , infopatch
    , adddeps
    , setinfo
    , anonymous
    , HasDeps(..)
    , patch2patchinfo
    , patchname
    , patchcontents
    , fmapNamed
    , fmapFL_Named
    , mergerIdNamed
    , ShowDepsFormat(..)
    , ShowWhichDeps(..)
    , 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(..), findConflicting )
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.Object ( ObjectId )
import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId )
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 () -- for ShowPatch FL instances

import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Ordered
    ( (:>)(..), (:\/:)(..), (:/\:)(..)
    , FL(..), RL(..), mapFL, mapRL, 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, redText )

-- | The @Named@ type adds a patch info about a patch, that is a name.
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
$cshowsPrec :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
Int -> Named p wX wY -> ShowS
showsPrec :: Int -> Named p wX wY -> ShowS
$cshow :: forall (p :: * -> * -> *) wX wY. Show2 p => Named p wX wY -> String
show :: Named p wX wY -> String
$cshowList :: forall (p :: * -> * -> *) wX wY.
Show2 p =>
[Named p wX wY] -> ShowS
showList :: [Named p wX wY] -> ShowS
Show
-- ^ @NamedP info deps p@ represents patch @p@ with name
-- @info@. @deps@ is a list of dependencies added at the named patch
-- level, compared with the unnamed level (ie, dependencies added with
-- @darcs record --ask-deps@).

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) = FL p wX wY -> FL (PrimOf (FL p)) wX wY
forall wX wY. 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 :: forall wX wY. Named p wX wY -> PatchId (Named p)
ident = Named p wX wY -> PatchInfo
Named p wX wY -> PatchId (Named p)
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo

instance IsHunk (Named p) where
    isHunk :: forall wX wY.
Named p wX wY -> Maybe (FileHunk (ObjectIdOfPatch (Named p)) wX wY)
isHunk Named p wX wY
_ = Maybe (FileHunk (ObjectIdOf (ApplyState p)) wX wY)
Maybe (FileHunk (ObjectIdOfPatch (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' = 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 :: 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 <- Parser (Sealed (FL p wX))
forall wX. 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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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) = FL p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
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 :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
Named p wX wY -> m ()
unapply (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
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 :: 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) = (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 a b. (a -> b) -> m a -> m b
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 (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
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 :: 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"]
  Named p wX wY -> IO (Named p wX wY)
forall a. a -> IO a
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 :: 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 = 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 wX wY. 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 :: 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 = 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

setinfo :: PatchInfo -> Named p wX wY -> Named p wX wY
setinfo :: forall (p :: * -> * -> *) wX wY.
PatchInfo -> Named p wX wY -> Named p wX wY
setinfo PatchInfo
i (NamedP PatchInfo
_ [PatchInfo]
ds FL 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
i [PatchInfo]
ds FL p wX wY
ps

-- | This slightly ad-hoc class is here so we can call 'getdeps' with patch
-- types that wrap a 'Named', such as 'RebaseChange'.
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
_) = 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 :: 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 = 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 Named p wW wY -> FL p wW wY
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 (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) = 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 p wW wY -> q wW wY
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) = 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 (Commute p, Eq2 p) => Eq2 (Named p) where
    unsafeCompare :: forall wA wB wC wD. Named p wA wB -> Named p wC wD -> Bool
unsafeCompare (NamedP PatchInfo
n1 [PatchInfo]
ds1 FL p wA wB
ps1) (NamedP PatchInfo
n2 [PatchInfo]
ds2 FL p wC wD
ps2) =
        PatchInfo
n1 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 Bool -> Bool -> Bool
&& [PatchInfo]
ds1 [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo]
ds2 Bool -> Bool -> Bool
&& FL p wA wB -> FL p wC wD -> Bool
forall wA wB wC wD. FL p wA wB -> FL p wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare FL p wA wB
ps1 FL p wC wD
ps2

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 PatchInfo -> [PatchInfo] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
d1 Bool -> Bool -> Bool
|| PatchInfo
n1 PatchInfo -> [PatchInfo] -> Bool
forall a. Eq a => a -> [a] -> 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 wX wY.
(:>) (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 a. a -> Maybe a
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 :: 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 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 wX wY.
(:\/:) (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 a. a -> Maybe a
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 :: 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 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 wX wY.
(:\/:) (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'

-- Merge an unnamed patch with a named patch.
-- This operation is safe even if the first patch is named, as names can
-- never conflict with each other.
-- This is in contrast with commuterIdNamed which is not safe and hence
-- is defined closer to the code that uses it.
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 MergeFn p1 p2 -> MergeFn p1 (FL p2)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (FL p2)
mergerIdFL (:\/:) p1 p2 wX wY -> (:/\:) p2 p1 wX wY
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'

{- | This instance takes care of handling the interaction between conflict
resolution and explicit dependencies. A conflict involves a set of two or
more patches and the general rule is that the conflict is considered
resolved if there is another (later) patch that (transitively) depends on
each of the (mutually) conflicting patches.

This principle extends to explicit dependencies between 'Named' patches. In
particular, recording a tag has the effect of resolving any as yet
unresolved conflicts in a repo.

In general a 'Named' patch contains multiple changes ( a "changeset").
Consider the named patches

@
  Named A [] a
  Named B [] (b1;b2)
  Named C [] c
  Named D [A,B] _
@

where, at the RepoPatch level, @a@ conflicts with @b1@, and @c@ with @b2@.
@D@ depends explicitly on both @A@ and @B@, so it fully covers the conflict
between @a@ and @b1@ and thus we would be justified to consider that
particular conflict as resolved. Unfortunately we cannot detect this at the
Named patch level because RepoPatchV1 and V2 have no notion of patch
identities. Thus, at the Named level the two underlying conflicts appear as
a single large conflict between the three named patches @A@, @B@, and @C@,
and this means that patch @D@ does /not/ count as a (partial) resolution
(even though it arguably should).

When we decide that a set of conflicting Named patches is resolved, we move
the RepoPatches contained in them to the context of the resolution. For all
other named patches, we must commute as much of their contents as possible
past the ones marked as resolved, using commutation at the RepoPatch level
(i.e. ignoring explicit dependencies). -}

instance ( Commute p
         , Conflict p
         , Summary p
         , PrimPatchBase p
         , PatchListFormat p
         , ShowPatch p
         ) =>
         Conflict (Named p) where
  isConflicted :: forall wX wY. Named p wX wY -> Bool
isConflicted (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
ps) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((forall wW wZ. p wW wZ -> Bool) -> FL p wX wY -> [Bool]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL p wW wZ -> Bool
forall wW wZ. p wW wZ -> Bool
forall (p :: * -> * -> *) wX wY. Conflict p => p wX wY -> Bool
isConflicted FL p wX wY
ps)
  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 Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) wO wX
-> RL (Named p) wX wY
-> FL p wY wY
-> FL p wY wY
-> (:>) (FL p) (FL p) wX wY
forall w0 w1 w2 w3 w4.
Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> 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) wO wX
context 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
resolved :> FL p wZ wY
unresolved ->
        RL p wO wZ -> RL p wZ wY -> [ConflictDetails (PrimOf p) wY]
forall wO wX wY.
RL p wO wX -> RL p wX 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
resolved) (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
unresolved)
    where
      -- Separate the patch contents of an 'RL' of 'Named' patches into those
      -- we regard as resolved due to explicit dependencies and any others.
      -- Implicit dependencies are kept with the resolved patches. The first
      -- parameter accumulates the PatchInfo of patches which we consider
      -- resolved; the second one accumulates direct and indirect explicit
      -- dependencies for the patches we have traversed. The third parameter
      -- is the context, which is only needed as input to 'findConflicting'.
      separate
        :: S.Set PatchInfo    -- names of resolved Named patches so far
        -> [S.Set PatchInfo]  -- transitive explicit dependencies so far
        -> RL (Named p) w0 w1 -- context for Named patches
        -> RL (Named p) w1 w2 -- Named patches under consideration
        -> FL p w2 w3         -- result: resolved at RepoPatch layer so far
        -> FL p w3 w4         -- result: unresolved at RepoPatch layer so far
        -> (FL p :> FL p) w1 w4
      separate :: forall w0 w1 w2 w3 w4.
Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate Set PatchInfo
acc_res [Set PatchInfo]
acc_deps RL (Named p) w0 w1
ctx (RL (Named p) w1 wY
ps :<: p :: Named p wY w2
p@(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_res Bool -> Bool -> Bool
|| Named p wY w2 -> Bool
forall wX wY. Named p wX wY -> Bool
forall (p :: * -> * -> *) wX wY. Conflict p => p wX wY -> Bool
isConflicted Named p wY w2
p
        , RL (Named p) w0 wZ
_ :> Named p wZ wZ
_ :> RL (Named p) wZ w2
conflicting <- RL (Named p) w0 wY
-> Named p wY w2
-> (:>) (RL (Named p)) (Named p :> RL (Named p)) w0 w2
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Conflict p, ShowPatch p) =>
RL p wX wY -> p wY wZ -> (:>) (RL p) (p :> RL p) wX wZ
findConflicting (RL (Named p) w0 w1
ctx RL (Named p) w0 w1 -> RL (Named p) w1 wY -> RL (Named p) w0 wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (Named p) w1 wY
ps) Named p wY w2
p
        , let conflict_ids :: Set PatchInfo
conflict_ids = [PatchInfo] -> Set PatchInfo
forall a. Ord a => [a] -> Set a
S.fromList ([PatchInfo] -> Set PatchInfo) -> [PatchInfo] -> Set PatchInfo
forall a b. (a -> b) -> a -> b
$ PatchInfo
name PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: (forall wW wZ. Named p wW wZ -> PatchInfo)
-> RL (Named p) wZ w2 -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL Named p wW wZ -> PatchInfo
Named p wW wZ -> PatchId (Named p)
forall wW wZ. Named p wW wZ -> PatchInfo
forall wX wY. Named p wX wY -> PatchId (Named p)
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident RL (Named p) wZ w2
conflicting
        , (Set PatchInfo -> Bool) -> [Set PatchInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Set PatchInfo
conflict_ids Set PatchInfo -> Set PatchInfo -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf`) [Set PatchInfo]
acc_deps =
          -- Either we already determined that p is considered resolved,
          -- or p is conflicted and all patches involved in the conflict are
          -- transitively explicitly depended upon by a single patch.
          -- The action is to regard everything in 'contents' as resolved.
          Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> RL (Named p) w1 wY
-> FL p wY w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
forall w0 w1 w2 w3 w4.
Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate (Set PatchInfo
acc_res Set PatchInfo -> Set PatchInfo -> Set PatchInfo
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set PatchInfo
conflict_ids) (PatchInfo -> [PatchInfo] -> [Set PatchInfo] -> [Set PatchInfo]
forall a. Ord a => a -> [a] -> [Set a] -> [Set a]
extend PatchInfo
name [PatchInfo]
deps [Set PatchInfo]
acc_deps)
            RL (Named p) w0 w1
ctx 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 =
          -- Commute as much as we can of our patch 'contents' past 'resolved',
          -- without dragging dependencies along.
          -- To use existing tools for commutation means we have to
          -- commuteWhatWeCan 'resolved' backwards through the 'contents',
          -- now /with/ dragging dependencies along.
          case CommuteFn p (FL p)
-> (:>) (RL p) (FL p) wY w3 -> (:>) (RL p) (FL p :> RL p) wY w3
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Commute p =>
CommuteFn p q
-> (:>) (RL p) q wX wY -> (:>) (RL p) (q :> RL p) wX wY
genCommuteWhatWeCanRL (CommuteFn p p -> CommuteFn p (FL p)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL (:>) p p wX wY -> Maybe ((:>) p p wX wY)
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
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> RL (Named p) w1 wY
-> FL p wY wZ
-> FL p wZ w4
-> (:>) (FL p) (FL p) w1 w4
forall w0 w1 w2 w3 w4.
Set PatchInfo
-> [Set PatchInfo]
-> RL (Named p) w0 w1
-> RL (Named p) w1 w2
-> FL p w2 w3
-> FL p w3 w4
-> (:>) (FL p) (FL p) w1 w4
separate Set PatchInfo
acc_res (PatchInfo -> [PatchInfo] -> [Set PatchInfo] -> [Set PatchInfo]
forall a. Ord a => a -> [a] -> [Set a] -> [Set a]
extend PatchInfo
name [PatchInfo]
deps [Set PatchInfo]
acc_deps) RL (Named p) w0 w1
ctx 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
_ [Set PatchInfo]
_ RL (Named p) w0 w1
_ RL (Named p) w1 w2
NilRL FL p w2 w3
resolved FL p w3 w4
unresolved = FL p w1 w3
FL p w2 w3
resolved FL p w1 w3 -> FL p w3 w4 -> (:>) (FL p) (FL p) w1 w4
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p w3 w4
unresolved

      -- Extend a list of sets of dependencies by adding the new list of
      -- dependencies to each set that contains the given 'name'. If 'name'
      -- does not occur in any of the sets, we add the dependencies as a new
      -- set to the list.
      -- Since we have to track whether 'name' was found in any of the input
      -- sets, this is not a straight-forward fold, so we use explicit
      -- recursion.
      extend :: Ord a => a -> [a] -> [S.Set a] -> [S.Set a]
      extend :: forall a. Ord a => a -> [a] -> [Set a] -> [Set a]
extend a
_ [] [Set a]
acc_deps = [Set a]
acc_deps
      extend a
name [a]
deps [Set a]
acc_deps = Bool -> Set a -> [Set a] -> [Set a]
go Bool
False ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
deps) [Set a]
acc_deps where
        go :: Bool -> Set a -> [Set a] -> [Set a]
go Bool
False Set a
new [] = [Set a
new]
        go Bool
True Set a
_ [] = []
        go Bool
found Set a
new (Set a
ds:[Set a]
dss)
          | a
name a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
ds = Set a
ds Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
new Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: Bool -> Set a -> [Set a] -> [Set a]
go Bool
True Set a
new [Set a]
dss
          | Bool
otherwise = Set a
ds Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: Bool -> Set a -> [Set a] -> [Set a]
go Bool
found Set a
new [Set a]
dss

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) = 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 p wW wY -> Unwound (PrimOf p) wW wY
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 :: forall wX wY. Named p wX wY -> [AnchoredPath]
listTouchedFiles (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> [AnchoredPath]
forall wX wY. FL p wX wY -> [AnchoredPath]
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) = (ByteString -> Bool) -> FL p wX wY -> Bool
forall wX wY. (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 :: forall wX wY.
Named p wX wY -> [IsConflictedPrim (PrimOf (Named p))]
conflictedEffect = FL p wX wY -> [IsConflictedPrim (PrimOf p)]
FL p wX wY -> [IsConflictedPrim (PrimOf (FL p))]
forall wX wY. FL p wX wY -> [IsConflictedPrim (PrimOf (FL 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 :: forall wX wY. Named p wX wY -> Maybe Doc
isInconsistent (NamedP PatchInfo
_ [PatchInfo]
_ FL p wX wY
p) = FL p wX wY -> Maybe Doc
forall wX wY. FL p wX wY -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent FL p wX wY
p

-- ForStorage: note the difference between use of <> when there are
-- no explicit dependencies vs. <+> when there are
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
$$ ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowWhichDeps
ShowNormalDeps 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> FL p wX wY -> Doc
forall wX wY. 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
         , ObjectId (ObjectIdOfPatch p)
         , ShowContextPatch p
         ) =>
         ShowContextPatch (Named p) where
    showPatchWithContextAndApply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
ShowPatchFor -> Named p wX wY -> m Doc
showPatchWithContextAndApply 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 (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
ShowPatchFor -> FL p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showPatchWithContextAndApply 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
$c== :: ShowDepsFormat -> ShowDepsFormat -> Bool
== :: ShowDepsFormat -> ShowDepsFormat -> Bool
$c/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
/= :: ShowDepsFormat -> ShowDepsFormat -> Bool
Eq)

-- | Support for rebase
data ShowWhichDeps = ShowNormalDeps | ShowDroppedDeps deriving (ShowWhichDeps -> ShowWhichDeps -> Bool
(ShowWhichDeps -> ShowWhichDeps -> Bool)
-> (ShowWhichDeps -> ShowWhichDeps -> Bool) -> Eq ShowWhichDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowWhichDeps -> ShowWhichDeps -> Bool
== :: ShowWhichDeps -> ShowWhichDeps -> Bool
$c/= :: ShowWhichDeps -> ShowWhichDeps -> Bool
/= :: ShowWhichDeps -> ShowWhichDeps -> Bool
Eq)

showDependencies :: ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies :: ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowWhichDeps
which 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 =
      case ShowDepsFormat
format of
        ShowDepsFormat
ShowDepsVerbose ->
          ShowWhichDeps -> ShowDepsFormat -> Doc
mark ShowWhichDeps
which ShowDepsFormat
format Doc -> Doc -> Doc
<+> String -> Doc
cyanText (SHA1 -> String
forall a. Show a => a -> String
show (PatchInfo -> SHA1
makePatchname PatchInfo
d)) Doc -> Doc -> Doc
$$
          String -> Doc
text String
"  *" Doc -> Doc -> Doc
<+> String -> Doc
text (PatchInfo -> String
piName PatchInfo
d)
        ShowDepsFormat
ShowDepsSummary ->
          ShowWhichDeps -> ShowDepsFormat -> Doc
mark ShowWhichDeps
which ShowDepsFormat
format Doc -> Doc -> Doc
<+>
          String -> Doc
cyanText (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 (SHA1 -> String
forall a. Show a => a -> String
show (PatchInfo -> SHA1
makePatchname PatchInfo
d))) Doc -> Doc -> Doc
<+> String -> Doc
text (PatchInfo -> String
piName PatchInfo
d)
    mark :: ShowWhichDeps -> ShowDepsFormat -> Doc
mark ShowWhichDeps
ShowNormalDeps ShowDepsFormat
ShowDepsVerbose = String -> Doc
blueText String
"depend"
    mark ShowWhichDeps
ShowDroppedDeps ShowDepsFormat
ShowDepsVerbose = String -> Doc
redText String
"dropped"
    mark ShowWhichDeps
ShowNormalDeps ShowDepsFormat
ShowDepsSummary = String -> Doc
text String
"D"
    mark ShowWhichDeps
ShowDroppedDeps ShowDepsFormat
ShowDepsSummary = String -> Doc
text String
"D!"

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) =
        ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowWhichDeps
ShowNormalDeps 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 :: forall wX wY. FL (Named p) wX wY -> Doc
summaryFL FL (Named p) wX wY
nps =
        ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowWhichDeps
ShowNormalDeps 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 Named p wW wZ -> [PatchInfo]
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 Named p wW wY -> FL p wW wY
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 :: forall wX wY. Named p wX wY -> Doc
content (NamedP PatchInfo
_ [PatchInfo]
ds FL p wX wY
ps) =
        ShowWhichDeps -> ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowWhichDeps
ShowNormalDeps 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)