-- Copyright (C) 2003-2004 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.

{- | Definitions used in this module:

[Explicit dependencies]: The set of patches that a (named) patch depends on
  "by name", i.e. irrespective of (non-)commutation (non commuting patches are
  implicit dependencies). The most important example are tags, but non-tag
  patches can also have explicit dependencies by recording them with
  --ask-deps.

[Covered]: A patch @p@ is covered by a tag @t@ if @t@ explicitly depends on
  @p@ or a tag covered by @t@ explicitly depends on @p@. In other words, the
  transitive closure of the relation "is depended on", restricted to
  situations where the right hand side is a tag. Note that it does /not/ take
  explicit dependencies of non-tag patches into account at all.

[Clean]: A tag @t@ in a repository is clean if all patches prior to the tag are
  covered by @t@. Tags normally start out as clean tags (the exception is
  if --ask-deps is used). It typically becomes unclean when it is merged into
  another repo (here the exceptions are if --reorder-patches is used, or if
  the target repo is actually a subset of the source repo).
-}

module Darcs.Patch.Depends
    ( getUncovered
    , areUnrelatedRepos
    , findCommon
    , findCommonWithThem
    , findUncommon
    , patchSetMerge
    , countUsThem
    , removeFromPatchSet
    , slightlyOptimizePatchset
    , fullyOptimizePatchSet
    , splitOnTag
    , patchSetUnion
    , patchSetIntersection
    , cleanLatestTag
    , contextPatches
    ) where

import Darcs.Prelude

import Control.Applicative ( (<|>) )
import Data.List ( delete, foldl1', intersect, (\\) )

import Darcs.Patch.Named ( getdeps )
import Darcs.Patch.Commute ( Commute )
import Darcs.Patch.Ident
    ( fastRemoveSubsequenceRL
    , findCommonRL
    , findCommonWithThemRL
    )
import Darcs.Patch.Info ( PatchInfo, isTag )
import Darcs.Patch.Merge ( Merge(..) )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.PatchInfoAnd( PatchInfoAnd, hopefully, info )
import Darcs.Patch.Set
    ( Origin
    , PatchSet(..)
    , SealedPatchSet
    , Tagged(..)
    , appendPSFL
    , emptyPatchSet
    , patchSet2FL
    , patchSet2RL
    , patchSetSplit
    )
import Darcs.Patch.Progress ( progressRL )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePStart )
import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Ordered
    ( (:\/:)(..), (:/\:)(..), (:>)(..), Fork(..),
    mapFL, RL(..), FL(..), isShorterThanRL, breakRL,
    (+<+), reverseFL, reverseRL, mapRL )
import Darcs.Patch.Witnesses.Sealed
    ( Sealed(..), seal )

{-|
Find clean tags that are common to both argument 'PatchSet's and return a
'Fork' with the common clean tags and whatever remains of the 'PatchSet's.
The two "uncommon" sequences may still have patches in common, even clean
tags, since we look only at the "known clean" tags of the second argument,
i.e. those that are the head of a 'Tagged' section.

This is a pretty efficient function, because it makes use of the
already-broken-up nature of 'PatchSet's.

Note that the first argument should be the repository that is more cheaply
accessed (i.e. local), as 'taggedIntersection' does its best to reduce the
number of inventories that are accessed from its second argument.
-}
taggedIntersection :: forall p wX wY . Commute p
                   => PatchSet p Origin wX -> PatchSet p Origin wY ->
                      Fork (RL (Tagged p))
                           (RL (PatchInfoAnd p))
                           (RL (PatchInfoAnd p)) Origin wX wY
