--  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.

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 () -- for ShowPatch FL instances

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 )

-- | 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
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
-- ^ @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) = 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

-- | 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
_) = 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'

-- 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 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'

{- | This instance takes care of handling the interaction between conflict
resolution and explicit dependencies. By definition, a conflict counts as
resolved if another patch depends on it. This principle extends to explicit
dependencies between 'Named' patches, but not to (aggregate) implicit
dependencies.

This means we count any patch inside a 'Named' patch as resolved if some
later 'Named' patch depends on it explicitly. The patches contained inside a
'Named' patch that is not explicitly depended on must be commuted one by one
past those we know are resolved. It is important to realize that we must not
do this commutation at the 'Named' patch level but at the level below that.
-}

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 the patch contents of an 'RL' of 'Named' patches into those
        -- we regard as resolved due to explicit dependencies on the containing
        -- 'Named' patch, and any others that can be commuted past them.
        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 =
            -- We are depended upon explicitly, so all patches in 'contents'
            -- are considered resolved.
            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 =
            -- We are not explicitly depended upon, so 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 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

        -- used to accumulate explicit dependencies
        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

-- 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 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)