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

{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}

-- | /First matcher, Second matcher and Nonrange matcher/
--
-- When we match for patches, we have a PatchSet, of which we want a
-- subset. This subset is formed by the patches in a given interval
-- which match a given criterion. If we represent time going left to
-- right, then we have (up to) three 'Matcher's:
--
-- * the 'firstMatcher' is the left bound of the interval,
--
-- * the 'secondMatcher' is the right bound, and
--
-- * the 'nonrangeMatcher' is the criterion we use to select among
--   patches in the interval.
---
-- Each of these matchers can be present or not according to the
-- options. The patches we want would then be the ones that all
-- present matchers have in common.
--
-- (Implementation note: keep in mind that the PatchSet is written
-- backwards with respect to the timeline, ie., from right to left)
module Darcs.Patch.Match
    (
      matchParser
    , helpOnMatchers
    , addInternalMatcher
    , matchFirstPatchset
    , matchSecondPatchset
    , splitSecondFL
    , matchPatch
    , matchAPatch
    , getNonrangeMatchS
    , firstMatch
    , secondMatch
    , haveNonrangeMatch
    , haveNonrangeExplicitMatch
    , havePatchsetMatch
    , checkMatchSyntax
    , applyInvToMatcher
    , nonrangeMatcher
    , InclusiveOrExclusive(..)
    , matchExists
    , applyNInv
    , hasIndexRange
    , getMatchingTag
    , matchAPatchset
    , getFirstMatchS
    , nonrangeMatcherIsTag
    , MatchFlag(..)
    ) where

import Prelude ()
import Darcs.Prelude

import Control.Exception ( throw )

import Text.ParserCombinators.Parsec
    ( parse
    , CharParser
    , (<?>)
    , (<|>)
    , noneOf
    , option
    , eof
    , many
    , try
    , between
    , spaces
    , char
    , oneOf
    , string
    , choice
    )
import Text.ParserCombinators.Parsec.Expr
    ( OperatorTable
    , Assoc( AssocLeft )
    , Operator ( Infix, Prefix )
    , buildExpressionParser
    )
import Text.Regex ( mkRegex, matchRegex )
import Data.Maybe ( isJust )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad ( when )
import Data.List ( isPrefixOf, intercalate )
import Data.Char ( toLower )

import Darcs.Util.Path ( AbsolutePath )
import Darcs.Patch
    ( IsRepoType
    , hunkMatches
    , listTouchedFiles
    , invert
    , invertRL
    , apply
    )
import Darcs.Patch.Info ( justName, justAuthor, justLog, makePatchname,
                          piDate )
import Darcs.Patch.Named.Wrapped
    ( WrappedNamed
    , patch2patchinfo
    )

import qualified Data.ByteString.Char8 as BC

import Darcs.Patch.Dummy ( DummyPatch )

import Darcs.Patch.Matchable ( Matchable )
import Darcs.Patch.MonadProgress ( MonadProgress )
import Darcs.Patch.Named.Wrapped ( runInternalChecker, namedIsInternal, namedInternalChecker )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, conscientiously, hopefully )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, patchSet2RL, Origin )
import Darcs.Patch.Type ( PatchType(..) )
import Darcs.Patch.Apply( Apply, ApplyState )
import Darcs.Patch.ApplyPatches( applyPatches )
import Darcs.Patch.Depends ( getPatchesBeyondTag, splitOnTag )
import Darcs.Patch.Invert( Invert )

import Darcs.Patch.Witnesses.Eq ( isIsEq )
import Darcs.Patch.Witnesses.Ordered ( RL(..), snocRLSealed, FL(..), (:>)(..) )
import Darcs.Patch.Witnesses.Sealed
    ( FlippedSeal(..), Sealed2(..),
    seal, flipSeal, seal2, unsealFlipped, unseal2, unseal )
import Darcs.Util.Printer ( text, ($$) )
import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )

import Darcs.Util.DateMatcher ( parseDateMatcher )

import Darcs.Util.Tree ( Tree )

-- | A type for predicates over patches which do not care about
-- contexts
type MatchFun rt p = Sealed2 (PatchInfoAnd rt p) -> Bool

-- | A @Matcher@ is made of a 'MatchFun' which we will use to match
-- patches and a @String@ representing it.
data Matcher rt p = MATCH String (MatchFun rt p)

instance Show (Matcher rt p) where
    show :: Matcher rt p -> String
show (MATCH s :: String
s _) = '"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\""


data MatchFlag =
                 OnePattern      String
               | SeveralPattern  String
               | AfterPattern    String
               | UpToPattern     String
               | OnePatch        String
               | OneHash         String
               | AfterHash       String
               | UpToHash        String
               | SeveralPatch    String
               | AfterPatch      String
               | UpToPatch       String
               | OneTag          String
               | AfterTag        String
               | UpToTag         String
               | LastN           Int
               | PatchIndexRange Int Int
               | Context AbsolutePath
                 deriving ( Int -> MatchFlag -> ShowS
[MatchFlag] -> ShowS
MatchFlag -> String
(Int -> MatchFlag -> ShowS)
-> (MatchFlag -> String)
-> ([MatchFlag] -> ShowS)
-> Show MatchFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchFlag] -> ShowS
$cshowList :: [MatchFlag] -> ShowS
show :: MatchFlag -> String
$cshow :: MatchFlag -> String
showsPrec :: Int -> MatchFlag -> ShowS
$cshowsPrec :: Int -> MatchFlag -> ShowS
Show )


makeMatcher :: String -> MatchFun rt p -> Matcher rt p
makeMatcher :: String -> MatchFun rt p -> Matcher rt p
makeMatcher = String -> MatchFun rt p -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
MATCH

-- | @applyMatcher@ applies a matcher to a patch.
applyMatcher :: Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher :: Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher (MATCH _ m :: MatchFun rt p
m) = MatchFun rt p
m MatchFun rt p
-> (PatchInfoAnd rt p wX wY -> Sealed2 (PatchInfoAnd rt p))
-> PatchInfoAnd rt p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> Sealed2 (PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2

parseMatch :: Matchable p => String -> Either String (MatchFun rt p)
parseMatch :: String -> Either String (MatchFun rt p)
parseMatch pattern :: String
pattern =
    case Parsec String () (MatchFun rt p)
-> String -> String -> Either ParseError (MatchFun rt p)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (MatchFun rt p)
forall (p :: * -> * -> *) st (rt :: RepoType).
Matchable p =>
CharParser st (MatchFun rt p)
matchParser "match" String
pattern of
    Left err :: ParseError
err -> String -> Either String (MatchFun rt p)
forall a b. a -> Either a b
Left (String -> Either String (MatchFun rt p))
-> String -> Either String (MatchFun rt p)
forall a b. (a -> b) -> a -> b
$ "Invalid --match pattern '"String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pattern String -> ShowS
forall a. [a] -> [a] -> [a]
++
                "'.\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("    "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err) -- indent
    Right m :: MatchFun rt p
m -> MatchFun rt p -> Either String (MatchFun rt p)
forall a b. b -> Either a b
Right MatchFun rt p
m

matchPattern :: Matchable p => String -> Matcher rt p
matchPattern :: String -> Matcher rt p
matchPattern pattern :: String
pattern =
    case String -> Either String (MatchFun rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Either String (MatchFun rt p)
parseMatch String
pattern of
    Left err :: String
err -> String -> Matcher rt p
forall a. HasCallStack => String -> a
error String
err
    Right m :: MatchFun rt p
m -> String -> MatchFun rt p -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
makeMatcher String
pattern MatchFun rt p
m

addInternalMatcher :: (IsRepoType rt) => Maybe (Matcher rt p) -> Maybe (Matcher rt p)
addInternalMatcher :: Maybe (Matcher rt p) -> Maybe (Matcher rt p)
addInternalMatcher om :: Maybe (Matcher rt p)
om =
  case Maybe (InternalChecker (WrappedNamed rt p))
forall (rt :: RepoType) (p :: * -> * -> *).
IsRepoType rt =>
Maybe (InternalChecker (WrappedNamed rt p))
namedInternalChecker of
    Nothing -> Maybe (Matcher rt p)
om
    Just f :: InternalChecker (WrappedNamed rt p)
f ->
         let matchFun :: Sealed2 (PatchInfoAnd rt p) -> Bool
matchFun = (forall wX wY. PatchInfoAnd rt p wX wY -> Bool)
-> Sealed2 (PatchInfoAnd rt p) -> Bool
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (Bool -> Bool
not (Bool -> Bool)
-> (PatchInfoAnd rt p wX wY -> Bool)
-> PatchInfoAnd rt p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqCheck wX wY -> Bool
forall wA wB. EqCheck wA wB -> Bool
isIsEq (EqCheck wX wY -> Bool)
-> (PatchInfoAnd rt p wX wY -> EqCheck wX wY)
-> PatchInfoAnd rt p wX wY
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalChecker (WrappedNamed rt p)
-> forall wX wY. WrappedNamed rt p wX wY -> EqCheck wX wY
forall (p :: * -> * -> *).
InternalChecker p -> forall wX wY. p wX wY -> EqCheck wX wY
runInternalChecker InternalChecker (WrappedNamed rt p)
f (WrappedNamed rt p wX wY -> EqCheck wX wY)
-> (PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY)
-> PatchInfoAnd rt p wX wY
-> EqCheck wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully)
         in case Maybe (Matcher rt p)
om of
            Nothing -> Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
Just (String -> (Sealed2 (PatchInfoAnd rt p) -> Bool) -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
MATCH "internal patch" Sealed2 (PatchInfoAnd rt p) -> Bool
matchFun)
            Just (MATCH s :: String
s oldFun :: Sealed2 (PatchInfoAnd rt p) -> Bool
oldFun) -> Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
Just (String -> (Sealed2 (PatchInfoAnd rt p) -> Bool) -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
MATCH String
s (\p :: Sealed2 (PatchInfoAnd rt p)
p -> Sealed2 (PatchInfoAnd rt p) -> Bool
matchFun Sealed2 (PatchInfoAnd rt p)
p Bool -> Bool -> Bool
&& Sealed2 (PatchInfoAnd rt p) -> Bool
oldFun Sealed2 (PatchInfoAnd rt p)
p))

matchParser :: Matchable p => CharParser st (MatchFun rt p)
matchParser :: CharParser st (MatchFun rt p)
matchParser = CharParser st (MatchFun rt p)
forall u (rt :: RepoType).
ParsecT String u Identity (MatchFun rt p)
submatcher CharParser st (MatchFun rt p)
-> String -> CharParser st (MatchFun rt p)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
helpfulErrorMsg
  where
    submatcher :: ParsecT String u Identity (MatchFun rt p)
submatcher = do
        MatchFun rt p
m <- MatchFun rt p
-> ParsecT String u Identity (MatchFun rt p)
-> ParsecT String u Identity (MatchFun rt p)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). MatchFun rt p
matchAnyPatch ParsecT String u Identity (MatchFun rt p)
forall (p :: * -> * -> *) st (rt :: RepoType).
Matchable p =>
CharParser st (MatchFun rt p)
submatch
        ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        MatchFun rt p -> ParsecT String u Identity (MatchFun rt p)
forall (m :: * -> *) a. Monad m => a -> m a
return MatchFun rt p
m

    -- When using <?>, Parsec prepends "expecting " to the given error message,
    -- so the phrasing below makes sense.
    helpfulErrorMsg :: String
helpfulErrorMsg = "valid expressions over: "
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " (((String, String, String, [String],
  String -> MatchFun Any DummyPatch)
 -> String)