taggedIntersection :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
ps1) PatchSet p Origin wY
s2 = RL (Tagged p) Origin Origin
-> RL (PatchInfoAnd p) Origin wX
-> RL (PatchInfoAnd p) Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (common :: * -> * -> *) (left :: * -> * -> *)
       (right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork RL (Tagged p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd p) wX wX
RL (PatchInfoAnd p) Origin wX
ps1 (PatchSet p Origin wY -> RL (PatchInfoAnd p) Origin wY
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wY
s2)
taggedIntersection PatchSet p Origin wX
s1 (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wY
ps2) = RL (Tagged p) Origin Origin
-> RL (PatchInfoAnd p) Origin wX
-> RL (PatchInfoAnd p) Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (common :: * -> * -> *) (left :: * -> * -> *)
       (right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork RL (Tagged p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL (PatchSet p Origin wX -> RL (PatchInfoAnd p) Origin wX
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wX
s1) RL (PatchInfoAnd p) wX wY
RL (PatchInfoAnd p) Origin wY
ps2
taggedIntersection PatchSet p Origin wX
s1 (PatchSet (RL (Tagged p) Origin wY
ts2 :<: Tagged RL (PatchInfoAnd p) wY wY
t2ps PatchInfoAnd p wY wX
t2 Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wY
ps2) =
  -- First try to find t2 in the heads of Tagged sections of s1;
  -- if that fails, try to reorder patches in s1 so that it does;
  -- otherwise t2 does not occur in s1, so recurse with the current
  -- Tagged section of s2 unwrapped.
  case PatchInfo -> PatchSet p Origin wX -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wStart wX.
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
maybeSplitSetOnTag (PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
t2) PatchSet p Origin wX
s1 Maybe (PatchSet p Origin wX)
-> Maybe (PatchSet p Origin wX) -> Maybe (PatchSet p Origin wX)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PatchInfo -> PatchSet p Origin wX -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag (PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
t2) PatchSet p Origin wX
s1 of
    Just (PatchSet RL (Tagged p) Origin wX
ts1 RL (PatchInfoAnd p) wX wX
ps1) -> RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX
-> RL (PatchInfoAnd p) wX wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (common :: * -> * -> *) (left :: * -> * -> *)
       (right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork RL (Tagged p) Origin wX
ts1 RL (PatchInfoAnd p) wX wX
ps1 (RL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wX wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RL (PatchInfoAnd p) wX wY
ps2)
    Maybe (PatchSet p Origin wX)
Nothing -> PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
s1 (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts2 (RL (PatchInfoAnd p) wY wY
t2ps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t2 RL (PatchInfoAnd p) wY wX
-> RL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wX wY
ps2))

-- |'maybeSplitSetOnTag' takes a tag's 'PatchInfo', @t0@, and a 'PatchSet' and
-- attempts to find @t0@ in one of the 'Tagged's in the PatchSet. If the tag is
-- found, the 'PatchSet' is split up, on that tag, such that all later patches
-- are in the "since last tag" patch list. If the tag is not found, 'Nothing'
-- is returned.
-- This is a simpler version of 'splitOnTag' that only looks at the heads
-- of 'Tagged' sections and does not commute any patches.
maybeSplitSetOnTag :: PatchInfo -> PatchSet p wStart wX
                   -> Maybe (PatchSet p wStart wX)
maybeSplitSetOnTag :: forall (p :: * -> * -> *) wStart wX.
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
maybeSplitSetOnTag PatchInfo
t0 origSet :: PatchSet p wStart wX
origSet@(PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
pst PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
ps)
    | PatchInfo
t0 PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
t = PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
Just PatchSet p wStart wX
origSet
    | Bool
otherwise = do
        PatchSet RL (Tagged p) Origin wX
ts' RL (PatchInfoAnd p) wX wX
ps' <- PatchInfo -> PatchSet p Origin wX -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wStart wX.
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
maybeSplitSetOnTag PatchInfo
t0 (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
pst RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t))
        PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
Just (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts' (RL (PatchInfoAnd p) wX wX
ps' RL (PatchInfoAnd p) wX wX
-> RL (PatchInfoAnd p) wX wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wX wX
ps)
maybeSplitSetOnTag PatchInfo
_ PatchSet p wStart wX
_ = Maybe (PatchSet p wStart wX)
forall a. Maybe a
Nothing

-- | Take a tag's 'PatchInfo', and a 'PatchSet', and attempt to find the tag in
-- the 'PatchSet'. If found, return a new 'PatchSet', in which the tag is now
-- clean (and the last of the 'Tagged' list), while all patches that are not
-- covered by the tag are in the trailing list of patches.
-- If the tag is not in the 'PatchSet', we return 'Nothing'.
splitOnTag :: Commute p => PatchInfo -> PatchSet p wStart wX
           -> Maybe (PatchSet p wStart wX)
-- If the tag we are looking for is the first Tagged tag of the patchset, we
-- are done.
splitOnTag :: forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag PatchInfo
t s :: PatchSet p wStart wX
s@(PatchSet (RL (Tagged p) Origin wY
_ :<: Tagged RL (PatchInfoAnd p) wY wY
_ PatchInfoAnd p wY wX
hp Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
_) | PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
hp PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
t = PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
Just PatchSet p wStart wX
s
-- If the tag is the most recent patch in the set, we check if the patch is the
-- only non-depended-on patch in the set (i.e. it is a clean tag); creating a
-- new Tagged out of the patches and tag, and adding it to the patchset, if
-- this is the case. Otherwise, we try to make the tag clean.
splitOnTag PatchInfo
t patchset :: PatchSet p wStart wX
patchset@(PatchSet RL (Tagged p) Origin wX
ts hps :: RL (PatchInfoAnd p) wX wX
hps@(RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wX
hp)) | PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
hp PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
t =
    if PatchSet p wStart wX -> [PatchInfo]
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered PatchSet p wStart wX
patchset [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo
t]
        then
          -- If t is the only patch not covered by any tag, then it is clean
          PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
Just (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet (RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wX -> RL (Tagged p) Origin wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wX -> Maybe InventoryHash -> Tagged p wX wX
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wY
ps PatchInfoAnd p wY wX
hp Maybe InventoryHash
forall a. Maybe a
Nothing) RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
        else
          -- Make it clean by commuting out patches not explicitly depended on
          -- by @t@; since we do this with just the trailing sequence @hps@ i.e.
          -- we don't include the tag of the next Tagged, we have to make an
          -- extra check to see if this tag is covered, too, and otherwise
          -- recurse with the next Tagged section unwrapped. Note that we cannot
          -- simply check if @t@ depends on this tag because it may depend
          -- indirectly via unclean tags contained in @hps@.
          case (forall wU wV. PatchInfoAnd p wU wV -> Bool)
-> RL (PatchInfoAnd p) wX wX
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wX wX
forall (p :: * -> * -> *) wX wY.
Commute p =>
(forall wU wV. p wU wV -> Bool)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
partitionRL ((PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (PatchInfo
t PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: Named p wY wX -> [PatchInfo]
forall wX wY. Named p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps (PatchInfoAnd p wY wX -> Named p wY wX
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully PatchInfoAnd p wY wX
hp))) (PatchInfo -> Bool)
-> (PatchInfoAnd p wU wV -> PatchInfo)
-> PatchInfoAnd p wU wV
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wU wV -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info) RL (PatchInfoAnd p) wX wX
hps of
            tagAndDeps :: RL (PatchInfoAnd p) wX wZ
tagAndDeps@(RL (PatchInfoAnd p) wX wY
ds' :<: PatchInfoAnd p wY wZ
hp') :> RL (PatchInfoAnd p) wZ wX
nonDeps ->
                -- check if t is now fully clean
                if PatchSet p Origin wZ -> [PatchInfo]
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wZ
tagAndDeps) [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo
t]
                    then let tagged :: Tagged p wX wZ
tagged = RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wY
ds' PatchInfoAnd p wY wZ
hp' Maybe InventoryHash
forall a. Maybe a
Nothing in
                         PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wZ
-> RL (PatchInfoAnd p) wZ wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet (RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wZ -> RL (Tagged p) Origin wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: Tagged p wX wZ
tagged) RL (PatchInfoAnd p) wZ wX
nonDeps
                    else do
                        PatchSet p Origin wZ
unfolded <- PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> Maybe (PatchSet p wX wY)
unwrapOneTagged (PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ))
-> PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wZ
tagAndDeps
                        PatchSet RL (Tagged p) Origin wX
ts' RL (PatchInfoAnd p) wX wZ
ps' <- PatchInfo -> PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag PatchInfo
t PatchSet p Origin wZ
unfolded
                        PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts' (RL (PatchInfoAnd p) wX wZ
ps' RL (PatchInfoAnd p) wX wZ
-> RL (PatchInfoAnd p) wZ wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wZ wX
nonDeps)
            (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wX wX
_ -> [Char] -> Maybe (PatchSet p wStart wX)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
-- We drop the leading patch, to try and find a non-Tagged tag.
splitOnTag PatchInfo
t (PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wX
p)) = do
    PatchSet RL (Tagged p) Origin wX
ns RL (PatchInfoAnd p) wX wY
xs <- PatchInfo -> PatchSet p Origin wY -> Maybe (PatchSet p Origin wY)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag PatchInfo
t (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps)
    PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ns (RL (PatchInfoAnd p) wX wY
xs RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
p)
-- If there are no patches left, we "unfold" the next Tagged, and try again.
splitOnTag PatchInfo
t0 patchset :: PatchSet p wStart wX
patchset@(PatchSet (RL (Tagged p) Origin wY
_ :<: Tagged RL (PatchInfoAnd p) wY wY
_ PatchInfoAnd p wY wX
_ Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
NilRL) =
    PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> Maybe (PatchSet p wX wY)
unwrapOneTagged PatchSet p wStart wX
patchset Maybe (PatchSet p wStart wX)
-> (PatchSet p wStart wX -> Maybe (PatchSet p wStart wX))
-> Maybe (PatchSet p wStart wX)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag PatchInfo
t0
-- If we've checked all the patches, but haven't found the tag, return Nothing.
splitOnTag PatchInfo
_ (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
NilRL) = Maybe (PatchSet p wStart wX)
forall a. Maybe a
Nothing

-- | Reorder a 'PatchSet' such that the latest tag becomes clean.
cleanLatestTag :: Commute p
               => PatchSet p wStart wX
               -> PatchSet p wStart wX
cleanLatestTag :: forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchSet p wStart wX -> PatchSet p wStart wX
cleanLatestTag inp :: PatchSet p wStart wX
inp@(PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
ps) =
  case (forall wA wB. PatchInfoAnd p wA wB -> Bool)
-> RL (PatchInfoAnd p) wX wX
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wX wX
forall (p :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> Bool)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
breakRL (PatchInfo -> Bool
isTag (PatchInfo -> Bool)
-> (PatchInfoAnd p wA wB -> PatchInfo)
-> PatchInfoAnd p wA wB
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wA wB -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info) RL (PatchInfoAnd p) wX wX
ps of
    RL (PatchInfoAnd p) wX wZ
NilRL :> RL (PatchInfoAnd p) wZ wX
_ -> PatchSet p wStart wX
inp -- no tag among the ps -> we are done
    (left :: RL (PatchInfoAnd p) wX wZ
left@(RL (PatchInfoAnd p) wX wY
_ :<: PatchInfoAnd p wY wZ
t) :> RL (PatchInfoAnd p) wZ wX
right) ->
      case PatchInfo -> PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag (PatchInfoAnd p wY wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wZ
t) (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wZ
left) of
        Just (PatchSet RL (Tagged p) Origin wX
ts' RL (PatchInfoAnd p) wX wZ
ps') -> RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts' (RL (PatchInfoAnd p) wX wZ
ps' RL (PatchInfoAnd p) wX wZ
-> RL (PatchInfoAnd p) wZ wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wZ wX
right)
        Maybe (PatchSet p Origin wZ)
_ -> [Char] -> PatchSet p wStart wX
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case" -- because t is in left

-- | Create a 'Tagged' section for every clean tag. For unclean tags we try to
-- make them clean, but only if that doesn't make an earlier clean tag dirty.
-- This means that the operation is idempotent and in particular monotonic,
-- which justifies the "optimize" in the name.
fullyOptimizePatchSet
  :: forall p wZ . Commute p => PatchSet p Origin wZ -> PatchSet p Origin wZ
fullyOptimizePatchSet :: forall (p :: * -> * -> *) wZ.
Commute p =>
PatchSet p Origin wZ -> PatchSet p Origin wZ
fullyOptimizePatchSet = PatchSet p Origin Origin
-> FL (PatchInfoAnd p) Origin wZ -> PatchSet p Origin wZ
forall wY.
PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
go PatchSet p Origin Origin
forall (p :: * -> * -> *). PatchSet p Origin Origin
emptyPatchSet (FL (PatchInfoAnd p) Origin wZ -> PatchSet p Origin wZ)
-> (PatchSet p Origin wZ -> FL (PatchInfoAnd p) Origin wZ)
-> PatchSet p Origin wZ
-> PatchSet p Origin wZ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet p Origin wZ -> FL (PatchInfoAnd p) Origin wZ
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> FL (PatchInfoAnd p) wStart wX
patchSet2FL
  where
    go :: PatchSet p Origin wY -> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
    go :: forall wY.
PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
go PatchSet p Origin wY
s FL (PatchInfoAnd p) wY wZ
NilFL = PatchSet p Origin wZ
PatchSet p Origin wY
s
    go s :: PatchSet p Origin wY
s@(PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps) (PatchInfoAnd p wY wY
q:>:FL (PatchInfoAnd p) wY wZ
qs)
      | PatchInfo -> Bool
isTag PatchInfo
qi, PatchSet p Origin wY -> [PatchInfo]
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered PatchSet p Origin wY
s' [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo
qi] =
          -- tag is clean
          PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
forall wY.
PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
go (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet (RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wY -> RL (Tagged p) Origin wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wY -> Maybe InventoryHash -> Tagged p wX wY
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wY
ps PatchInfoAnd p wY wY
q Maybe InventoryHash
forall a. Maybe a
Nothing) RL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL) FL (PatchInfoAnd p) wY wZ
qs
      | PatchInfo -> Bool
isTag PatchInfo
qi, Just PatchSet p Origin wY
s'' <- PatchSet p Origin wY
-> PatchInfoAnd p wY wY -> Maybe (PatchSet p Origin wY)
forall (p :: * -> * -> *) wY wZ.
Commute p =>
PatchSet p Origin wY
-> PatchInfoAnd p wY wZ -> Maybe (PatchSet p Origin wZ)
makeClean PatchSet p Origin wY
s PatchInfoAnd p wY wY
q = PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
forall wY.
PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
go PatchSet p Origin wY
s'' FL (PatchInfoAnd p) wY wZ
qs
      | Bool
otherwise = PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
forall wY.
PatchSet p Origin wY
-> FL (PatchInfoAnd p) wY wZ -> PatchSet p Origin wZ
go PatchSet p Origin wY
s' FL (PatchInfoAnd p) wY wZ
qs
      where
        qi :: PatchInfo
qi = PatchInfoAnd p wY wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wY
q
        s' :: PatchSet p Origin wY
s' = RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
psRL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wY -> RL (PatchInfoAnd p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd p wY wY
q)

-- | Take a 'PatchSet' and an adjacent tag and try to make the tag clean
-- by commuting out trailing patches that are not covered by the tag.
makeClean
  :: Commute p
  => PatchSet p Origin wY
  -> PatchInfoAnd p wY wZ
  -> Maybe (PatchSet p Origin wZ)
makeClean :: forall (p :: * -> * -> *) wY wZ.
Commute p =>
PatchSet p Origin wY
-> PatchInfoAnd p wY wZ -> Maybe (PatchSet p Origin wZ)
makeClean (PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps) PatchInfoAnd p wY wZ
t =
  let ti :: PatchInfo
ti = PatchInfoAnd p wY wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wZ
t in
  case (forall wU wV. PatchInfoAnd p wU wV -> Bool)
-> RL (PatchInfoAnd p) wX wZ
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wX wZ
forall (p :: * -> * -> *) wX wY.
Commute p =>
(forall wU wV. p wU wV -> Bool)
-> RL p wX wY -> (:>) (RL p) (RL p) wX wY
partitionRL ((PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (PatchInfo
ti PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: Named p wY wZ -> [PatchInfo]
forall wX wY. Named p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps (PatchInfoAnd p wY wZ -> Named p wY wZ
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully PatchInfoAnd p wY wZ
t))) (PatchInfo -> Bool)
-> (PatchInfoAnd p wU wV -> PatchInfo)
-> PatchInfoAnd p wU wV
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p wU wV -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info) (RL (PatchInfoAnd p) wX wY
ps RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> RL (PatchInfoAnd p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wZ
t) of
    tagAndDeps :: RL (PatchInfoAnd p) wX wZ
tagAndDeps@(RL (PatchInfoAnd p) wX wY
ds :<: PatchInfoAnd p wY wZ
t') :> RL (PatchInfoAnd p) wZ wZ
nonDeps ->
      -- check if tag really became clean
      if PatchSet p Origin wZ -> [PatchInfo]
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wZ
tagAndDeps) [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [PatchInfo
ti]
        then PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall a. a -> Maybe a
Just (PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ))
-> PatchSet p Origin wZ -> Maybe (PatchSet p Origin wZ)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wZ
-> RL (PatchInfoAnd p) wZ wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet (RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wZ -> RL (Tagged p) Origin wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wY
ds PatchInfoAnd p wY wZ
t' Maybe InventoryHash
forall a. Maybe a
Nothing) RL (PatchInfoAnd p) wZ wZ
nonDeps
        else Maybe (PatchSet p Origin wZ)
forall a. Maybe a
Nothing
    (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wX wZ
_ -> [Char] -> Maybe (PatchSet p Origin wZ)
forall a. HasCallStack => [Char] -> a
error [Char]
"imposible"

-- |'unwrapOneTagged' unfolds a single Tagged object in a PatchSet, adding the
-- tag and patches to the PatchSet's patch list.
unwrapOneTagged :: PatchSet p wX wY -> Maybe (PatchSet p wX wY)
unwrapOneTagged :: forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> Maybe (PatchSet p wX wY)
unwrapOneTagged (PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
tps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wY
ps) =
    PatchSet p wX wY -> Maybe (PatchSet p wX wY)
forall a. a -> Maybe a
Just (PatchSet p wX wY -> Maybe (PatchSet p wX wY))
-> PatchSet p wX wY -> Maybe (PatchSet p wX wY)
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
tps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t RL (PatchInfoAnd p) wY wX
-> RL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wX wY
ps)
unwrapOneTagged PatchSet p wX wY
_ = Maybe (PatchSet p wX wY)
forall a. Maybe a
Nothing

-- | Return the 'PatchInfo' for all the patches in a 'PatchSet' that are not
-- *explicitly* depended on by any tag (in the given 'PatchSet').
--
-- This is exactly the set of patches that a new tag recorded on top
-- of the 'PatchSet' would explicitly depend on.
--
-- Note that the result is not minimal with respect to dependencies, not even
-- explicit dependencies: explicit dependencies of regular (non-tag) patches
-- are completely ignored.
getUncovered :: PatchSet p wStart wX -> [PatchInfo]
getUncovered :: forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered (PatchSet RL (Tagged p) Origin wX
tagged RL (PatchInfoAnd p) wX wX
patches) =
  [(PatchInfo, [PatchInfo])] -> [PatchInfo]
forall a. Eq a => [(a, [a])] -> [a]
findUncovered ([(PatchInfo, [PatchInfo])] -> [PatchInfo])
-> [(PatchInfo, [PatchInfo])] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$
    case RL (Tagged p) Origin wX
tagged of
      RL (Tagged p) Origin wX
NilRL -> (forall wW wZ. PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo]))
-> RL (PatchInfoAnd p) wX wX -> [(PatchInfo, [PatchInfo])]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo])
forall wW wZ. PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo])
forall (p :: * -> * -> *) wX wY.
PatchInfoAnd p wX wY -> (PatchInfo, [PatchInfo])
infoAndExplicitDeps RL (PatchInfoAnd p) wX wX
patches
      RL (Tagged p) Origin wY
_ :<: Tagged RL (PatchInfoAnd p) wY wY
_ PatchInfoAnd p wY wX
t Maybe InventoryHash
_ -> (forall wW wZ. PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo]))
-> RL (PatchInfoAnd p) wX wX -> [(PatchInfo, [PatchInfo])]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo])
forall wW wZ. PatchInfoAnd p wW wZ -> (PatchInfo, [PatchInfo])
forall (p :: * -> * -> *) wX wY.
PatchInfoAnd p wX wY -> (PatchInfo, [PatchInfo])
infoAndExplicitDeps RL (PatchInfoAnd p) wX wX
patches [(PatchInfo, [PatchInfo])]
-> [(PatchInfo, [PatchInfo])] -> [(PatchInfo, [PatchInfo])]
forall a. [a] -> [a] -> [a]
++ [(PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
t, [])]
  where
    -- Both findUncovered and dropDepsIn are basically graph algorithms. We
    -- present the (directed, acyclic) graph as a topologically sorted list of
    -- vertices together with the targets of their outgoing edges. The problem
    -- findUncovered solves is to find all vertices with no incoming edges.
    -- This is done by removing all vertices reachable from any vertex in the
    -- graph.
    findUncovered :: Eq a => [(a, [a])] -> [a]
    findUncovered :: forall a. Eq a => [(a, [a])] -> [a]
findUncovered [] = []
    findUncovered ((a
pi, [a]
deps) : [(a, [a])]
rest) =
        a
pi a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [(a, [a])] -> [a]
forall a. Eq a => [(a, [a])] -> [a]
findUncovered ([a] -> [(a, [a])] -> [(a, [a])]
forall a. Eq a => [a] -> [(a, [a])] -> [(a, [a])]
dropDepsIn [a]
deps [(a, [a])]
rest)

    -- Remove the given list of vertices from the graph, as well as all
    -- vertices reachable from them.
    dropDepsIn :: Eq a => [a] -> [(a, [a])] -> [(a, [a])]
    dropDepsIn :: forall a. Eq a => [a] -> [(a, [a])] -> [(a, [a])]
dropDepsIn [] [(a, [a])]
ps = [(a, [a])]
ps
    dropDepsIn [a]
_  [] = []
    dropDepsIn [a]
ds (hp :: (a, [a])
hp@(a
hpi,[a]
hpds) : [(a, [a])]
ps)
        | a
hpi a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ds = [a] -> [(a, [a])] -> [(a, [a])]
forall a. Eq a => [a] -> [(a, [a])] -> [(a, [a])]
dropDepsIn (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
hpi [a]
ds [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
hpds) [(a, [a])]
ps
        | Bool
otherwise = (a, [a])
hp (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [a] -> [(a, [a])] -> [(a, [a])]
forall a. Eq a => [a] -> [(a, [a])] -> [(a, [a])]
dropDepsIn [a]
ds [(a, [a])]
ps

    -- The patch info together with the list of explicit dependencies in case
    -- it is a tag. This constructs one element of the graph representation.
    -- It cannot be used for the tag of a Tagged section as that may not be
    -- available in a lazy repo. That's okay because we already know it is
    -- clean, so no patches preceding it it can be uncovered.
    infoAndExplicitDeps :: PatchInfoAnd p wX wY -> (PatchInfo, [PatchInfo])
    infoAndExplicitDeps :: forall (p :: * -> * -> *) wX wY.
PatchInfoAnd p wX wY -> (PatchInfo, [PatchInfo])
infoAndExplicitDeps PatchInfoAnd p wX wY
p
        | PatchInfo -> Bool
isTag (PatchInfoAnd p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wY
p) = (PatchInfoAnd p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wY
p, Named p wX wY -> [PatchInfo]
forall wX wY. Named p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps (Named p wX wY -> [PatchInfo]) -> Named p wX wY -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully PatchInfoAnd p wX wY
p)
        | Bool
otherwise = (PatchInfoAnd p wX wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wY
p, [])

-- | Create a new 'Tagged' section for the most recent clean tag found in the
-- tail of un-'Tagged' patches without re-ordering patches. Note that earlier
-- tags may remain un-'Tagged' even if they are actually clean.
slightlyOptimizePatchset :: PatchSet p wStart wX -> PatchSet p wStart wX
slightlyOptimizePatchset :: forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> PatchSet p wStart wX
slightlyOptimizePatchset (PatchSet RL (Tagged p) Origin wX
ts0 RL (PatchInfoAnd p) wX wX
ps0) =
    PatchSet p wStart wX -> PatchSet p wStart wX
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> PatchSet p wStart wX
go (PatchSet p wStart wX -> PatchSet p wStart wX)
-> PatchSet p wStart wX -> PatchSet p wStart wX
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts0 ([Char] -> RL (PatchInfoAnd p) wX wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY. [Char] -> RL a wX wY -> RL a wX wY
progressRL [Char]
"Optimizing inventory" RL (PatchInfoAnd p) wX wX
ps0)
  where
    go :: PatchSet p wStart wY -> PatchSet p wStart wY
    go :: forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> PatchSet p wStart wX
go (PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
NilRL) = RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
    go s :: PatchSet p wStart wY
s@(PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wY
hp))
        | PatchInfo -> Bool
isTag (PatchInfoAnd p wY wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wY
hp)
        , [PatchInfoAnd p wY wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wY
hp] [PatchInfo] -> [PatchInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== PatchSet p wStart wY -> [PatchInfo]
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> [PatchInfo]
getUncovered PatchSet p wStart wY
s =
            RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet (RL (Tagged p) Origin wX
ts RL (Tagged p) Origin wX
-> Tagged p wX wY -> RL (Tagged p) Origin wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wY -> Maybe InventoryHash -> Tagged p wX wY
forall (p :: * -> * -> *) wX wY wZ.
RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wZ -> Maybe InventoryHash -> Tagged p wX wZ
Tagged RL (PatchInfoAnd p) wX wY
ps PatchInfoAnd p wY wY
hp Maybe InventoryHash
forall a. Maybe a
Nothing) RL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
        | Bool
otherwise = PatchSet p wStart wY
-> FL (PatchInfoAnd p) wY wY -> PatchSet p wStart wY
forall (p :: * -> * -> *) wStart wX wY.
PatchSet p wStart wX
-> FL (PatchInfoAnd p) wX wY -> PatchSet p wStart wY
appendPSFL (PatchSet p wStart wY -> PatchSet p wStart wY
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> PatchSet p wStart wX
go (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps)) (PatchInfoAnd p wY wY
hp PatchInfoAnd p wY wY
-> FL (PatchInfoAnd p) wY wY -> FL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)

removeFromPatchSet
  :: (Commute p, Eq2 p)
  => FL (PatchInfoAnd p) wX wY
  -> PatchSet p wStart wY
  -> Maybe (PatchSet p wStart wX)
removeFromPatchSet :: forall (p :: * -> * -> *) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY -> Maybe (PatchSet p wStart wX)
removeFromPatchSet FL (PatchInfoAnd p) wX wY
bad s :: PatchSet p wStart wY
s@(PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps)
  | (PatchInfo -> Bool) -> [PatchInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (PatchInfo -> [PatchInfo] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd p) wX wY -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info RL (PatchInfoAnd p) wX wY
ps) ((forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> FL (PatchInfoAnd p) wX wY -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info FL (PatchInfoAnd p) wX wY
bad) = do
    RL (PatchInfoAnd p) wX wX
ps' <- RL (PatchInfoAnd p) wX wY
-> RL (PatchInfoAnd p) wX wY -> Maybe (RL (PatchInfoAnd p) wX wX)
forall (p :: * -> * -> *) wY wZ wX.
(Commute p, Ident p) =>
RL p wY wZ -> RL p wX wZ -> Maybe (RL p wX wY)
fastRemoveSubsequenceRL (FL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wX wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd p) wX wY
bad) RL (PatchInfoAnd p) wX wY
ps
    PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wX
ps')
  | Bool
otherwise = FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY -> Maybe (PatchSet p wStart wX)
forall (p :: * -> * -> *) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY -> Maybe (PatchSet p wStart wX)
removeFromPatchSet FL (PatchInfoAnd p) wX wY
bad (PatchSet p wStart wY -> Maybe (PatchSet p wStart wX))
-> Maybe (PatchSet p wStart wY) -> Maybe (PatchSet p wStart wX)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PatchSet p wStart wY -> Maybe (PatchSet p wStart wY)
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> Maybe (PatchSet p wX wY)
unwrapOneTagged PatchSet p wStart wY
s

-- | The symmetric difference between two 'PatchSet's, expressed as a 'Fork'
-- consisting of the intersection 'PatchSet' and the trailing lists of
-- left-only and right-only patches.
--
-- From a purely functional point of view this is a symmetric function.
-- However, laziness effects make it asymmetric: the LHS is more likely to be
-- evaluated fully, while the RHS is evaluated as sparingly as possible. For
-- efficiency, the LHS should come from the local repo and the RHS from the
-- remote one. This asymmetry can also have a semantic effect, namely if
-- 'PatchSet's have *unavailable* patches or inventories, for instance when we
-- deal with a lazy clone of a repo that is no longer accessible. In this case
-- the order of arguments may determine whether the command fails or succeeds.
findCommon
  :: Commute p
  => PatchSet p Origin wX
  -> PatchSet p Origin wY
  -> Fork (PatchSet p) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) Origin wX wY
findCommon :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wX
     wY
findCommon PatchSet p Origin wX
us PatchSet p Origin wY
them =
  case PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
us PatchSet p Origin wY
them of
    Fork RL (Tagged p) Origin wU
common RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' ->
      case RL (PatchInfoAnd p) wU wX
-> RL (PatchInfoAnd p) wU wY
-> Fork
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     wU
     wX
     wY
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
RL p wX wY -> RL p wX wZ -> Fork (RL p) (RL p) (RL p) wX wY wZ
findCommonRL RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' of
        Fork RL (PatchInfoAnd p) wU wU
more_common RL (PatchInfoAnd p) wU wX
us'' RL (PatchInfoAnd p) wU wY
them'' ->
          PatchSet p Origin wU
-> FL (PatchInfoAnd p) wU wX
-> FL (PatchInfoAnd p) wU wY
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (common :: * -> * -> *) (left :: * -> * -> *)
       (right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork (RL (Tagged p) Origin wU
-> RL (PatchInfoAnd p) wU wU -> PatchSet p Origin wU
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wU
common RL (PatchInfoAnd p) wU wU
more_common) (RL (PatchInfoAnd p) wU wX -> FL (PatchInfoAnd p) wU wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wU wX
us'') (RL (PatchInfoAnd p) wU wY -> FL (PatchInfoAnd p) wU wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wU wY
them'')

findCommonWithThem
  :: Commute p
  => PatchSet p Origin wX
  -> PatchSet p Origin wY
  -> (PatchSet p :> FL (PatchInfoAnd p)) Origin wX
findCommonWithThem :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wX
us PatchSet p Origin wY
them =
  case PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
us PatchSet p Origin wY
them of
    Fork RL (Tagged p) Origin wU
common RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' ->
      case RL (PatchInfoAnd p) wU wX
-> RL (PatchInfoAnd p) wU wY
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wU wX
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
RL p wX wY -> RL p wX wZ -> (:>) (RL p) (RL p) wX wY
findCommonWithThemRL RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' of
        RL (PatchInfoAnd p) wU wZ
more_common :> RL (PatchInfoAnd p) wZ wX
us'' ->
          RL (Tagged p) Origin wU
-> RL (PatchInfoAnd p) wU wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wU
common RL (PatchInfoAnd p) wU wZ
more_common PatchSet p Origin wZ
-> FL (PatchInfoAnd p) wZ wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd p) wZ wX -> FL (PatchInfoAnd p) wZ wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wZ wX
us''

findUncommon
  :: Commute p
  => PatchSet p Origin wX
  -> PatchSet p Origin wY
  -> (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) wX wY
findUncommon :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
findUncommon PatchSet p Origin wX
us PatchSet p Origin wY
them =
  case PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
us PatchSet p Origin wY
them of
    Fork RL (Tagged p) Origin wU
_ RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' ->
      case (RL (PatchInfoAnd p) wU wX
-> RL (PatchInfoAnd p) wU wY
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wU wX
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
RL p wX wY -> RL p wX wZ -> (:>) (RL p) (RL p) wX wY
findCommonWithThemRL RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them', RL (PatchInfoAnd p) wU wY
-> RL (PatchInfoAnd p) wU wX
-> (:>) (RL (PatchInfoAnd p)) (RL (PatchInfoAnd p)) wU wY
forall (p :: * -> * -> *) wX wY wZ.
(Commute p, Ident p) =>
RL p wX wY -> RL p wX wZ -> (:>) (RL p) (RL p) wX wY
findCommonWithThemRL RL (PatchInfoAnd p) wU wY
them' RL (PatchInfoAnd p) wU wX
us') of
        (RL (PatchInfoAnd p) wU wZ
_ :> RL (PatchInfoAnd p) wZ wX
us'', RL (PatchInfoAnd p) wU wZ
_ :> RL (PatchInfoAnd p) wZ wY
them'') ->
          RL (PatchInfoAnd p) wZ wX -> FL (PatchInfoAnd p) wZ wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wZ wX
us'' FL (PatchInfoAnd p) wZ wX
-> FL (PatchInfoAnd p) wZ wY
-> (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PatchInfoAnd p) wZ wY -> FL (PatchInfoAnd p) wZ wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (RL (PatchInfoAnd p) wZ wY -> FL (PatchInfoAnd p) wZ wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wZ wY
them'')

countUsThem :: Commute p
            => PatchSet p Origin wX
            -> PatchSet p Origin wY
            -> (Int, Int)
countUsThem :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX -> PatchSet p Origin wY -> (Int, Int)
countUsThem PatchSet p Origin wX
us PatchSet p Origin wY
them =
    case PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
us PatchSet p Origin wY
them of
        Fork RL (Tagged p) Origin wU
_ RL (PatchInfoAnd p) wU wX
us' RL (PatchInfoAnd p) wU wY
them' -> let uu :: [PatchInfo]
uu = (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd p) wU wX -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info RL (PatchInfoAnd p) wU wX
us'
                                tt :: [PatchInfo]
tt = (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd p) wU wY -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info RL (PatchInfoAnd p) wU wY
them' in
                            ([PatchInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PatchInfo] -> Int) -> [PatchInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [PatchInfo]
uu [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo]
tt, [PatchInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PatchInfo] -> Int) -> [PatchInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [PatchInfo]
tt [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo]
uu)

patchSetMerge
  :: (Commute p, Merge p)
  => PatchSet p Origin wX
  -> PatchSet p Origin wY
  -> (FL (PatchInfoAnd p) :/\: FL (PatchInfoAnd p)) wX wY
patchSetMerge :: forall (p :: * -> * -> *) wX wY.
(Commute p, Merge p) =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:/\:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
patchSetMerge PatchSet p Origin wX
us PatchSet p Origin wY
them = (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
-> (:/\:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
forall wX wY.
(:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
-> (:/\:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
findUncommon PatchSet p Origin wX
us PatchSet p Origin wY
them)

-- | A 'PatchSet' consisting of the patches common to all input 'PatchSet's.
-- This is *undefined* for the empty list since intersection of 'PatchSet's
-- has no unit.
patchSetIntersection
  :: Commute p => [SealedPatchSet p Origin] -> SealedPatchSet p Origin
patchSetIntersection :: forall (p :: * -> * -> *).
Commute p =>
[SealedPatchSet p Origin] -> SealedPatchSet p Origin
patchSetIntersection = (SealedPatchSet p Origin
 -> SealedPatchSet p Origin -> SealedPatchSet p Origin)
-> [SealedPatchSet p Origin] -> SealedPatchSet p Origin
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SealedPatchSet p Origin
-> SealedPatchSet p Origin -> SealedPatchSet p Origin
forall {p :: * -> * -> *}.
Commute p =>
Sealed (PatchSet p Origin)
-> Sealed (PatchSet p Origin) -> Sealed (PatchSet p Origin)
go
  where
    go :: Sealed (PatchSet p Origin)
-> Sealed (PatchSet p Origin) -> Sealed (PatchSet p Origin)
go (Sealed PatchSet p Origin wX
ps) (Sealed PatchSet p Origin wX
acc) =
      case PatchSet p Origin wX
-> PatchSet p Origin wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wX
ps PatchSet p Origin wX
acc of
        PatchSet p Origin wZ
common :> FL (PatchInfoAnd p) wZ wX
_ -> PatchSet p Origin wZ -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wZ
common

-- | A 'PatchSet' consisting of the patches contained in any of the input
-- 'PatchSet's. The input 'PatchSet's are merged in left to right order, left
-- patches first.
patchSetUnion
  :: (Commute p, Merge p) => [SealedPatchSet p Origin] -> SealedPatchSet p Origin
-- You may consider simplifying this to a plain foldr'. However, this is
-- extremely inefficient because we have to build everything up from an empty
-- PatchSet. In principle this could be avoided by merging right patches first,
-- but then we get a failure in the conflict-chain-resolution test for darcs-1.
patchSetUnion :: forall (p :: * -> * -> *).
(Commute p, Merge p) =>
[SealedPatchSet p Origin] -> SealedPatchSet p Origin
patchSetUnion [] = PatchSet p Origin Origin -> SealedPatchSet p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin Origin
forall (p :: * -> * -> *). PatchSet p Origin Origin
emptyPatchSet
patchSetUnion [SealedPatchSet p Origin
x] = SealedPatchSet p Origin
x
patchSetUnion [SealedPatchSet p Origin]
xs = (SealedPatchSet p Origin
 -> SealedPatchSet p Origin -> SealedPatchSet p Origin)
-> [SealedPatchSet p Origin] -> SealedPatchSet p Origin
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' SealedPatchSet p Origin
-> SealedPatchSet p Origin -> SealedPatchSet p Origin
forall {p :: * -> * -> *}.
(Commute p, Merge p) =>
Sealed (PatchSet p Origin)
-> Sealed (PatchSet p Origin) -> Sealed (PatchSet p Origin)
go [SealedPatchSet p Origin]
xs
  where
    go :: Sealed (PatchSet p Origin)
-> Sealed (PatchSet p Origin) -> Sealed (PatchSet p Origin)
go (Sealed PatchSet p Origin wX
acc) (Sealed PatchSet p Origin wX
ps) =
      case PatchSet p Origin wX
-> PatchSet p Origin wX
-> (:/\:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wX
forall (p :: * -> * -> *) wX wY.
(Commute p, Merge p) =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:/\:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY
patchSetMerge PatchSet p Origin wX
acc PatchSet p Origin wX
ps of
        FL (PatchInfoAnd p) wX wZ
ps_only :/\: FL (PatchInfoAnd p) wX wZ
_ -> PatchSet p Origin wZ -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet p Origin wZ -> Sealed (PatchSet p Origin))
-> PatchSet p Origin wZ -> Sealed (PatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX
-> FL (PatchInfoAnd p) wX wZ -> PatchSet p Origin wZ
forall (p :: * -> * -> *) wStart wX wY.
PatchSet p wStart wX
-> FL (PatchInfoAnd p) wX wY -> PatchSet p wStart wY
appendPSFL PatchSet p Origin wX
acc FL (PatchInfoAnd p) wX wZ
ps_only

-- | Two 'PatchSet's are considered unrelated unless they share a common
-- inventory, or either 'PatchSet' has less than 5 patches, or they have at
-- least one patch in common.
areUnrelatedRepos
  :: Commute p => PatchSet p Origin wX -> PatchSet p Origin wY -> Bool
areUnrelatedRepos :: forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX -> PatchSet p Origin wY -> Bool
areUnrelatedRepos PatchSet p Origin wX
us PatchSet p Origin wY
them =
  case PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> Fork
     (RL (Tagged p))
     (RL (PatchInfoAnd p))
     (RL (PatchInfoAnd p))
     Origin
     wX
     wY
taggedIntersection PatchSet p Origin wX
us PatchSet p Origin wY
them of
    Fork RL (Tagged p) Origin wU
NilRL RL (PatchInfoAnd p) wU wX
u RL (PatchInfoAnd p) wU wY
t
      | RL (PatchInfoAnd p) wU wY
t RL (PatchInfoAnd p) wU wY -> Int -> Bool
forall (a :: * -> * -> *) wX wY. RL a wX wY -> Int -> Bool
`isShorterThanRL` Int
5 -> Bool
False
      | RL (PatchInfoAnd p) wU wX
u RL (PatchInfoAnd p) wU wX -> Int -> Bool
forall (a :: * -> * -> *) wX wY. RL a wX wY -> Int -> Bool
`isShorterThanRL` Int
5 -> Bool
False
      | Bool
otherwise -> [PatchInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PatchInfo] -> Bool) -> [PatchInfo] -> Bool
forall a b. (a -> b) -> a -> b
$ [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
intersect ((forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd p) wU wX -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info RL (PatchInfoAnd p) wU wX
u) ((forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd p) wU wY -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info RL (PatchInfoAnd p) wU wY
t)
    Fork
  (RL (Tagged p))
  (RL (PatchInfoAnd p))
  (RL (PatchInfoAnd p))
  Origin
  wX
  wY
_ -> Bool
False

-- | Split a 'PatchSet' at the latest clean tag. The left part is what comes
-- before the tag, the right part is the tag and its non-dependencies.
contextPatches :: PatchSet p wX wY
               -> (PatchSet p :> RL (PatchInfoAnd p)) wX wY
contextPatches :: forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
contextPatches = PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
patchSetSplit (PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY)
-> (PatchSet p wX wY -> PatchSet p wX wY)
-> PatchSet p wX wY
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet p wX wY -> PatchSet p wX wY
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> PatchSet p wStart wX
slightlyOptimizePatchset