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

-- | /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.
--
-- Alternatively, match flags can also be understood as a 'patchSetMatch'.
-- This (ab-)uses match flags that normally denote a 'nonrangeMatcher',
-- (additionally including the 'OneIndex' flag --index=n), to denote
-- selection of a full 'PatchSet' up to the latest matching patch. This
-- works similar to 'secondMatcher' except for tag matches, which in this
-- case mean to select only the tag and all its dependencies. In other
-- words, the tag will be clean in the resulting 'PatchSet'.
--
-- (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
    ( helpOnMatchers
    , matchFirstPatchset
    , matchSecondPatchset
    , splitSecondFL
    , matchAPatch
    , rollbackToPatchSetMatch
    , firstMatch
    , secondMatch
    , haveNonrangeMatch
    , PatchSetMatch(..)
    , patchSetMatch
    , checkMatchSyntax
    , hasIndexRange
    , getMatchingTag
    , matchAPatchset
    , MatchFlag(..)
    , matchingHead
    , Matchable
    , MatchableRP
    ) where

import Darcs.Prelude

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 Darcs.Util.Regex ( mkRegex, matchRegex )

import Control.Exception ( Exception, throw )
import Data.Maybe ( isJust )
import System.IO.Unsafe ( unsafePerformIO )
import Data.List ( isPrefixOf, intercalate )
import Data.Char ( toLower )
import Data.Typeable ( Typeable )

import Darcs.Util.Path ( AbsolutePath )
import Darcs.Patch ( hunkMatches, listTouchedFiles )
import Darcs.Patch.Info ( justName, justAuthor, justLog, makePatchname,
                          piDate, piTag )

import qualified Data.ByteString.Char8 as BC

import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Set
    ( Origin
    , PatchSet(..)
    , SealedPatchSet
    , Tagged(..)
    , patchSetDrop
    )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Depends ( splitOnTag, contextPatches )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId )
import Darcs.Patch.Info ( PatchInfo )
import Darcs.Patch.Inspect ( PatchInspect )

import Darcs.Patch.Witnesses.Ordered
    ( RL(..), FL(..), (:>)(..), reverseRL, mapRL, (+<+) )
import Darcs.Patch.Witnesses.Sealed
    ( Sealed2(..), seal, seal2, unseal2, unseal )
import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )

import Darcs.Util.DateMatcher ( parseDateMatcher )
import Darcs.Util.Path ( anchorPath )
import Darcs.Util.Tree ( Tree )

-- | Patches that can be matched.
type Matchable p =
  ( Apply p
  , PatchInspect p
  , Ident p
  , PatchId p ~ PatchInfo
  )

-- | Constraint for a patch type @p@ that ensures @'PatchInfoAnd' p@
-- is 'Matchable'.
type MatchableRP p =
  ( Apply p
  , Commute p
  , PatchInspect p
  )

-- | A type for predicates over patches which do not care about
-- contexts
data MatchFun = MatchFun (forall p. Matchable p => Sealed2 p -> Bool)

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

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

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

makeMatcher :: String -> MatchFun -> Matcher
makeMatcher :: [Char] -> MatchFun -> Matcher
makeMatcher = [Char] -> MatchFun -> Matcher
MATCH

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

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

matchPattern :: String -> Matcher
matchPattern :: [Char] -> Matcher
matchPattern [Char]
pattern =
    case [Char] -> Either [Char] Matcher
parseMatch [Char]
pattern of
    Left [Char]
err -> [Char] -> Matcher
forall a. HasCallStack => [Char] -> a
error [Char]
err
    Right Matcher