-> [(String, String, String, [String],
     String -> MatchFun Any DummyPatch)]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(name :: String
name, _, _, _, _) -> String
name) [(String, String, String, [String],
  String -> MatchFun Any DummyPatch)]
forall (rt :: RepoType).
[(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
ps)
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\nfor more help, see `darcs help patterns`."

    -- This type signature is just to bind an ambiguous type var.
    ps :: [(String, String, String, [String], String -> MatchFun rt DummyPatch)]
    ps :: [(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
ps = [(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[(String, String, String, [String], String -> MatchFun rt p)]
primitiveMatchers

    -- matchAnyPatch is returned if submatch fails without consuming any
    -- input, i.e. if we pass --match '', we want to match anything.
    matchAnyPatch :: MatchFun rt p
    matchAnyPatch :: MatchFun rt p
matchAnyPatch = Bool -> MatchFun rt p
forall a b. a -> b -> a
const Bool
True

submatch :: Matchable p => CharParser st (MatchFun rt p)
submatch :: CharParser st (MatchFun rt p)
submatch = OperatorTable Char st (MatchFun rt p)
-> CharParser st (MatchFun rt p) -> CharParser st (MatchFun rt p)
forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser OperatorTable Char st (MatchFun rt p)
forall st (rt :: RepoType) (p :: * -> * -> *).
OperatorTable Char st (MatchFun rt p)
table CharParser st (MatchFun rt p)
forall (p :: * -> * -> *) st (rt :: RepoType).
Matchable p =>
CharParser st (MatchFun rt p)
match

table :: OperatorTable Char st (MatchFun rt p)
table :: OperatorTable Char st (MatchFun rt p)
table   = [ [String
-> (MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a) -> Operator Char st a
prefix "not" MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> t -> Bool
negate_match,
             String
-> (MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a) -> Operator Char st a
prefix "!" MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> t -> Bool
negate_match ]
          , [String
-> (MatchFun rt p -> MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a -> a) -> Operator Char st a
binary "||" MatchFun rt p -> MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
or_match,
             String
-> (MatchFun rt p -> MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a -> a) -> Operator Char st a
binary "or" MatchFun rt p -> MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
or_match,
             String
-> (MatchFun rt p -> MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a -> a) -> Operator Char st a
binary "&&" MatchFun rt p -> MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
and_match,
            String
-> (MatchFun rt p -> MatchFun rt p -> MatchFun rt p)
-> Operator Char st (MatchFun rt p)
forall a st. String -> (a -> a -> a) -> Operator Char st a
binary "and" MatchFun rt p -> MatchFun rt p -> MatchFun rt p
forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
and_match ]
          ]
    where binary :: String -> (a -> a -> a) -> Operator Char st a
binary name :: String
name fun :: a -> a -> a
fun = GenParser Char st (a -> a -> a) -> Assoc -> Operator Char st a
forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix (String -> (a -> a -> a) -> GenParser Char st (a -> a -> a)
forall b st. String -> b -> ParsecT String st Identity b
tryNameAndUseFun String
name a -> a -> a
fun) Assoc
AssocLeft
          prefix :: String -> (a -> a) -> Operator Char st a
prefix name :: String
name fun :: a -> a
fun = GenParser Char st (a -> a) -> Operator Char st a
forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix (GenParser Char st (a -> a) -> Operator Char st a)
-> GenParser Char st (a -> a) -> Operator Char st a
forall a b. (a -> b) -> a -> b
$ String -> (a -> a) -> GenParser Char st (a -> a)
forall b st. String -> b -> ParsecT String st Identity b
tryNameAndUseFun String
name a -> a
fun
          tryNameAndUseFun :: String -> b -> ParsecT String st Identity b
tryNameAndUseFun name :: String
name fun :: b
fun = do String
_ <- String -> CharParser st String
forall st. String -> CharParser st String
trystring String
name
                                         ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                         b -> ParsecT String st Identity b
forall (m :: * -> *) a. Monad m => a -> m a
return b
fun
          negate_match :: (t -> Bool) -> t -> Bool
negate_match a :: t -> Bool
a p :: t
p = Bool -> Bool
not (t -> Bool
a t
p)
          or_match :: (t -> Bool) -> (t -> Bool) -> t -> Bool
or_match m1 :: t -> Bool
m1 m2 :: t -> Bool
m2 p :: t
p = t -> Bool
m1 t
p Bool -> Bool -> Bool
|| t -> Bool
m2 t
p
          and_match :: (t -> Bool) -> (t -> Bool) -> t -> Bool
and_match m1 :: t -> Bool
m1 m2 :: t -> Bool
m2 p :: t
p = t -> Bool
m1 t
p Bool -> Bool -> Bool
&& t -> Bool
m2 t
p

trystring :: String -> CharParser st String
trystring :: String -> CharParser st String
trystring s :: String
s = CharParser st String -> CharParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s

match :: Matchable p => CharParser st (MatchFun rt p)
match :: CharParser st (MatchFun rt p)
match = ParsecT String st Identity ()
-> ParsecT String st Identity ()
-> CharParser st (MatchFun rt p)
-> CharParser st (MatchFun rt p)
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (CharParser st (MatchFun rt p) -> CharParser st (MatchFun rt p)
forall st (rt :: RepoType) (p :: * -> * -> *).
CharParser st (MatchFun rt p) -> CharParser st (MatchFun rt p)
parens CharParser st (MatchFun rt p)
forall (p :: * -> * -> *) st (rt :: RepoType).
Matchable p =>
CharParser st (MatchFun rt p)
submatch CharParser st (MatchFun rt p)
-> CharParser st (MatchFun rt p) -> CharParser st (MatchFun rt p)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [CharParser st (MatchFun rt p)] -> CharParser st (MatchFun rt p)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [CharParser st (MatchFun rt p)]
forall st (rt :: RepoType). [CharParser st (MatchFun rt p)]
matchers_)
  where
    matchers_ :: [CharParser st (MatchFun rt p)]
matchers_ = ((String, String, String, [String], String -> MatchFun rt p)
 -> CharParser st (MatchFun rt p))
-> [(String, String, String, [String], String -> MatchFun rt p)]
-> [CharParser st (MatchFun rt p)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, String, [String], String -> MatchFun rt p)
-> CharParser st (MatchFun rt p)
forall (rt :: RepoType) (p :: * -> * -> *) st.
(String, String, String, [String], String -> MatchFun rt p)
-> CharParser st (MatchFun rt p)
createMatchHelper [(String, String, String, [String], String -> MatchFun rt p)]
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[(String, String, String, [String], String -> MatchFun rt p)]
primitiveMatchers

createMatchHelper :: (String, String, String, [String], String -> MatchFun rt p)
                  -> CharParser st (MatchFun rt p)
createMatchHelper :: (String, String, String, [String], String -> MatchFun rt p)
-> CharParser st (MatchFun rt p)
createMatchHelper (key :: String
key,_,_,_,matcher :: String -> MatchFun rt p
matcher) =
  do String
_ <- String -> CharParser st String
forall st. String -> CharParser st String
trystring String
key
     ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
     String
q <- CharParser st String
forall st. CharParser st String
quoted
     MatchFun rt p -> CharParser st (MatchFun rt p)
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchFun rt p -> CharParser st (MatchFun rt p))
-> MatchFun rt p -> CharParser st (MatchFun rt p)
forall a b. (a -> b) -> a -> b
$ String -> MatchFun rt p
matcher String
q

-- | The string that is emitted when the user runs @darcs help patterns@.
helpOnMatchers :: [String]
helpOnMatchers :: [String]
helpOnMatchers =
  ["Selecting Patches:",
   "",
   "The --patches option yields patches with names matching an *extended*",
   "regular expression.  See regex(7) for details.  The --matches option",
   "yields patches that match a logical (Boolean) expression: one or more",
   "primitive expressions combined by grouping (parentheses) and the",
   "complement (not), conjunction (and) and disjunction (or) operators.",
   "The C notation for logic operators (!, && and ||) can also be used.",
   "",
   "- --patches=regex is a synonym for --matches='name regex'",
   "- --hash=HASH is a synonym for --matches='hash HASH'",
   "- --from-patch and --to-patch are synonyms for --from-match='name... and --to-match='name...",
   "- --from-patch and --to-match can be unproblematically combined:",
   "  `darcs log --from-patch='html.*documentation' --to-match='date 20040212'`",
   "",
   "The following primitive Boolean expressions are supported:"
   ,""]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
keywords
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["", "Here are some examples:", ""]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
examples
  where -- This type signature exists to appease GHC.
        ps :: [(String, String, String, [String], String -> MatchFun rt DummyPatch)]
        ps :: [(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
ps = [(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[(String, String, String, [String], String -> MatchFun rt p)]
primitiveMatchers
        keywords :: [String]
keywords = [String -> ShowS
showKeyword ([String] -> String
unwords [String
k,String
a]) String
d | (k :: String
k,a :: String
a,d :: String
d,_,_) <- [(String, String, String, [String],
  String -> MatchFun Any DummyPatch)]
forall (rt :: RepoType).
[(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
ps]
        examples :: [String]
examples = [String -> ShowS
showExample String
k String
e | (k :: String
k,_,_,es :: [String]
es,_) <- [(String, String, String, [String],
  String -> MatchFun Any DummyPatch)]
forall (rt :: RepoType).
[(String, String, String, [String],
  String -> MatchFun rt DummyPatch)]
ps, String
e <- [String]
es]
        showKeyword :: String -> ShowS
showKeyword keyword :: String
keyword description :: String
description =
            "  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
keyword String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
description String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
        showExample :: String -> ShowS
showExample keyword :: String
keyword example :: String
example =
            "  darcs log --match "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
keyword String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
example String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"

primitiveMatchers :: Matchable p => [(String, String, String, [String], String -> MatchFun rt p)]
                     -- ^ keyword (operator), argument name, help description, list
                     -- of examples, matcher function
primitiveMatchers :: [(String, String, String, [String], String -> MatchFun rt p)]
primitiveMatchers =
 [ ("exact", "STRING", "check literal STRING is equal to patch name"
           , ["\"Resolve issue17: use dynamic memory allocation.\""]
           , String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
exactmatch )
 , ("name", "REGEX", "match REGEX against patch name"
          , ["issue17", "\"^[Rr]esolve issue17\\>\""]
          , String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
namematch )
 , ("author", "REGEX", "match REGEX against patch author"
            , ["\"David Roundy\"", "droundy", "droundy@darcs.net"]
            , String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
authormatch )
 , ("hunk", "REGEX", "match REGEX against contents of a hunk patch"
            , ["\"foo = 2\"", "\"^instance .* Foo where$\""]
            , String -> MatchFun rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> MatchFun rt p
hunkmatch )
 , ("comment", "REGEX", "match REGEX against the full log message"
         , ["\"prevent deadlocks\""]
         , String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
logmatch )
 , ("hash", "HASH", "match HASH against (a prefix of) the hash of a patch"
          ,  ["c719567e92c3b0ab9eddd5290b705712b8b918ef","c7195"]
          ,  String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
hashmatch )
 , ("date", "DATE", "match DATE against the patch date"
          , ["\"2006-04-02 22:41\"", "\"tea time yesterday\""]
          , String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
datematch )
 , ("touch", "REGEX", "match file paths for a patch"
          , ["src/foo.c", "src/", "\"src/*.(c|h)\""]
          , String -> MatchFun rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> MatchFun rt p
touchmatch ) ]

parens :: CharParser st (MatchFun rt p)
       -> CharParser st (MatchFun rt p)
parens :: CharParser st (MatchFun rt p) -> CharParser st (MatchFun rt p)
parens = ParsecT String st Identity String
-> ParsecT String st Identity String
-> CharParser st (MatchFun rt p)
-> CharParser st (MatchFun rt p)
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "(") (String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ")")

quoted :: CharParser st String
quoted :: CharParser st String
quoted = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> CharParser st String
-> CharParser st String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"') (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"')
                 (ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char -> CharParser st String)
-> ParsecT String st Identity Char -> CharParser st String
forall a b. (a -> b) -> a -> b
$ do { Char
_ <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\' -- allow escapes
                            ; ParsecT String st Identity Char -> ParsecT String st Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "\\\"") ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String st Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\\'
                            }
                         ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\"")
         CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity ()
-> ParsecT String st Identity ()
-> CharParser st String
-> CharParser st String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char -> CharParser st String)
-> ParsecT String st Identity Char -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf " ()")
         CharParser st String -> String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "string"

datematch, hashmatch, authormatch, exactmatch, namematch, logmatch
  :: String -> MatchFun rt p

hunkmatch, touchmatch
  :: Matchable p => String -> MatchFun rt p

namematch :: String -> MatchFun rt p
namematch r :: String
r (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justName (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)

exactmatch :: String -> MatchFun rt p
exactmatch r :: String
r (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo -> String
justName (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)

authormatch :: String -> MatchFun rt p
authormatch a :: String
a (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
a) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justAuthor (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)

logmatch :: String -> MatchFun rt p
logmatch l :: String
l (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
l) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justLog (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)

hunkmatch :: String -> MatchFun rt p
hunkmatch r :: String
r (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = let regexMatcher :: ByteString -> Bool
regexMatcher = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool)
-> (ByteString -> Maybe [String]) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r) (String -> Maybe [String])
-> (ByteString -> String) -> ByteString -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack
                           in (ByteString -> Bool) -> PatchInfoAnd rt p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
regexMatcher PatchInfoAnd rt p wX wY
hp

hashmatch :: String -> MatchFun rt p
hashmatch h :: String
h (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = let rh :: String
rh = SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)
                               lh :: String
lh = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
h
                           in (String
lh String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
rh) Bool -> Bool -> Bool
|| (String
lh String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rh String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".gz")

datematch :: String -> MatchFun rt p
datematch d :: String
d (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = let dm :: CalendarTime -> Bool
dm = IO (CalendarTime -> Bool) -> CalendarTime -> Bool
forall a. IO a -> a
unsafePerformIO (IO (CalendarTime -> Bool) -> CalendarTime -> Bool)
-> IO (CalendarTime -> Bool) -> CalendarTime -> Bool
forall a b. (a -> b) -> a -> b
$ String -> IO (CalendarTime -> Bool)
parseDateMatcher String
d
                                  in CalendarTime -> Bool
dm (CalendarTime -> Bool) -> CalendarTime -> Bool
forall a b. (a -> b) -> a -> b
$ PatchInfo -> CalendarTime
piDate (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
hp)

touchmatch :: String -> MatchFun rt p
touchmatch r :: String
r (Sealed2 hp :: PatchInfoAnd rt p wX wY
hp) = let files :: [String]
files = PatchInfoAnd rt p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles PatchInfoAnd rt p wX wY
hp
                            in (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool)
-> (String -> Maybe [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r)) [String]
files

data InclusiveOrExclusive = Inclusive | Exclusive deriving InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
(InclusiveOrExclusive -> InclusiveOrExclusive -> Bool)
-> (InclusiveOrExclusive -> InclusiveOrExclusive -> Bool)
-> Eq InclusiveOrExclusive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
$c/= :: InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
== :: InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
$c== :: InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
Eq

data IncludeInternalPatches = IncludeInternalPatches | ExcludeInternalPatches
                              deriving IncludeInternalPatches -> IncludeInternalPatches -> Bool
(IncludeInternalPatches -> IncludeInternalPatches -> Bool)
-> (IncludeInternalPatches -> IncludeInternalPatches -> Bool)
-> Eq IncludeInternalPatches
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncludeInternalPatches -> IncludeInternalPatches -> Bool
$c/= :: IncludeInternalPatches -> IncludeInternalPatches -> Bool
== :: IncludeInternalPatches -> IncludeInternalPatches -> Bool
$c== :: IncludeInternalPatches -> IncludeInternalPatches -> Bool
Eq

-- | @haveNonrangeMatch flags@ tells whether there is a flag in
-- @flags@ which corresponds to a match that is "non-range". Thus,
-- @--match@, @--patch@, @--hash@ and @--index@ make @haveNonrangeMatch@
-- true, but not @--from-patch@ or @--to-patch@.
haveNonrangeMatch :: forall rt p . (IsRepoType rt, Matchable p)
                  => PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch :: PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch pt :: PatchType rt p
pt fs :: [MatchFlag]
fs = IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch' IncludeInternalPatches
IncludeInternalPatches PatchType rt p
pt [MatchFlag]
fs

-- | @haveNonrangeExplicitMatch flags@ is just like @haveNonrangeMatch flags@,
-- but ignores "internal matchers" used to mask "internal patches"
haveNonrangeExplicitMatch :: forall rt p . (IsRepoType rt, Matchable p)
                          => PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeExplicitMatch :: PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeExplicitMatch pt :: PatchType rt p
pt fs :: [MatchFlag]
fs = IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch' IncludeInternalPatches
ExcludeInternalPatches PatchType rt p
pt [MatchFlag]
fs

haveNonrangeMatch' :: forall rt p . (IsRepoType rt, Matchable p)
                   => IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch' :: IncludeInternalPatches -> PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeMatch' i :: IncludeInternalPatches
i _ fs :: [MatchFlag]
fs =
     case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of Just (m :: Int
m,n :: Int
n) | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> Bool
True; _ -> Bool
False
  Bool -> Bool -> Bool
|| Maybe (Matcher rt p) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Matcher rt p)
nonrangeMatch::Maybe (Matcher rt p))
    where
     nonrangeMatch :: Maybe (Matcher rt p)
nonrangeMatch | IncludeInternalPatches
i IncludeInternalPatches -> IncludeInternalPatches -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeInternalPatches
IncludeInternalPatches = [MatchFlag] -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher [MatchFlag]
fs
                   | Bool
otherwise = [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcherArgs [MatchFlag]
fs

-- | @havePatchsetMatch flags@ tells whether there is a "patchset
-- match" in the flag list. A patchset match is @--match@ or
-- @--patch@, or @--context@, but not @--from-patch@ nor (!)
-- @--index@.
-- Question: Is it supposed not to be a subset of @haveNonrangeMatch@?
havePatchsetMatch
  :: forall rt p
   . (IsRepoType rt, Matchable p)
  => PatchType rt p -> [MatchFlag] -> Bool
havePatchsetMatch :: PatchType rt p -> [MatchFlag] -> Bool
havePatchsetMatch _ fs :: [MatchFlag]
fs = Maybe (Matcher rt p) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher [MatchFlag]
fs::Maybe (Matcher rt p)) Bool -> Bool -> Bool
|| [MatchFlag] -> Bool
hasC [MatchFlag]
fs
    where hasC :: [MatchFlag] -> Bool
hasC [] = Bool
False
          hasC (Context _:_) = Bool
True
          hasC (_:xs :: [MatchFlag]
xs) = [MatchFlag] -> Bool
hasC [MatchFlag]
xs

getNonrangeMatchS :: ( ApplyMonad (ApplyState p) m, MonadProgress m
                     , IsRepoType rt, Matchable p, ApplyState p ~ Tree
                     )
                  => [MatchFlag]
                  -> PatchSet rt p Origin wX
                  -> m ()
getNonrangeMatchS :: [MatchFlag] -> PatchSet rt p Origin wX -> m ()
getNonrangeMatchS fs :: [MatchFlag]
fs repo :: PatchSet rt p Origin wX
repo =
    case [MatchFlag] -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher [MatchFlag]
fs of
        Just m :: Matcher rt p
m -> if [MatchFlag] -> Bool
nonrangeMatcherIsTag [MatchFlag]
fs
                        then Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p) =>
Matcher rt p -> PatchSet rt p Origin wX -> m ()
getTagS Matcher rt p
m PatchSet rt p Origin wX
repo
                        else InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, Matchable p) =>
InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
getMatcherS InclusiveOrExclusive
Exclusive Matcher rt p
m PatchSet rt p Origin wX
repo
        Nothing -> IOError -> m ()
forall a e. Exception e => e -> a
throw (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError "Pattern not specified in getNonrangeMatch."

-- | @firstMatch fs@ tells whether @fs@ implies a "first match", that
-- is if we match against patches from a point in the past on, rather
-- than against all patches since the creation of the repository.
firstMatch :: [MatchFlag] -> Bool
firstMatch :: [MatchFlag] -> Bool
firstMatch fs :: [MatchFlag]
fs = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs)
                 Bool -> Bool -> Bool
|| Maybe (Matcher Any DummyPatch) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Matcher rt DummyPatch)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
firstMatcher [MatchFlag]
fs::Maybe (Matcher rt DummyPatch))
                 Bool -> Bool -> Bool
|| Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs)

getFirstMatchS :: (ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p, IsRepoType rt)
               => [MatchFlag] -> PatchSet rt p Origin wX -> m ()
getFirstMatchS :: [MatchFlag] -> PatchSet rt p Origin wX -> m ()
getFirstMatchS fs :: [MatchFlag]
fs repo :: PatchSet rt p Origin wX
repo =
    case [MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs of
    Just n :: Int
n -> PatchSet rt p Origin wX -> Int -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, Invert p, ApplyMonad (ApplyState p) m, MonadProgress m,
 IsRepoType rt) =>
PatchSet rt p wX wY -> Int -> m ()
unpullLastN PatchSet rt p Origin wX
repo Int
n
    Nothing ->
     case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
     Just (_,b :: Int
b) -> PatchSet rt p Origin wX -> Int -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, Invert p, ApplyMonad (ApplyState p) m, MonadProgress m,
 IsRepoType rt) =>
PatchSet rt p wX wY -> Int -> m ()
unpullLastN PatchSet rt p Origin wX
repo Int
b -- b is chronologically earlier than a
     Nothing    ->
      case [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
firstMatcher [MatchFlag]
fs of
               Nothing -> IOError -> m ()
forall a e. Exception e => e -> a
throw (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError "Pattern not specified in getFirstMatchS."
               Just m :: Matcher rt p
m -> if [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs
                         then Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p) =>
Matcher rt p -> PatchSet rt p Origin wX -> m ()
getTagS Matcher rt p
m PatchSet rt p Origin wX
repo
                         else InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, Matchable p) =>
InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
getMatcherS InclusiveOrExclusive
Inclusive Matcher rt p
m PatchSet rt p Origin wX
repo

-- | @secondMatch fs@ tells whether @fs@ implies a "second match", that
-- is if we match against patches up to a point in the past on, rather
-- than against all patches until now.
secondMatch :: [MatchFlag] -> Bool
secondMatch :: [MatchFlag] -> Bool
secondMatch fs :: [MatchFlag]
fs = Maybe (Matcher Any DummyPatch) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Matcher rt DummyPatch)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
secondMatcher [MatchFlag]
fs::Maybe (Matcher rt DummyPatch)) Bool -> Bool -> Bool
|| Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs)

unpullLastN :: (Apply p, Invert p, ApplyMonad (ApplyState p) m, MonadProgress m, IsRepoType rt)
            => PatchSet rt p wX wY
            -> Int
            -> m ()
unpullLastN :: PatchSet rt p wX wY -> Int -> m ()
unpullLastN repo :: PatchSet rt p wX wY
repo n :: Int
n = forall wX wY. RL (PatchInfoAnd rt p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wR.
(Apply p, Invert p, ApplyMonad (ApplyState p) m,
 MonadProgress m) =>
RL (PatchInfoAnd rt p) wX wR -> m ()
applyInvRL (forall wX wY. RL (PatchInfoAnd rt p) wX wY -> m ())
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY -> m ()
forall (a :: * -> * -> *) b wZ.
(forall wX wY. a wX wY -> b) -> FlippedSeal a wZ -> b
`unsealFlipped` Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
safetake Int
n (PatchSet rt p wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p wX wY
repo)

checkMatchSyntax :: [MatchFlag] -> IO ()
checkMatchSyntax :: [MatchFlag] -> IO ()
checkMatchSyntax opts :: [MatchFlag]
opts =
 case [MatchFlag] -> Maybe String
getMatchPattern [MatchFlag]
opts of
  Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just p :: String
p  -> (String -> IO ())
-> (MatchFun Any DummyPatch -> IO ())
-> Either String (MatchFun Any DummyPatch)
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO ()
forall a e. Exception e => e -> a
throw (IOError -> IO ()) -> (String -> IOError) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError) (IO () -> MatchFun Any DummyPatch -> IO ()
forall a b. a -> b -> a
const (IO () -> MatchFun Any DummyPatch -> IO ())
-> IO () -> MatchFun Any DummyPatch -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (String -> Either String (MatchFun rt DummyPatch)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Either String (MatchFun rt p)
parseMatch String
p::Either String (MatchFun rt DummyPatch))

getMatchPattern :: [MatchFlag] -> Maybe String
getMatchPattern :: [MatchFlag] -> Maybe String
getMatchPattern [] = Maybe String
forall a. Maybe a
Nothing
getMatchPattern (OnePattern m :: String
m:_) = String -> Maybe String
forall a. a -> Maybe a
Just String
m
getMatchPattern (SeveralPattern m :: String
m:_) = String -> Maybe String
forall a. a -> Maybe a
Just String
m
getMatchPattern (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe String
getMatchPattern [MatchFlag]
fs

tagmatch :: String -> Matcher rt p
tagmatch :: String -> Matcher rt p
tagmatch r :: String
r = String -> MatchFun rt p -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
makeMatcher ("tag-name "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
r) MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). MatchFun rt p
tm
    where tm :: Sealed2 (PatchInfoAnd rt p) -> Bool
tm (Sealed2 p :: PatchInfoAnd rt p wX wY
p) =
              let n :: String
n = PatchInfo -> String
justName (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
p) in
              "TAG " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
n Bool -> Bool -> Bool
&& Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop 4 String
n)

patchmatch :: String -> Matcher rt p
patchmatch :: String -> Matcher rt p
patchmatch r :: String
r = String -> MatchFun rt p -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
makeMatcher ("patch-name "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
r) (String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
namematch String
r)

hashmatch' :: String -> Matcher rt p
hashmatch' :: String -> Matcher rt p
hashmatch' r :: String
r = String -> MatchFun rt p -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *).
String -> MatchFun rt p -> Matcher rt p
makeMatcher ("hash "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
r) (String -> MatchFun rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> MatchFun rt p
hashmatch String
r)


-- | strictJust is a strict version of the Just constructor, used to ensure
-- that if we claim we've got a pattern match, that the pattern will
-- actually match (rathern than fail to compile properly).
strictJust :: a -> Maybe a
strictJust :: a -> Maybe a
strictJust x :: a
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! a
x

-- | @nonrangeMatcher@ is the criterion that is used to match against
-- patches in the interval. It is 'Just m' when the @--patch@, @--match@,
-- @--tag@ options are passed (or their plural variants).
nonrangeMatcher :: (IsRepoType rt, Matchable p) => [MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcherArgs :: Matchable p => [MatchFlag] -> Maybe (Matcher rt p)

nonrangeMatcher :: [MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher fs :: [MatchFlag]
fs = Maybe (Matcher rt p) -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
IsRepoType rt =>
Maybe (Matcher rt p) -> Maybe (Matcher rt p)
addInternalMatcher (Maybe (Matcher rt p) -> Maybe (Matcher rt p))
-> Maybe (Matcher rt p) -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcherArgs [MatchFlag]
fs

nonrangeMatcherArgs :: [MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcherArgs [] = Maybe (Matcher rt p)
forall a. Maybe a
Nothing
nonrangeMatcherArgs (OnePattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
nonrangeMatcherArgs (OneTag t :: String
t:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
tagmatch String
t
nonrangeMatcherArgs (OnePatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
nonrangeMatcherArgs (OneHash h :: String
h:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
hashmatch' String
h
nonrangeMatcherArgs (SeveralPattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
nonrangeMatcherArgs (SeveralPatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
nonrangeMatcherArgs (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcherArgs [MatchFlag]
fs

-- | @nonrangeMatcherIsTag@ returns true if the matching option was
-- '--tag'
nonrangeMatcherIsTag :: [MatchFlag] -> Bool
nonrangeMatcherIsTag :: [MatchFlag] -> Bool
nonrangeMatcherIsTag [] = Bool
False
nonrangeMatcherIsTag (OneTag _:_) = Bool
True
nonrangeMatcherIsTag (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Bool
nonrangeMatcherIsTag [MatchFlag]
fs

-- | @firstMatcher@ returns the left bound of the matched interval.
-- This left bound is also specified when we use the singular versions
-- of @--patch@, @--match@ and @--tag@. Otherwise, @firstMatcher@
-- returns @Nothing@.
firstMatcher :: Matchable p => [MatchFlag] -> Maybe (Matcher rt p)
firstMatcher :: [MatchFlag] -> Maybe (Matcher rt p)
firstMatcher [] = Maybe (Matcher rt p)
forall a. Maybe a
Nothing
firstMatcher (OnePattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
firstMatcher (AfterPattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
firstMatcher (AfterTag t :: String
t:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
tagmatch String
t
firstMatcher (OnePatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
firstMatcher (AfterPatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
firstMatcher (OneHash h :: String
h:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
hashmatch' String
h
firstMatcher (AfterHash h :: String
h:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
hashmatch' String
h
firstMatcher (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
firstMatcher [MatchFlag]
fs

firstMatcherIsTag :: [MatchFlag] -> Bool
firstMatcherIsTag :: [MatchFlag] -> Bool
firstMatcherIsTag [] = Bool
False
firstMatcherIsTag (AfterTag _:_) = Bool
True
firstMatcherIsTag (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs

secondMatcher :: Matchable p => [MatchFlag] -> Maybe (Matcher rt p)
secondMatcher :: [MatchFlag] -> Maybe (Matcher rt p)
secondMatcher [] = Maybe (Matcher rt p)
forall a. Maybe a
Nothing
secondMatcher (OnePattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
secondMatcher (UpToPattern m :: String
m:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
String -> Matcher rt p
matchPattern String
m
secondMatcher (OnePatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
secondMatcher (UpToPatch p :: String
p:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
patchmatch String
p
secondMatcher (OneHash h :: String
h:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
hashmatch' String
h
secondMatcher (UpToHash h :: String
h:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
hashmatch' String
h
secondMatcher (UpToTag t :: String
t:_) = Matcher rt p -> Maybe (Matcher rt p)
forall a. a -> Maybe a
strictJust (Matcher rt p -> Maybe (Matcher rt p))
-> Matcher rt p -> Maybe (Matcher rt p)
forall a b. (a -> b) -> a -> b
$ String -> Matcher rt p
forall (rt :: RepoType) (p :: * -> * -> *). String -> Matcher rt p
tagmatch String
t
secondMatcher (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
secondMatcher [MatchFlag]
fs

secondMatcherIsTag :: [MatchFlag] -> Bool
secondMatcherIsTag :: [MatchFlag] -> Bool
secondMatcherIsTag [] = Bool
False
secondMatcherIsTag (UpToTag _:_) = Bool
True
secondMatcherIsTag (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Bool
secondMatcherIsTag [MatchFlag]
fs

-- | @matchAPatch fs p@ tells whether @p@ matches the matchers in
-- the flags @fs@
matchAPatch :: (IsRepoType rt, Matchable p) => [MatchFlag] -> PatchInfoAnd rt p wX wY -> Bool
matchAPatch :: [MatchFlag] -> PatchInfoAnd rt p wX wY -> Bool
matchAPatch fs :: [MatchFlag]
fs p :: PatchInfoAnd rt p wX wY
p =
  case [MatchFlag] -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher [MatchFlag]
fs of
    Nothing -> Bool
True
    Just m :: Matcher rt p
m -> Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wX wY
p

matchPatch :: (IsRepoType rt, Matchable p) => [MatchFlag] -> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
matchPatch :: [MatchFlag]
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
matchPatch fs :: [MatchFlag]
fs ps :: PatchSet rt p wStart wX
ps =
    case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
    Just (a :: Int
a,a' :: Int
a') | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a' -> case (forall wX.
 PatchSet rt p wStart wX -> Maybe (Sealed2 (PatchInfoAnd rt p)))
-> Sealed (PatchSet rt p wStart)
-> Maybe (Sealed2 (PatchInfoAnd rt p))
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX.
PatchSet rt p wStart wX -> Maybe (Sealed2 (PatchInfoAnd rt p))
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> Maybe (Sealed2 (PatchInfoAnd rt p))
myhead (Sealed (PatchSet rt p wStart)
 -> Maybe (Sealed2 (PatchInfoAnd rt p)))
-> Sealed (PatchSet rt p wStart)
-> Maybe (Sealed2 (PatchInfoAnd rt p))
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wStart)
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) PatchSet rt p wStart wX
ps of
                             Just (Sealed2 p :: PatchInfoAnd rt p wX wY
p) -> WrappedNamed rt p wX wY -> Sealed2 (WrappedNamed rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 (WrappedNamed rt p wX wY -> Sealed2 (WrappedNamed rt p))
-> WrappedNamed rt p wX wY -> Sealed2 (WrappedNamed rt p)
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wX wY
p
                             Nothing -> String -> Sealed2 (WrappedNamed rt p)
forall a. HasCallStack => String -> a
error "Patch out of range!"
                | Bool
otherwise -> String -> Sealed2 (WrappedNamed rt p)
forall a. String -> a
bug ("Invalid index range match given to matchPatch: "String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                    MatchFlag -> String
forall a. Show a => a -> String
show (Int -> Int -> MatchFlag
PatchIndexRange Int
a Int
a'))
                where myhead :: PatchSet rt p wStart wX -> Maybe (Sealed2 (PatchInfoAnd rt p))
                      myhead :: PatchSet rt p wStart wX -> Maybe (Sealed2 (PatchInfoAnd rt p))
myhead (PatchSet (_ :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ _) NilRL) = Sealed2 (PatchInfoAnd rt p) -> Maybe (Sealed2 (PatchInfoAnd rt p))
forall a. a -> Maybe a
Just (Sealed2 (PatchInfoAnd rt p)
 -> Maybe (Sealed2 (PatchInfoAnd rt p)))
-> Sealed2 (PatchInfoAnd rt p)
-> Maybe (Sealed2 (PatchInfoAnd rt p))
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wY wX -> Sealed2 (PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 PatchInfoAnd rt p wY wX
t
                      myhead (PatchSet _ (_:<:x :: PatchInfoAnd rt p wY wX
x)) = Sealed2 (PatchInfoAnd rt p) -> Maybe (Sealed2 (PatchInfoAnd rt p))
forall a. a -> Maybe a
Just (Sealed2 (PatchInfoAnd rt p)
 -> Maybe (Sealed2 (PatchInfoAnd rt p)))
-> Sealed2 (PatchInfoAnd rt p)
-> Maybe (Sealed2 (PatchInfoAnd rt p))
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wY wX -> Sealed2 (PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 PatchInfoAnd rt p wY wX
x
                      myhead _ = Maybe (Sealed2 (PatchInfoAnd rt p))
forall a. Maybe a
Nothing
    Nothing -> case [MatchFlag] -> Maybe (Matcher rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> Maybe (Matcher rt p)
nonrangeMatcher [MatchFlag]
fs of
                    Nothing -> String -> Sealed2 (WrappedNamed rt p)
forall a. String -> a
bug "Couldn't matchPatch"
                    Just m :: Matcher rt p
m -> Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch Matcher rt p
m PatchSet rt p wStart wX
ps

-- | @hasLastn fs@ return the @--last@ argument in @fs@, if any.
hasLastn :: [MatchFlag] -> Maybe Int
hasLastn :: [MatchFlag] -> Maybe Int
hasLastn [] = Maybe Int
forall a. Maybe a
Nothing
hasLastn (LastN (-1):_) = String -> Maybe Int
forall a. HasCallStack => String -> a
error "--last requires a positive integer argument."
hasLastn (LastN n :: Int
n:_) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
hasLastn (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs

hasIndexRange :: [MatchFlag] -> Maybe (Int,Int)
hasIndexRange :: [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [] = Maybe (Int, Int)
forall a. Maybe a
Nothing
hasIndexRange (PatchIndexRange x :: Int
x y :: Int
y:_) = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x,Int
y)
hasIndexRange (_:fs :: [MatchFlag]
fs) = [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs

-- | @matchFirstPatchset fs ps@ returns the part of @ps@ before its
-- first matcher, ie the one that comes first dependencywise. Hence,
-- patches in @matchFirstPatchset fs ps@ are the context for the ones
-- we don't want.
matchFirstPatchset :: (IsRepoType rt, Matchable p) => [MatchFlag] -> PatchSet rt p wStart wX
                   -> SealedPatchSet rt p wStart
matchFirstPatchset :: [MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchFirstPatchset fs :: [MatchFlag]
fs patchset :: PatchSet rt p wStart wX
patchset =
    case [MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs of
    Just n :: Int
n -> Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn Int
n PatchSet rt p wStart wX
patchset
    Nothing ->
        case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
        Just (_,b :: Int
b) -> Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn Int
b PatchSet rt p wStart wX
patchset
        Nothing ->
               case [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
firstMatcher [MatchFlag]
fs of
               Nothing -> String -> SealedPatchSet rt p wStart
forall a. String -> a
bug "Couldn't matchFirstPatchset"
               Just m :: Matcher rt p
m -> (forall wX. PatchSet rt p wStart wX -> SealedPatchSet rt p wStart)
-> SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn 1) (SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart)
-> SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ if [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs
                                            then Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher rt p
m PatchSet rt p wStart wX
patchset
                                            else Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher rt p
m PatchSet rt p wStart wX
patchset

-- | @dropn n ps@ drops the @n@ last patches from @ps@.
dropn :: IsRepoType rt => Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn :: Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn n :: Int
n ps :: PatchSet rt p wStart wX
ps | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p wStart wX
ps
dropn n :: Int
n (PatchSet (ts :: RL (Tagged rt p) wStart wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn Int
n (PatchSet rt p wStart wX -> SealedPatchSet rt p wStart)
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) wStart wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t)
dropn _ (PatchSet NilRL NilRL) = PatchSet rt p wStart wStart -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p wStart wStart -> SealedPatchSet rt p wStart)
-> PatchSet rt p wStart wStart -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) wStart wStart
-> RL (PatchInfoAnd rt p) wStart wStart
-> PatchSet rt p wStart wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wStart
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wStart wStart
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
dropn n :: Int
n (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p))
    | EqCheck wY wX -> Bool
forall wA wB. EqCheck wA wB -> Bool
isIsEq (WrappedNamed rt p wY wX -> EqCheck wY wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal (PatchInfoAnd rt p wY wX -> WrappedNamed rt p wY wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wY wX
p))
   = Int -> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn Int
n (PatchSet rt p wStart wY -> SealedPatchSet rt p wStart)
-> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps
dropn n :: Int
n (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:_)) = Int -> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (PatchSet rt p wStart wY -> SealedPatchSet rt p wStart)
-> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps

-- | @matchSecondPatchset fs ps@ returns the part of @ps@ before its
-- second matcher, ie the one that comes last dependencywise.
matchSecondPatchset :: (IsRepoType rt, Matchable p) => [MatchFlag] -> PatchSet rt p wStart wX
                    -> SealedPatchSet rt p wStart
matchSecondPatchset :: [MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchSecondPatchset fs :: [MatchFlag]
fs ps :: PatchSet rt p wStart wX
ps =
  case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
  Just (a :: Int
a,_) -> Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
IsRepoType rt =>
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
dropn (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) PatchSet rt p wStart wX
ps
  Nothing ->
    case [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
secondMatcher [MatchFlag]
fs of
    Nothing -> String -> SealedPatchSet rt p wStart
forall a. String -> a
bug "Couldn't matchSecondPatchset"
    Just m :: Matcher rt p
m -> if [MatchFlag] -> Bool
secondMatcherIsTag [MatchFlag]
fs
              then Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher rt p
m PatchSet rt p wStart wX
ps
              else Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher rt p
m PatchSet rt p wStart wX
ps

-- | Split on the second matcher. Note that this picks up the first match starting from
-- the earliest patch in a sequence, as opposed to 'matchSecondPatchset' which picks up the
-- first match starting from the latest patch
splitSecondFL :: Matchable p
              => (forall wA wB . q wA wB -> Sealed2 (PatchInfoAnd rt p))
              -> [MatchFlag]
              -> FL q wX wY
              -> (FL q :> FL q) wX wY -- ^The first element is the patches before and including the first patch matching the second matcher,
                                      --  the second element is the patches after it
splitSecondFL :: (forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> [MatchFlag] -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitSecondFL extract :: forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
extract fs :: [MatchFlag]
fs ps :: FL q wX wY
ps =
   case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
   Just _ -> -- selecting the last n doesn't really make sense if we're starting from the earliest patches
             String -> (:>) (FL q) (FL q) wX wY
forall a. String -> a
bug "index matches not supported by splitSecondPatchesFL"
   Nothing ->
     case [MatchFlag] -> Maybe (Matcher rt p)
forall (p :: * -> * -> *) (rt :: RepoType).
Matchable p =>
[MatchFlag] -> Maybe (Matcher rt p)
secondMatcher [MatchFlag]
fs of
     Nothing -> String -> (:>) (FL q) (FL q) wX wY
forall a. String -> a
bug "Couldn't splitSecondPatches"
     Just m :: Matcher rt p
m -> (forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> Matcher rt p -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
forall (p :: * -> * -> *) (q :: * -> * -> *) (rt :: RepoType) wX
       wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> Matcher rt p -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
extract Matcher rt p
m FL q wX wY
ps

-- | @findAPatch m ps@ returns the last patch in @ps@ matching @m@, and
-- calls 'error' if there is none.
findAPatch :: Matchable p => Matcher rt p -> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch :: Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch m :: Matcher rt p
m (PatchSet NilRL NilRL) = String -> Sealed2 (WrappedNamed rt p)
forall a. HasCallStack => String -> a
error (String -> Sealed2 (WrappedNamed rt p))
-> String -> Sealed2 (WrappedNamed rt p)
forall a b. (a -> b) -> a -> b
$ "Couldn't find patch matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher rt p -> String
forall a. Show a => a -> String
show Matcher rt p
m
findAPatch m :: Matcher rt p
m (PatchSet (ts :: RL (Tagged rt p) wStart wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch Matcher rt p
m (RL (Tagged rt p) wStart wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
findAPatch m :: Matcher rt p
m (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p)) | Matcher rt p -> PatchInfoAnd rt p wY wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wY wX
p = WrappedNamed rt p wY wX -> Sealed2 (WrappedNamed rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2 (WrappedNamed rt p wY wX -> Sealed2 (WrappedNamed rt p))
-> WrappedNamed rt p wY wX -> Sealed2 (WrappedNamed rt p)
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wY wX -> WrappedNamed rt p wY wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wY wX
p
                                    | Bool
otherwise = Matcher rt p
-> PatchSet rt p wStart wY -> Sealed2 (WrappedNamed rt p)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch Matcher rt p
m (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps)

-- | @matchAPatchset m ps@ returns a prefix of @ps@
-- ending in a patch matching @m@, and calls 'error' if there is none.
matchAPatchset :: Matchable p => Matcher rt p -> PatchSet rt p wStart wX
               -> SealedPatchSet rt p wStart
matchAPatchset :: Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset m :: Matcher rt p
m (PatchSet NilRL NilRL) = String -> SealedPatchSet rt p wStart
forall a. HasCallStack => String -> a
error (String -> SealedPatchSet rt p wStart)
-> String -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ "Couldn't find patch matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher rt p -> String
forall a. Show a => a -> String
show Matcher rt p
m
matchAPatchset m :: Matcher rt p
m (PatchSet (ts :: RL (Tagged rt p) wStart wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher rt p
m (RL (Tagged rt p) wStart wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
matchAPatchset m :: Matcher rt p
m (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p)) | Matcher rt p -> PatchInfoAnd rt p wY wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wY wX
p = PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts (RL (PatchInfoAnd rt p) wX wY
psRL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
p))
                                        | Bool
otherwise = Matcher rt p
-> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher rt p
m (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps)

-- | @getMatchingTag m ps@, where @m@ is a 'Matcher' which matches tags
-- returns a 'SealedPatchSet' containing all patches in the last tag which
-- matches @m@. Last tag means the most recent tag in repository order,
-- i.e. the last one you'd see if you ran darcs log -t @m@. Calls
-- 'error' if there is no matching tag.
getMatchingTag :: Matchable p => Matcher rt p -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag :: Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag m :: Matcher rt p
m (PatchSet NilRL NilRL) = String -> SealedPatchSet rt p wStart
forall a. HasCallStack => String -> a
error (String -> SealedPatchSet rt p wStart)
-> String -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ "Couldn't find a tag matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher rt p -> String
forall a. Show a => a -> String
show Matcher rt p
m
getMatchingTag m :: Matcher rt p
m (PatchSet (ts :: RL (Tagged rt p) wStart wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher rt p
m (RL (Tagged rt p) wStart wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
getMatchingTag m :: Matcher rt p
m (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p))
    | Matcher rt p -> PatchInfoAnd rt p wY wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wY wX
p =
        -- found a non-clean tag, need to commute out the things that it doesn't depend on
        case PatchInfo
-> PatchSet rt p wStart wX
-> Maybe ((:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wStart wX)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX
-> Maybe ((:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wStart wX)
splitOnTag (PatchInfoAnd rt p wY wX -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wY wX
p) (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts (RL (PatchInfoAnd rt p) wX wY
psRL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
p)) of
            Nothing -> String -> SealedPatchSet rt p wStart
forall a. String -> a
bug "splitOnTag couldn't find tag we explicitly provided!"
            Just (patchSet :: PatchSet rt p wStart wZ
patchSet :> _) -> PatchSet rt p wStart wZ -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p wStart wZ
patchSet
    | Bool
otherwise = Matcher rt p
-> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher rt p
m (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps)

splitMatchFL :: Matchable p => (forall wA wB . q wA wB -> Sealed2 (PatchInfoAnd rt p)) -> Matcher rt p -> FL q wX wY -> (FL q :> FL q) wX wY
splitMatchFL :: (forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> Matcher rt p -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL _extract :: forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
_extract m :: Matcher rt p
m NilFL = String -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => String -> a
error (String -> (:>) (FL q) (FL q) wX wY)
-> String -> (:>) (FL q) (FL q) wX wY
forall a b. (a -> b) -> a -> b
$ "Couldn't find patch matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher rt p -> String
forall a. Show a => a -> String
show Matcher rt p
m
splitMatchFL extract :: forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
extract m :: Matcher rt p
m (p :: q wX wY
p :>: ps :: FL q wY wY
ps)
   | (forall wX wY. PatchInfoAnd rt p wX wY -> Bool)
-> Sealed2 (PatchInfoAnd rt p) -> Bool
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m) (Sealed2 (PatchInfoAnd rt p) -> Bool)
-> (q wX wY -> Sealed2 (PatchInfoAnd rt p)) -> q wX wY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q wX wY -> Sealed2 (PatchInfoAnd rt p)
forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
extract (q wX wY -> Bool) -> q wX wY -> Bool
forall a b. (a -> b) -> a -> b
$ q wX wY
p = (q wX wY
p q wX wY -> FL q wY wY -> FL q wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL q wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) FL q wX wY -> FL q wY wY -> (:>) (FL q) (FL q) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL q wY wY
ps
   | Bool
otherwise = case (forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> Matcher rt p -> FL q wY wY -> (:>) (FL q) (FL q) wY wY
forall (p :: * -> * -> *) (q :: * -> * -> *) (rt :: RepoType) wX
       wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p))
-> Matcher rt p -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL forall wA wB. q wA wB -> Sealed2 (PatchInfoAnd rt p)
extract Matcher rt p
m FL q wY wY
ps of
                    before :: FL q wY wZ
before :> after :: FL q wZ wY
after -> (q wX wY
p q wX wY -> FL q wY wZ -> FL q wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL q wY wZ
before) FL q wX wZ -> FL q wZ wY -> (:>) (FL q) (FL q) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL q wZ wY
after

-- | @matchExists m ps@ tells whether there is a patch matching
-- @m@ in @ps@
matchExists :: Matcher rt p -> PatchSet rt p wStart wX -> Bool
matchExists :: Matcher rt p -> PatchSet rt p wStart wX -> Bool
matchExists _ (PatchSet NilRL NilRL) = Bool
False
matchExists m :: Matcher rt p
m (PatchSet (ts :: RL (Tagged rt p) wStart wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = Matcher rt p -> PatchSet rt p wStart wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Matcher rt p -> PatchSet rt p wStart wX -> Bool
matchExists Matcher rt p
m (RL (Tagged rt p) wStart wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p wStart wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
matchExists m :: Matcher rt p
m (PatchSet ts :: RL (Tagged rt p) wStart wX
ts (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p)) | Matcher rt p -> PatchInfoAnd rt p wY wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wY wX
p = Bool
True
                                     | Bool
otherwise = Matcher rt p -> PatchSet rt p wStart wY -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Matcher rt p -> PatchSet rt p wStart wX -> Bool
matchExists Matcher rt p
m (RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) wStart wX
ts RL (PatchInfoAnd rt p) wX wY
ps)

applyInvToMatcher :: (Matchable p, ApplyMonad (ApplyState p) m)
                  => InclusiveOrExclusive -> Matcher rt p -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher :: InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher _ _ (PatchSet NilRL NilRL) = m ()
forall a. a
impossible
applyInvToMatcher ioe :: InclusiveOrExclusive
ioe m :: Matcher rt p
m (PatchSet (ts :: RL (Tagged rt p) Origin wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) = InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(Matchable p, ApplyMonad (ApplyState p) m) =>
InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher InclusiveOrExclusive
ioe Matcher rt p
m
                                                                  (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
applyInvToMatcher ioe :: InclusiveOrExclusive
ioe m :: Matcher rt p
m (PatchSet xs :: RL (Tagged rt p) Origin wX
xs (ps :: RL (PatchInfoAnd rt p) wX wY
ps:<:p :: PatchInfoAnd rt p wY wX
p))
    | Matcher rt p -> PatchInfoAnd rt p wY wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Matcher rt p -> PatchInfoAnd rt p wX wY -> Bool
applyMatcher Matcher rt p
m PatchInfoAnd rt p wY wX
p = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InclusiveOrExclusive
ioe InclusiveOrExclusive -> InclusiveOrExclusive -> Bool
forall a. Eq a => a -> a -> Bool
== InclusiveOrExclusive
Inclusive) (PatchInfoAnd rt p wY wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, Invert p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp PatchInfoAnd rt p wY wX
p)
    | Bool
otherwise = PatchInfoAnd rt p wY wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, Invert p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp PatchInfoAnd rt p wY wX
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(Matchable p, ApplyMonad (ApplyState p) m) =>
InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher InclusiveOrExclusive
ioe Matcher rt p
m (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wX
xs RL (PatchInfoAnd rt p) wX wY
ps)

-- | @applyNInv@ n ps applies the inverse of the last @n@ patches of @ps@.
applyNInv :: (Matchable p, ApplyMonad (ApplyState p) m) => Int -> PatchSet rt p Origin wX -> m ()
applyNInv :: Int -> PatchSet rt p Origin wX -> m ()
applyNInv n :: Int
n _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyNInv _ (PatchSet NilRL NilRL) = String -> m ()
forall a. HasCallStack => String -> a
error "Index out of range."
applyNInv n :: Int
n (PatchSet (ts :: RL (Tagged rt p) Origin wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) NilRL) =
  Int -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(Matchable p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv Int
n (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
applyNInv n :: Int
n (PatchSet xs :: RL (Tagged rt p) Origin wX
xs (ps :: RL (PatchInfoAnd rt p) wX wY
ps :<: p :: PatchInfoAnd rt p wY wX
p)) =
  PatchInfoAnd rt p wY wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, Invert p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp PatchInfoAnd rt p wY wX
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PatchSet rt p Origin wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(Matchable p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wX
xs RL (PatchInfoAnd rt p) wX wY
ps)


getMatcherS :: (ApplyMonad (ApplyState p) m, Matchable p) =>
                 InclusiveOrExclusive -> Matcher rt p -> PatchSet rt p Origin wX -> m ()
getMatcherS :: InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
getMatcherS ioe :: InclusiveOrExclusive
ioe m :: Matcher rt p
m repo :: PatchSet rt p Origin wX
repo =
    if Matcher rt p -> PatchSet rt p Origin wX -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Matcher rt p -> PatchSet rt p wStart wX -> Bool
matchExists Matcher rt p
m PatchSet rt p Origin wX
repo
    then InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(Matchable p, ApplyMonad (ApplyState p) m) =>
InclusiveOrExclusive
-> Matcher rt p -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher InclusiveOrExclusive
ioe Matcher rt p
m PatchSet rt p Origin wX
repo
    else IOError -> m ()
forall a e. Exception e => e -> a
throw (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ "Couldn't match pattern "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher rt p -> String
forall a. Show a => a -> String
show Matcher rt p
m

getTagS :: (ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p) =>
             Matcher rt p -> PatchSet rt p Origin wX -> m ()
getTagS :: Matcher rt p -> PatchSet rt p Origin wX -> m ()
getTagS matcher :: Matcher rt p
matcher repo :: PatchSet rt p Origin wX
repo = do
    let pinfo :: PatchInfo
pinfo = forall wX wY. WrappedNamed rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> PatchInfo
patch2patchinfo (forall wX wY. WrappedNamed rt p wX wY -> PatchInfo)
-> Sealed2 (WrappedNamed rt p) -> PatchInfo
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
`unseal2` Matcher rt p
-> PatchSet rt p Origin wX -> Sealed2 (WrappedNamed rt p)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Matchable p =>
Matcher rt p
-> PatchSet rt p wStart wX -> Sealed2 (WrappedNamed rt p)
findAPatch Matcher rt p
matcher PatchSet rt p Origin wX
repo
    case PatchInfo
-> PatchSet rt p Origin wX
-> FlippedSeal (RL (PatchInfoAnd rt p)) wX
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX
-> FlippedSeal (RL (PatchInfoAnd rt p)) wX
getPatchesBeyondTag PatchInfo
pinfo PatchSet rt p Origin wX
repo of
        FlippedSeal extras :: RL (PatchInfoAnd rt p) wX wX
extras -> RL (PatchInfoAnd rt p) wX wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wR.
(Apply p, Invert p, ApplyMonad (ApplyState p) m,
 MonadProgress m) =>
RL (PatchInfoAnd rt p) wX wR -> m ()
applyInvRL RL (PatchInfoAnd rt p) wX wX
extras

-- | @applyInvp@ tries to get the patch that's in a 'PatchInfoAnd
-- patch', and to apply its inverse. If we fail to fetch the patch
-- then we share our sorrow with the user.
applyInvp :: (Apply p, Invert p, ApplyMonad (ApplyState p) m) => PatchInfoAnd rt p wX wY -> m ()
applyInvp :: PatchInfoAnd rt p wX wY -> m ()
applyInvp hp :: PatchInfoAnd rt p wX wY
hp = WrappedNamed rt p wY wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply (WrappedNamed rt p wX wY -> WrappedNamed rt p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (WrappedNamed rt p wX wY -> WrappedNamed rt p wY wX)
-> WrappedNamed rt p wX wY -> WrappedNamed rt p wY wX
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wX wY -> WrappedNamed rt p wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
fromHopefully PatchInfoAnd rt p wX wY
hp)
    where fromHopefully :: PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
fromHopefully = (Doc -> Doc) -> PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
(Doc -> Doc) -> PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
conscientiously ((Doc -> Doc)
 -> PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB)
-> (Doc -> Doc)
-> PatchInfoAnd rt p wA wB
-> WrappedNamed rt p wA wB
forall a b. (a -> b) -> a -> b
$ \e :: Doc
e ->
                     String -> Doc
text "Sorry, patch not available:"
                     Doc -> Doc -> Doc
$$ Doc
e
                     Doc -> Doc -> Doc
$$ String -> Doc
text ""
                     Doc -> Doc -> Doc
$$ String -> Doc
text "If you think what you're trying to do is ok then"
                     Doc -> Doc -> Doc
$$ String -> Doc
text "report this as a bug on the darcs-user list."

-- | a version of 'take' for 'RL' lists that cater for contexts.
safetake :: IsRepoType rt => Int -> RL (PatchInfoAnd rt p) wX wY -> FlippedSeal (RL (PatchInfoAnd rt p)) wY
safetake :: Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
safetake 0 _ = RL (PatchInfoAnd rt p) wY wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
safetake _ NilRL = String -> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall a. HasCallStack => String -> a
error "There aren't that many patches..."
safetake i :: Int
i (as :: RL (PatchInfoAnd rt p) wX wY
as:<:a :: PatchInfoAnd rt p wY wY
a) | EqCheck wY wY -> Bool
forall wA wB. EqCheck wA wB -> Bool
isIsEq (WrappedNamed rt p wY wY -> EqCheck wY wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal (PatchInfoAnd rt p wY wY -> WrappedNamed rt p wY wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wY wY
a)) = Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
safetake Int
i RL (PatchInfoAnd rt p) wX wY
as FlippedSeal (RL (PatchInfoAnd rt p)) wY
-> PatchInfoAnd rt p wY wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (a :: * -> * -> *) wY wZ.
FlippedSeal (RL a) wY -> a wY wZ -> FlippedSeal (RL a) wZ
`snocRLSealed` PatchInfoAnd rt p wY wY
a
safetake i :: Int
i (as :: RL (PatchInfoAnd rt p) wX wY
as:<:a :: PatchInfoAnd rt p wY wY
a) = Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
Int
-> RL (PatchInfoAnd rt p) wX wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
safetake (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) RL (PatchInfoAnd rt p) wX wY
as FlippedSeal (RL (PatchInfoAnd rt p)) wY
-> PatchInfoAnd rt p wY wY
-> FlippedSeal (RL (PatchInfoAnd rt p)) wY
forall (a :: * -> * -> *) wY wZ.
FlippedSeal (RL a) wY -> a wY wZ -> FlippedSeal (RL a) wZ
`snocRLSealed` PatchInfoAnd rt p wY wY
a

applyInvRL :: (Apply p, Invert p, ApplyMonad (ApplyState p) m, MonadProgress m) => RL (PatchInfoAnd rt p) wX wR -> m ()
applyInvRL :: RL (PatchInfoAnd rt p) wX wR -> m ()
applyInvRL = FL (PatchInfoAnd rt p) wR wX -> m ()
forall (m :: * -> *) (p :: * -> * -> *) (rt :: RepoType) wX wY.
(MonadProgress m, ApplyMonad (ApplyState p) m, Apply p) =>
FL (PatchInfoAnd rt p) wX wY -> m ()
applyPatches (FL (PatchInfoAnd rt p) wR wX -> m ())
-> (RL (PatchInfoAnd rt p) wX wR -> FL (PatchInfoAnd rt p) wR wX)
-> RL (PatchInfoAnd rt p) wX wR
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL (PatchInfoAnd rt p) wX wR -> FL (PatchInfoAnd rt p) wR wX
forall (p :: * -> * -> *) wX wY.
Invert p =>
RL p wX wY -> FL p wY wX
invertRL -- this gives nicer feedback