m -> Matcher
m

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

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

    ps :: [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
ps = [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
primitiveMatchers

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

submatch :: CharParser st MatchFun
submatch :: forall st. CharParser st MatchFun
submatch = OperatorTable Char st MatchFun
-> GenParser Char st MatchFun -> GenParser Char st MatchFun
forall tok st a.
OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
buildExpressionParser OperatorTable Char st MatchFun
forall st. OperatorTable Char st MatchFun
table GenParser Char st MatchFun
forall st. CharParser st MatchFun
match

table :: OperatorTable Char st MatchFun
table :: forall st. OperatorTable Char st MatchFun
table   = [ [[Char] -> (MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a) -> Operator Char st a
prefix [Char]
"not" MatchFun -> MatchFun
negate_match,
             [Char] -> (MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a) -> Operator Char st a
prefix [Char]
"!" MatchFun -> MatchFun
negate_match ]
          , [[Char]
-> (MatchFun -> MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"||" MatchFun -> MatchFun -> MatchFun
or_match,
             [Char]
-> (MatchFun -> MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"or" MatchFun -> MatchFun -> MatchFun
or_match,
             [Char]
-> (MatchFun -> MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"&&" MatchFun -> MatchFun -> MatchFun
and_match,
            [Char]
-> (MatchFun -> MatchFun -> MatchFun) -> Operator Char st MatchFun
forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"and" MatchFun -> MatchFun -> MatchFun
and_match ]
          ]
    where binary :: [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
name 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 ([Char] -> (a -> a -> a) -> GenParser Char st (a -> a -> a)
forall {b} {st}. [Char] -> b -> ParsecT [Char] st Identity b
tryNameAndUseFun [Char]
name a -> a -> a
fun) Assoc
AssocLeft
          prefix :: [Char] -> (a -> a) -> Operator Char st a
prefix [Char]
name 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
$ [Char] -> (a -> a) -> GenParser Char st (a -> a)
forall {b} {st}. [Char] -> b -> ParsecT [Char] st Identity b
tryNameAndUseFun [Char]
name a -> a
fun
          tryNameAndUseFun :: [Char] -> b -> ParsecT [Char] st Identity b
tryNameAndUseFun [Char]
name b
fun = do [Char]
_ <- [Char] -> CharParser st [Char]
forall st. [Char] -> CharParser st [Char]
trystring [Char]
name
                                         ParsecT [Char] st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                         b -> ParsecT [Char] st Identity b
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
fun
          negate_match :: MatchFun -> MatchFun
negate_match (MatchFun forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m) = (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> Bool -> Bool
not (Sealed2 p -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m Sealed2 p
p)
          or_match :: MatchFun -> MatchFun -> MatchFun
or_match (MatchFun forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1) (MatchFun forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m2) = (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> Sealed2 p -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1 Sealed2 p
p Bool -> Bool -> Bool
|| Sealed2 p -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m2 Sealed2 p
p
          and_match :: MatchFun -> MatchFun -> MatchFun
and_match (MatchFun forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1) (MatchFun forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m2) = (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> Sealed2 p -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1 Sealed2 p
p Bool -> Bool -> Bool
&& Sealed2 p -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m2 Sealed2 p
p

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

match :: CharParser st MatchFun
match :: forall st. CharParser st MatchFun
match = ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity MatchFun
-> ParsecT [Char] st Identity MatchFun
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 [Char] st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT [Char] st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (ParsecT [Char] st Identity MatchFun
-> ParsecT [Char] st Identity MatchFun
forall st. CharParser st MatchFun -> CharParser st MatchFun
parens ParsecT [Char] st Identity MatchFun
forall st. CharParser st MatchFun
submatch ParsecT [Char] st Identity MatchFun
-> ParsecT [Char] st Identity MatchFun
-> ParsecT [Char] st Identity MatchFun
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [ParsecT [Char] st Identity MatchFun]
-> ParsecT [Char] st Identity MatchFun
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT [Char] st Identity MatchFun]
forall {st}. [CharParser st MatchFun]
matchers_)
  where
    matchers_ :: [CharParser st MatchFun]
matchers_ = (([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)
 -> CharParser st MatchFun)
-> [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
-> [CharParser st MatchFun]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)
-> CharParser st MatchFun
forall st.
([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)
-> CharParser st MatchFun
createMatchHelper [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
primitiveMatchers

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

-- | The string that is emitted when the user runs @darcs help patterns@.
helpOnMatchers :: [String]
helpOnMatchers :: [[Char]]
helpOnMatchers =
  [[Char]
"Selecting Patches:",
   [Char]
"",
   [Char]
"The --patches option yields patches with names matching an *extended*",
   [Char]
"regular expression.  See regex(7) for details.  The --matches option",
   [Char]
"yields patches that match a logical (Boolean) expression: one or more",
   [Char]
"primitive expressions combined by grouping (parentheses) and the",
   [Char]
"complement (not), conjunction (and) and disjunction (or) operators.",
   [Char]
"The C notation for logic operators (!, && and ||) can also be used.",
   [Char]
"",
   [Char]
"    --patches=regex is a synonym for --matches='name regex'",
   [Char]
"    --hash=HASH is a synonym for --matches='hash HASH'",
   [Char]
"    --from-patch and --to-patch are synonyms for",
   [Char]
"      --from-match='name... and --to-match='name...",
   [Char]
"    --from-hash and --to-hash are synonyms for",
   [Char]
"      --from-match='hash...' and --to-match='hash...'",
   [Char]
"    sensible combinations of --from-* and --to-* options are possible:",
   [Char]
"      `darcs log --from-patch='html.*docu' --to-match='date 20040212'`",
   [Char]
"      `darcs log --from-hash=368089c6969 --to-patch='^fix.*renamed or moved\\.$'`",
   [Char]
"",
   [Char]
"The following primitive Boolean expressions are supported:"
   ,[Char]
""]
  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
keywords
  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"", [Char]
"Here are some examples:", [Char]
""]
  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
examples
  where ps :: [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
ps = [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
primitiveMatchers
        keywords :: [[Char]]
keywords = [[Char] -> ShowS
showKeyword ([[Char]] -> [Char]
unwords [[Char]
k,[Char]
a]) [Char]
d | ([Char]
k,[Char]
a,[Char]
d,[[Char]]
_,[Char] -> MatchFun
_) <- [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
ps]
        examples :: [[Char]]
examples = [[Char] -> ShowS
showExample [Char]
k [Char]
e | ([Char]
k,[Char]
_,[Char]
_,[[Char]]
es,[Char] -> MatchFun
_) <- [([Char], [Char], [Char], [[Char]], [Char] -> MatchFun)]
ps, [Char]
e <- [[Char]]
es]
        showKeyword :: [Char] -> ShowS
showKeyword [Char]
keyword [Char]
description =
            [Char]
"    " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
keyword [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" - " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
description [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
        showExample :: [Char] -> ShowS
showExample [Char]
keyword [Char]
example =
            [Char]
"    darcs log --match "
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
keyword [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
example [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'"

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

parens :: CharParser st MatchFun
       -> CharParser st MatchFun
parens :: forall st. CharParser st MatchFun -> CharParser st MatchFun
parens = ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity MatchFun
-> ParsecT [Char] st Identity MatchFun
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 [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"(") ([Char] -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
")")

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

datematch, hashmatch, authormatch, exactmatch, namematch, logmatch,
  hunkmatch, touchmatch :: String -> MatchFun

namematch :: [Char] -> MatchFun
namematch [Char]
r =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool) -> Maybe [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r) ([Char] -> Maybe [[Char]]) -> [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justName (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

exactmatch :: [Char] -> MatchFun
exactmatch [Char]
r = (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) -> [Char]
r [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo -> [Char]
justName (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

authormatch :: [Char] -> MatchFun
authormatch [Char]
a =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool) -> Maybe [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
a) ([Char] -> Maybe [[Char]]) -> [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justAuthor (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

logmatch :: [Char] -> MatchFun
logmatch [Char]
l =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool) -> Maybe [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
l) ([Char] -> Maybe [[Char]]) -> [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justLog (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

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

hashmatch :: [Char] -> MatchFun
hashmatch [Char]
h =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let rh :: [Char]
rh = SHA1 -> [Char]
forall a. Show a => a -> [Char]
show (SHA1 -> [Char]) -> SHA1 -> [Char]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)
        lh :: [Char]
lh = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
h
     in ([Char]
lh [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
rh) Bool -> Bool -> Bool
|| ([Char]
lh [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rh [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".gz")

datematch :: [Char] -> MatchFun
datematch [Char]
d =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 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
$ [Char] -> IO (CalendarTime -> Bool)
parseDateMatcher [Char]
d
     in CalendarTime -> Bool
dm (CalendarTime -> Bool) -> CalendarTime -> Bool
forall a b. (a -> b) -> a -> b
$ PatchInfo -> CalendarTime
piDate (p wX wY -> PatchId p
forall wX wY. p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

touchmatch :: [Char] -> MatchFun
touchmatch [Char]
r =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
 -> MatchFun)
-> (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let files :: [AnchoredPath]
files = p wX wY -> [AnchoredPath]
forall wX wY. p wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
hp
     in ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool)
-> ([Char] -> Maybe [[Char]]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r)) ((AnchoredPath -> [Char]) -> [AnchoredPath] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
".") [AnchoredPath]
files)

-- | @haveNonrangeMatch flags@ tells whether there is a flag in
-- @flags@ which corresponds to a match that is "non-range". Thus,
-- @--match@, @--patch@, and @--hash@ make @haveNonrangeMatch@
-- true, but not @--from-patch@ or @--to-patch@.
haveNonrangeMatch :: [MatchFlag] -> Bool
haveNonrangeMatch :: [MatchFlag] -> Bool
haveNonrangeMatch [MatchFlag]
fs = Maybe Matcher -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Matcher
nonrangeMatcher [MatchFlag]
fs)

data PatchSetMatch
  = IndexMatch Int
  | PatchMatch Matcher
  | TagMatch Matcher
  | ContextMatch AbsolutePath

patchSetMatch :: [MatchFlag] -> Maybe PatchSetMatch
patchSetMatch :: [MatchFlag] -> Maybe PatchSetMatch
patchSetMatch [] = Maybe PatchSetMatch
forall a. Maybe a
Nothing
patchSetMatch (OneTag [Char]
t:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
TagMatch (Matcher -> PatchSetMatch) -> Matcher -> PatchSetMatch
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
patchSetMatch (OnePattern [Char]
m:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch (Matcher -> PatchSetMatch) -> Matcher -> PatchSetMatch
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
patchSetMatch (OnePatch [Char]
p:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch (Matcher -> PatchSetMatch) -> Matcher -> PatchSetMatch
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
patchSetMatch (OneHash [Char]
h:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch (Matcher -> PatchSetMatch) -> Matcher -> PatchSetMatch
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
patchSetMatch (OneIndex Int
n:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ Int -> PatchSetMatch
IndexMatch Int
n
patchSetMatch (Context AbsolutePath
p:[MatchFlag]
_) = PatchSetMatch -> Maybe PatchSetMatch
forall a. a -> Maybe a
strictJust (PatchSetMatch -> Maybe PatchSetMatch)
-> PatchSetMatch -> Maybe PatchSetMatch
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> PatchSetMatch
ContextMatch AbsolutePath
p
patchSetMatch (MatchFlag
_:[MatchFlag]
fs) = [MatchFlag] -> Maybe PatchSetMatch
patchSetMatch [MatchFlag]
fs

-- | @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 [MatchFlag]
fs = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs)
                 Bool -> Bool -> Bool
|| Maybe Matcher -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs)
                 Bool -> Bool -> Bool
|| Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs)

-- | @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 [MatchFlag]
fs =
  Maybe Matcher -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs) Bool -> Bool -> Bool
||
  Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs)

checkMatchSyntax :: [MatchFlag] -> IO ()
checkMatchSyntax :: [MatchFlag] -> IO ()
checkMatchSyntax [MatchFlag]
opts =
  case [MatchFlag] -> Maybe [Char]
getMatchPattern [MatchFlag]
opts of
    Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Char]
p ->
      ([Char] -> IO ())
-> (Matcher -> IO ()) -> Either [Char] Matcher -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
        (IO () -> Matcher -> IO ()
forall a b. a -> b -> a
const (IO () -> Matcher -> IO ()) -> IO () -> Matcher -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        ([Char] -> Either [Char] Matcher
parseMatch [Char]
p)

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

tagmatch :: String -> Matcher
tagmatch :: [Char] -> Matcher
tagmatch [Char]
r = [Char] -> MatchFun -> Matcher
makeMatcher ([Char]
"tag-name "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
r) ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun Sealed2 p -> Bool
forall {a :: * -> * -> *}.
(PatchId a ~ PatchInfo, Ident a) =>
Sealed2 a -> Bool
forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
tm)
  where
    tm :: Sealed2 a -> Bool
tm (Sealed2 a wX wY
p) =
      case PatchInfo -> Maybe [Char]
piTag (a wX wY -> PatchId a
forall wX wY. a wX wY -> PatchId a
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident a wX wY
p) of
        Just [Char]
t -> Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r) [Char]
t)
        Maybe [Char]
Nothing -> Bool
False

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

hashmatch' :: String -> Matcher
hashmatch' :: [Char] -> Matcher
hashmatch' [Char]
r = [Char] -> MatchFun -> Matcher
makeMatcher ([Char]
"hash "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
r) ([Char] -> MatchFun
hashmatch [Char]
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 :: forall a. a -> Maybe a
strictJust 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 :: [MatchFlag] -> Maybe Matcher
nonrangeMatcher :: [MatchFlag] -> Maybe Matcher
nonrangeMatcher [] = Maybe Matcher
forall a. Maybe a
Nothing
nonrangeMatcher (OnePattern [Char]
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
nonrangeMatcher (OneTag [Char]
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
nonrangeMatcher (OnePatch [Char]
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
nonrangeMatcher (OneHash [Char]
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
nonrangeMatcher (SeveralPattern [Char]
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
nonrangeMatcher (SeveralTag [Char]
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
nonrangeMatcher (SeveralPatch [Char]
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
nonrangeMatcher (MatchFlag
_:[MatchFlag]
fs) = [MatchFlag] -> Maybe Matcher
nonrangeMatcher [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 :: [MatchFlag] -> Maybe Matcher
firstMatcher :: [MatchFlag] -> Maybe Matcher
firstMatcher [] = Maybe Matcher
forall a. Maybe a
Nothing
firstMatcher (OnePattern [Char]
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
firstMatcher (AfterPattern [Char]
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
firstMatcher (AfterTag [Char]
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
firstMatcher (OnePatch [Char]
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
firstMatcher (AfterPatch [Char]
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
firstMatcher (OneHash [Char]
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
firstMatcher (AfterHash [Char]
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
firstMatcher (MatchFlag
_:[MatchFlag]
fs) = [MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs

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

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

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

-- | Whether a patch matches the given 'MatchFlag's. This should be
-- invariant under inversion:
--
-- prop> matchAPatch (invert p) = matchAPatch p
matchAPatch :: Matchable p => [MatchFlag] -> p wX wY -> Bool
matchAPatch :: forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
fs p wX wY
p =
  case [MatchFlag] -> Maybe Matcher
nonrangeMatcher [MatchFlag]
fs of
    Maybe Matcher
Nothing -> Bool
True
    Just Matcher
m -> Matcher -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m p wX wY
p

-- | @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):[MatchFlag]
_) = [Char] -> Maybe Int
forall a. HasCallStack => [Char] -> a
error [Char]
"--last requires a positive integer argument."
hasLastn (LastN Int
n:[MatchFlag]
_) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
hasLastn (MatchFlag
_:[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 (IndexRange Int
x Int
y:[MatchFlag]
_) = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x,Int
y)
hasIndexRange (MatchFlag
_:[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 want.
matchFirstPatchset :: MatchableRP p
                   => [MatchFlag] -> PatchSet p wStart wX
                   -> Maybe (SealedPatchSet p wStart)
matchFirstPatchset :: forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet p wStart wX -> Maybe (SealedPatchSet p wStart)
matchFirstPatchset [MatchFlag]
fs PatchSet p wStart wX
patchset
  | Just Int
n <- [MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs = SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart))
-> SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
patchSetDrop Int
n PatchSet p wStart wX
patchset
  | Just (Int
_, Int
b) <- [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs = SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart))
-> SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
patchSetDrop Int
b PatchSet p wStart wX
patchset
  | Just Matcher
m <- [MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs =
    SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart))
-> SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a b. (a -> b) -> a -> b
$ (forall wX. PatchSet p wStart wX -> SealedPatchSet p wStart)
-> SealedPatchSet p wStart -> SealedPatchSet p wStart
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
patchSetDrop Int
1) (SealedPatchSet p wStart -> SealedPatchSet p wStart)
-> SealedPatchSet p wStart -> SealedPatchSet p wStart
forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs
      then Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
getMatchingTag Matcher
m PatchSet p wStart wX
patchset
      else Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m PatchSet p wStart wX
patchset
  | Bool
otherwise = Maybe (SealedPatchSet p wStart)
forall a. Maybe a
Nothing

-- | @matchSecondPatchset fs ps@ returns the part of @ps@ before its
-- second matcher, ie the one that comes last dependencywise.
matchSecondPatchset :: MatchableRP p
                    => [MatchFlag] -> PatchSet p wStart wX
                    -> Maybe (SealedPatchSet p wStart)
matchSecondPatchset :: forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet p wStart wX -> Maybe (SealedPatchSet p wStart)
matchSecondPatchset [MatchFlag]
fs PatchSet p wStart wX
ps
  | Just (Int
a, Int
_) <- [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs = SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart))
-> SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
patchSetDrop (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PatchSet p wStart wX
ps
  | Just Matcher
m <- [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs =
    SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart))
-> SealedPatchSet p wStart -> Maybe (SealedPatchSet p wStart)
forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
secondMatcherIsTag [MatchFlag]
fs
      then Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
getMatchingTag Matcher
m PatchSet p wStart wX
ps
      else Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m PatchSet p wStart wX
ps
  | Bool
otherwise = Maybe (SealedPatchSet p wStart)
forall a. Maybe a
Nothing

-- | 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 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 (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 p)
-> [MatchFlag] -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitSecondFL forall wA wB. q wA wB -> Sealed2 p
extract [MatchFlag]
fs FL q wX wY
ps =
   case [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs of
   Just (Int, Int)
_ -> -- selecting the last n doesn't really make sense if we're starting
             -- from the earliest patches
             [Char] -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => [Char] -> a
error [Char]
"index matches not supported by splitSecondPatchesFL"
   Maybe (Int, Int)
Nothing ->
     case [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs of
     Maybe Matcher
Nothing -> [Char] -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => [Char] -> a
error [Char]
"Couldn't splitSecondPatches"
     Just Matcher
m -> (forall wA wB. q wA wB -> Sealed2 p)
-> Matcher -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 p)
-> Matcher -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL q wA wB -> Sealed2 p
forall wA wB. q wA wB -> Sealed2 p
extract Matcher
m FL q wX wY
ps

splitMatchFL
  :: Matchable p
  => (forall wA wB. q wA wB -> Sealed2 p)
  -> Matcher
  -> FL q wX wY
  -> (FL q :> FL q) wX wY
splitMatchFL :: forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 p)
-> Matcher -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL forall wA wB. q wA wB -> Sealed2 p
_extract Matcher
m FL q wX wY
NilFL = [Char] -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => [Char] -> a
error ([Char] -> (:>) (FL q) (FL q) wX wY)
-> [Char] -> (:>) (FL q) (FL q) wX wY
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find a patch matching " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher -> [Char]
forall a. Show a => a -> [Char]
show Matcher
m
splitMatchFL forall wA wB. q wA wB -> Sealed2 p
extract Matcher
m (q wX wY
p :>: FL q wY wY
ps)
   | (forall wX wY. p wX wY -> Bool) -> Sealed2 p -> Bool
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (Matcher -> p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m) (Sealed2 p -> Bool) -> (q wX wY -> Sealed2 p) -> q wX wY -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q wX wY -> Sealed2 p
forall wA wB. q wA wB -> Sealed2 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 p)
-> Matcher -> FL q wY wY -> (:>) (FL q) (FL q) wY wY
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 p)
-> Matcher -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitMatchFL q wA wB -> Sealed2 p
forall wA wB. q wA wB -> Sealed2 p
extract Matcher
m FL q wY wY
ps of
                    FL q wY wZ
before :> 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

-- | Using a special exception type here means that is is treated as
-- regular failure, and not as a bug in Darcs.
data MatchFailure = MatchFailure String
  deriving Typeable

instance Exception MatchFailure

instance Show MatchFailure where
  show :: MatchFailure -> [Char]
show (MatchFailure [Char]
m) =
    [Char]
"Couldn't find a patch matching " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
m

-- | @matchAPatchset m ps@ returns a prefix of @ps@
-- ending in a patch matching @m@, and calls 'error' if there is none.
matchAPatchset
  :: MatchableRP p
  => Matcher
  -> PatchSet p wStart wX
  -> SealedPatchSet p wStart
matchAPatchset :: forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
NilRL) =
  MatchFailure -> SealedPatchSet p wStart
forall a e. Exception e => e -> a
throw (MatchFailure -> SealedPatchSet p wStart)
-> MatchFailure -> SealedPatchSet p wStart
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure ([Char] -> MatchFailure) -> [Char] -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> [Char]
forall a. Show a => a -> [Char]
show Matcher
m
matchAPatchset Matcher
m (PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
ps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
NilRL) =
  Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
ps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t))
matchAPatchset Matcher
m (PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wX
p))
  | Matcher -> PatchInfoAnd p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd p wY wX
p = PatchSet p wStart wX -> SealedPatchSet p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
ps RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
p))
  | Bool
otherwise = Matcher -> PatchSet p wStart wY -> SealedPatchSet p wStart
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps)

splitOnMatchingTag :: MatchableRP p
                   => Matcher
                   -> PatchSet p wStart wX
                   -> PatchSet p wStart wX
splitOnMatchingTag :: forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
splitOnMatchingTag Matcher
_ s :: PatchSet p wStart wX
s@(PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
NilRL) = PatchSet p wStart wX
s
splitOnMatchingTag Matcher
m s :: PatchSet p wStart wX
s@(PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
ps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
NilRL)
    | Matcher -> PatchInfoAnd p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd p wY wX
t = PatchSet p wStart wX
s
    | Bool
otherwise = Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
splitOnMatchingTag Matcher
m (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
psRL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd p wY wX
PatchInfoAnd p wY wX
t))
splitOnMatchingTag Matcher
m (PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
ps:<:PatchInfoAnd p wY wX
p))
    -- found a non-clean tag, need to commute out the things that it doesn't depend on
    | Matcher -> PatchInfoAnd p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd p wY wX
p =
        case PatchInfo -> PatchSet p Origin wX -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wStart wX.
Commute p =>
PatchInfo -> PatchSet p wStart wX -> Maybe (PatchSet p wStart wX)
splitOnTag (PatchInfoAnd p wY wX -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wY wX
p) (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts (RL (PatchInfoAnd p) wX wY
psRL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd p wY wX
p)) of
          Just PatchSet p Origin wX
x -> PatchSet p wStart wX
PatchSet p Origin wX
x
          Maybe (PatchSet p Origin wX)
Nothing -> [Char] -> PatchSet p wStart wX
forall a. HasCallStack => [Char] -> a
error [Char]
"splitOnTag failed"
    | Bool
otherwise =
        case Matcher -> PatchSet p Origin wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
splitOnMatchingTag Matcher
m (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts RL (PatchInfoAnd p) wX wY
ps) of
          PatchSet RL (Tagged p) Origin wX
ts' RL (PatchInfoAnd p) wX wY
ps' -> RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ts' (RL (PatchInfoAnd p) wX wY
ps' RL (PatchInfoAnd p) wX wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
p)

-- | @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 :: MatchableRP p
               => Matcher
               -> PatchSet p wStart wX
               -> SealedPatchSet p wStart
getMatchingTag :: forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
getMatchingTag Matcher
m PatchSet p wStart wX
ps =
  case Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
splitOnMatchingTag Matcher
m PatchSet p wStart wX
ps of
    PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
_ -> IOError -> SealedPatchSet p wStart
forall a e. Exception e => e -> a
throw (IOError -> SealedPatchSet p wStart)
-> IOError -> SealedPatchSet p wStart
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find a tag matching " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher -> [Char]
forall a. Show a => a -> [Char]
show Matcher
m
    PatchSet RL (Tagged p) Origin wX
ps' RL (PatchInfoAnd p) wX wX
_ -> PatchSet p wStart wX -> SealedPatchSet p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet p wStart wX -> SealedPatchSet p wStart)
-> PatchSet p wStart wX -> SealedPatchSet p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
ps' RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL

-- | Rollback (i.e. apply the inverse) of what remains of a 'PatchSet' after we
-- extract a 'PatchSetMatch'. This is the counterpart of 'getOnePatchset' and
-- is used to create a matching state. In particular, if the match is --index=n
-- then rollback the last (n-1) patches; if the match is --tag, then rollback
-- patches that are not depended on by the tag; otherwise rollback patches that
-- follow the latest matching patch.
rollbackToPatchSetMatch :: ( ApplyMonad (ApplyState p) m
                           , MatchableRP p, ApplyState p ~ Tree
                           )
                        => PatchSetMatch
                        -> PatchSet p Origin wX
                        -> m ()
rollbackToPatchSetMatch :: forall (p :: * -> * -> *) (m :: * -> *) wX.
(ApplyMonad (ApplyState p) m, MatchableRP p,
 ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet p Origin wX -> m ()
rollbackToPatchSetMatch PatchSetMatch
psm PatchSet p Origin wX
repo =
  case PatchSetMatch
psm of
    IndexMatch Int
n -> Int -> PatchSet p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet p Origin wX -> m ()
applyNInv (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) PatchSet p Origin wX
repo
    TagMatch Matcher
m ->
      case Matcher -> PatchSet p Origin wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> PatchSet p wStart wX
splitOnMatchingTag Matcher
m PatchSet p Origin wX
repo of
        PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
_ -> MatchFailure -> m ()
forall a e. Exception e => e -> a
throw (MatchFailure -> m ()) -> MatchFailure -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure ([Char] -> MatchFailure) -> [Char] -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> [Char]
forall a. Show a => a -> [Char]
show Matcher
m
        PatchSet RL (Tagged p) Origin wX
_ RL (PatchInfoAnd p) wX wX
extras -> RL (PatchInfoAnd p) wX wX -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RL (PatchInfoAnd p))) m =>
RL (PatchInfoAnd p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply RL (PatchInfoAnd p) wX wX
extras
    PatchMatch Matcher
m -> Matcher -> PatchSet p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet p Origin wX -> m ()
applyInvToMatcher Matcher
m PatchSet p Origin wX
repo
    ContextMatch AbsolutePath
_ -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"rollbackToPatchSetMatch: unexpected context match"

-- | @applyInvToMatcher@ m ps applies the inverse of the patches in @ps@,
-- starting at the end, until we hit a patch that matches the 'Matcher' @m@.
applyInvToMatcher :: (MatchableRP p, ApplyMonad (ApplyState p) m)
                  => Matcher
                  -> PatchSet p Origin wX
                  -> m ()
applyInvToMatcher :: forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet p Origin wX -> m ()
applyInvToMatcher Matcher
m (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
NilRL) =
  MatchFailure -> m ()
forall a e. Exception e => e -> a
throw (MatchFailure -> m ()) -> MatchFailure -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure ([Char] -> MatchFailure) -> [Char] -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> [Char]
forall a. Show a => a -> [Char]
show Matcher
m
applyInvToMatcher Matcher
m (PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
ps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
NilRL) =
  Matcher -> PatchSet p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet p Origin wX -> m ()
applyInvToMatcher Matcher
m (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
ps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t))
applyInvToMatcher Matcher
m (PatchSet RL (Tagged p) Origin wX
xs (RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wX
p))
  | Matcher -> PatchInfoAnd p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd p wY wX
p = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = PatchInfoAnd p wY wX -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PatchInfoAnd p)) m =>
PatchInfoAndG (Named p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply PatchInfoAnd p wY wX
p m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Matcher -> PatchSet p Origin wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet p Origin wX -> m ()
applyInvToMatcher Matcher
m (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
xs RL (PatchInfoAnd p) wX wY
ps)

-- | @applyNInv@ n ps applies the inverse of the last @n@ patches of @ps@.
applyNInv :: (MatchableRP p, ApplyMonad (ApplyState p) m)
          => Int -> PatchSet p Origin wX -> m ()
applyNInv :: forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet p Origin wX -> m ()
applyNInv Int
n PatchSet p Origin wX
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyNInv Int
_ (PatchSet RL (Tagged p) Origin wX
NilRL RL (PatchInfoAnd p) wX wX
NilRL) = IOError -> m ()
forall a e. Exception e => e -> a
throw (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
"Index out of range"
applyNInv Int
n (PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
ps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
NilRL) =
  Int -> PatchSet p Origin wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet p Origin wX -> m ()
applyNInv Int
n (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
ps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t))
applyNInv Int
n (PatchSet RL (Tagged p) Origin wX
xs (RL (PatchInfoAnd p) wX wY
ps :<: PatchInfoAnd p wY wX
p)) =
  PatchInfoAnd p wY wX -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PatchInfoAnd p)) m =>
PatchInfoAndG (Named p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply PatchInfoAnd p wY wX
p m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PatchSet p Origin wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet p Origin wX -> m ()
applyNInv (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wX
xs RL (PatchInfoAnd p) wX wY
ps)

-- | matchingHead returns the repository up to some tag. The tag t is the last
-- tag such that there is a patch after t that is matched by the user's query.
matchingHead :: forall p wR. MatchableRP p
             => [MatchFlag] -> PatchSet p Origin wR
             -> (PatchSet p :> FL (PatchInfoAnd p)) Origin wR
matchingHead :: forall (p :: * -> * -> *) wR.
MatchableRP p =>
[MatchFlag]
-> PatchSet p Origin wR
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
matchingHead [MatchFlag]
matchFlags PatchSet p Origin wR
set =
    case PatchSet p Origin wR
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wR
forall wX.
PatchSet p Origin wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
mh PatchSet p Origin wR
set of
        (PatchSet p Origin wZ
start :> RL (PatchInfoAnd p) wZ wR
patches) -> PatchSet p Origin wZ
start PatchSet p Origin wZ
-> FL (PatchInfoAnd p) wZ wR
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd p) wZ wR -> FL (PatchInfoAnd p) wZ wR
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd p) wZ wR
patches
  where
    mh :: forall wX . PatchSet p Origin wX
       -> (PatchSet p :> RL (PatchInfoAnd p)) Origin wX
    mh :: forall wX.
PatchSet p Origin wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
mh s :: PatchSet p Origin wX
s@(PatchSet RL (Tagged p) Origin wX
_ RL (PatchInfoAnd p) wX wX
x)
        | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((forall wW wZ. PatchInfoAnd p wW wZ -> Bool)
-> RL (PatchInfoAnd p) wX wX -> [Bool]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL ([MatchFlag] -> PatchInfoAnd p wW wZ -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
matchFlags) RL (PatchInfoAnd p) wX wX
x) = PatchSet p Origin wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
contextPatches PatchSet p Origin wX
s
    mh (PatchSet (RL (Tagged p) Origin wY
ts :<: Tagged RL (PatchInfoAnd p) wY wY
ps PatchInfoAnd p wY wX
t Maybe InventoryHash
_) RL (PatchInfoAnd p) wX wX
x) =
        case PatchSet p Origin wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
forall wX.
PatchSet p Origin wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
mh (RL (Tagged p) Origin wY
-> RL (PatchInfoAnd p) wY wX -> PatchSet p Origin wX
forall (p :: * -> * -> *) wX wY.
RL (Tagged p) Origin wX
-> RL (PatchInfoAnd p) wX wY -> PatchSet p Origin wY
PatchSet RL (Tagged p) Origin wY
ts (RL (PatchInfoAnd p) wY wY
ps RL (PatchInfoAnd p) wY wY
-> PatchInfoAnd p wY wX -> RL (PatchInfoAnd p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd p wY wX
t)) of
            (PatchSet p Origin wZ
start :> RL (PatchInfoAnd p) wZ wX
patches) -> PatchSet p Origin wZ
start PatchSet p Origin wZ
-> RL (PatchInfoAnd p) wZ wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd p) wZ wX
patches RL (PatchInfoAnd p) wZ wX
-> RL (PatchInfoAnd p) wX wX -> RL (PatchInfoAnd p) wZ wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd p) wX wX
x
    mh PatchSet p Origin wX
ps = PatchSet p Origin wX
ps PatchSet p Origin wX
-> RL (PatchInfoAnd p) wX wX
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL