--  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
    ( IsRepoType
    , 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, conscientiously )
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.Util.Printer ( text, ($$) )
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' rt 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
'"'forall a. a -> [a] -> [a]
:[Char]
s 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
    | AfterTag String
    | UpToTag String
    | LastN Int
    | OneIndex Int
    | IndexRange Int Int
    | Context AbsolutePath
    deriving (Int -> MatchFlag -> ShowS
[MatchFlag] -> ShowS
MatchFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MatchFlag] -> ShowS
$cshowList :: [MatchFlag] -> ShowS
show :: MatchFlag -> [Char]
$cshow :: MatchFlag -> [Char]
showsPrec :: Int -> MatchFlag -> ShowS
$cshowsPrec :: Int -> 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)) = forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
seal2

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

matchParser :: CharParser st MatchFun
matchParser :: forall st. CharParser st MatchFun
matchParser = forall st. CharParser st MatchFun
submatcher 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 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MatchFun
matchAnyPatch forall st. CharParser st MatchFun
submatch
        forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        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: "
                      forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [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)
                      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 (forall a b. a -> b -> a
const Bool
True)

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

table :: OperatorTable Char st MatchFun
table :: forall st. OperatorTable Char st MatchFun
table   = [ [forall {a} {st}. [Char] -> (a -> a) -> Operator Char st a
prefix [Char]
"not" MatchFun -> MatchFun
negate_match,
             forall {a} {st}. [Char] -> (a -> a) -> Operator Char st a
prefix [Char]
"!" MatchFun -> MatchFun
negate_match ]
          , [forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"||" MatchFun -> MatchFun -> MatchFun
or_match,
             forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"or" MatchFun -> MatchFun -> MatchFun
or_match,
             forall {a} {st}. [Char] -> (a -> a -> a) -> Operator Char st a
binary [Char]
"&&" MatchFun -> MatchFun -> MatchFun
and_match,
            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 = forall tok st a.
GenParser tok st (a -> a -> a) -> Assoc -> Operator tok st a
Infix (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 = forall tok st a. GenParser tok st (a -> a) -> Operator tok st a
Prefix forall a b. (a -> b) -> a -> b
$ 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]
_ <- forall st. [Char] -> CharParser st [Char]
trystring [Char]
name
                                         forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                         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 a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> Bool -> Bool
not (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 a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1 Sealed2 p
p Bool -> Bool -> 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 a b. (a -> b) -> a -> b
$ \Sealed2 p
p -> forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool
m1 Sealed2 p
p Bool -> Bool -> 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ 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 = 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 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (forall st. CharParser st MatchFun -> CharParser st MatchFun
parens forall st. CharParser st MatchFun
submatch forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall {st}. [CharParser st MatchFun]
matchers_)
  where
    matchers_ :: [CharParser st MatchFun]
matchers_ = forall a b. (a -> b) -> [a] -> [b]
map 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]
_ <- forall st. [Char] -> CharParser st [Char]
trystring [Char]
key
     forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
     [Char]
q <- forall st. CharParser st [Char]
quoted
     forall (m :: * -> *) a. Monad m => a -> m a
return 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-patch and --to-match can be unproblematically combined:",
   [Char]
"      `darcs log --from-patch='html.*docu' --to-match='date 20040212'`",
   [Char]
"",
   [Char]
"The following primitive Boolean expressions are supported:"
   ,[Char]
""]
  forall a. [a] -> [a] -> [a]
++ [[Char]]
keywords
  forall a. [a] -> [a] -> [a]
++ [[Char]
"", [Char]
"Here are some examples:", [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]
"    " forall a. [a] -> [a] -> [a]
++ [Char]
keyword forall a. [a] -> [a] -> [a]
++ [Char]
" - " forall a. [a] -> [a] -> [a]
++ [Char]
description forall a. [a] -> [a] -> [a]
++ [Char]
"."
        showExample :: [Char] -> ShowS
showExample [Char]
keyword [Char]
example =
            [Char]
"    darcs log --match "
            forall a. [a] -> [a] -> [a]
++ [Char]
"'" forall a. [a] -> [a] -> [a]
++ [Char]
keyword forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
example 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 = 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 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [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 = 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
                 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ do { Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' -- allow escapes
                            ; forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"\\\"") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
                            }
                         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\"")
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r) forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justName (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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) -> [Char]
r forall a. Eq a => a -> a -> Bool
== PatchInfo -> [Char]
justName (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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
a) forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justAuthor (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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
l) forall a b. (a -> b) -> a -> b
$ PatchInfo -> [Char]
justLog (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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let regexMatcher :: ByteString -> Bool
regexMatcher = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BC.unpack
     in 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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let rh :: [Char]
rh = forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)
        lh :: [Char]
lh = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
h
     in ([Char]
lh forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
rh) Bool -> Bool -> Bool
|| ([Char]
lh forall a. Eq a => a -> a -> Bool
== [Char]
rh forall a. [a] -> [a] -> [a]
++ [Char]
".gz")

datematch :: [Char] -> MatchFun
datematch [Char]
d =
  (forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun forall a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let dm :: CalendarTime -> Bool
dm = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO (CalendarTime -> Bool)
parseDateMatcher [Char]
d
     in CalendarTime -> Bool
dm forall a b. (a -> b) -> a -> b
$ PatchInfo -> CalendarTime
piDate (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 a b. (a -> b) -> a -> b
$ \(Sealed2 p wX wY
hp) ->
    let files :: [AnchoredPath]
files = forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
hp
     in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> [Char] -> Maybe [[Char]]
matchRegex ([Char] -> Regex
mkRegex [Char]
r)) (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 = 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 [] = forall a. Maybe a
Nothing
patchSetMatch (OneTag [Char]
t:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
TagMatch forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
patchSetMatch (OnePattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
patchSetMatch (OnePatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
patchSetMatch (OneHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ Matcher -> PatchSetMatch
PatchMatch forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
patchSetMatch (OneIndex Int
n:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ Int -> PatchSetMatch
IndexMatch Int
n
patchSetMatch (Context AbsolutePath
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust 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 = forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs)
                 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs)
                 Bool -> Bool -> 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 =
  forall a. Maybe a -> Bool
isJust ([MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs) Bool -> Bool -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Char]
p ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
        (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 [] = forall a. Maybe a
Nothing
getMatchPattern (OnePattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
Just [Char]
m
getMatchPattern (SeveralPattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
Just [Char]
m
getMatchPattern (AfterPattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
Just [Char]
m
getMatchPattern (UpToPattern [Char]
m:[MatchFlag]
_) = 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 "forall a. [a] -> [a] -> [a]
++[Char]
r) ((forall (p :: * -> * -> *). Matchable p => Sealed2 p -> Bool)
-> MatchFun
MatchFun forall {a :: * -> * -> *}.
(PatchId a ~ PatchInfo, Ident a) =>
Sealed2 a -> Bool
tm)
  where
    tm :: Sealed2 a -> Bool
tm (Sealed2 a wX wY
p) =
      case PatchInfo -> Maybe [Char]
piTag (forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident a wX wY
p) of
        Just [Char]
t -> 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 "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 "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 = forall a. a -> Maybe a
Just 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 [] = forall a. Maybe a
Nothing
nonrangeMatcher (OnePattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
nonrangeMatcher (OneTag [Char]
t:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
nonrangeMatcher (OnePatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
nonrangeMatcher (OneHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
nonrangeMatcher (SeveralPattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
nonrangeMatcher (SeveralPatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust 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 [] = forall a. Maybe a
Nothing
firstMatcher (OnePattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
firstMatcher (AfterPattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
firstMatcher (AfterTag [Char]
t:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
tagmatch [Char]
t
firstMatcher (OnePatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
firstMatcher (AfterPatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
firstMatcher (OneHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
firstMatcher (AfterHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust 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 [] = forall a. Maybe a
Nothing
secondMatcher (OnePattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
secondMatcher (UpToPattern [Char]
m:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
matchPattern [Char]
m
secondMatcher (OnePatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
secondMatcher (UpToPatch [Char]
p:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
patchmatch [Char]
p
secondMatcher (OneHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
secondMatcher (UpToHash [Char]
h:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust forall a b. (a -> b) -> a -> b
$ [Char] -> Matcher
hashmatch' [Char]
h
secondMatcher (UpToTag [Char]
t:[MatchFlag]
_) = forall a. a -> Maybe a
strictJust 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 -> 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 [] = forall a. Maybe a
Nothing
hasLastn (LastN (-1):[MatchFlag]
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"--last requires a positive integer argument."
hasLastn (LastN Int
n:[MatchFlag]
_) = 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 [] = forall a. Maybe a
Nothing
hasIndexRange (IndexRange Int
x Int
y:[MatchFlag]
_) = 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 don't want.
matchFirstPatchset :: MatchableRP p
                   => [MatchFlag] -> PatchSet rt p wStart wX
                   -> Maybe (SealedPatchSet rt p wStart)
matchFirstPatchset :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p wStart wX -> Maybe (SealedPatchSet rt p wStart)
matchFirstPatchset [MatchFlag]
fs PatchSet rt p wStart wX
patchset
  | Just Int
n <- [MatchFlag] -> Maybe Int
hasLastn [MatchFlag]
fs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
n PatchSet rt p wStart wX
patchset
  | Just (Int
_, Int
b) <- [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
b PatchSet rt p wStart wX
patchset
  | Just Matcher
m <- [MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
1) forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs
      then forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher
m PatchSet rt p wStart wX
patchset
      else forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m PatchSet rt p wStart wX
patchset
  | Bool
otherwise = 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 rt p wStart wX
                    -> Maybe (SealedPatchSet rt p wStart)
matchSecondPatchset :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p wStart wX -> Maybe (SealedPatchSet rt p wStart)
matchSecondPatchset [MatchFlag]
fs PatchSet rt p wStart wX
ps
  | Just (Int
a, Int
_) <- [MatchFlag] -> Maybe (Int, Int)
hasIndexRange [MatchFlag]
fs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop (Int
a forall a. Num a => a -> a -> a
- Int
1) PatchSet rt p wStart wX
ps
  | Just Matcher
m <- [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
secondMatcherIsTag [MatchFlag]
fs
      then forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher
m PatchSet rt p wStart wX
ps
      else forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m PatchSet rt p wStart wX
ps
  | Bool
otherwise = 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
             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 -> forall a. HasCallStack => [Char] -> a
error [Char]
"Couldn't splitSecondPatches"
     Just Matcher
m -> 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
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 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find a patch matching " forall a. [a] -> [a] -> [a]
++ 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 (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 (forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall wA wB. q wA wB -> Sealed2 p
extract forall a b. (a -> b) -> a -> b
$ q wX wY
p = (q wX wY
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) 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 (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 wY wY
ps of
                    FL q wY wZ
before :> FL q wZ wY
after -> (q wX wY
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL q wY wZ
before) 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 " 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 rt p wStart wX
  -> SealedPatchSet rt p wStart
matchAPatchset :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) =
  forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Matcher
m
matchAPatchset Matcher
m (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL) =
  forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
matchAPatchset Matcher
m (PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p))
  | forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p = forall (a :: * -> *) wX. a wX -> Sealed a
seal (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
p))
  | Bool
otherwise = forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wY
ps)

splitOnMatchingTag :: MatchableRP p
                   => Matcher
                   -> PatchSet rt p wStart wX
                   -> PatchSet rt p wStart wX
splitOnMatchingTag :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
_ s :: PatchSet rt p wStart wX
s@(PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) = PatchSet rt p wStart wX
s
splitOnMatchingTag Matcher
m s :: PatchSet rt p wStart wX
s@(PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL)
    | forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
t = PatchSet rt p wStart wX
s
    | Bool
otherwise = forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
psforall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
t))
splitOnMatchingTag Matcher
m (PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps:<:PatchInfoAnd rt p wY wX
p))
    -- found a non-clean tag, need to commute out the things that it doesn't depend on
    | forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p =
        case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX -> Maybe (PatchSet rt p wStart wX)
splitOnTag (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wY wX
p) (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
psforall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
p)) of
          Just PatchSet rt p Origin wX
x -> PatchSet rt p Origin wX
x
          Maybe (PatchSet rt p Origin wX)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"splitOnTag failed"
    | Bool
otherwise =
        case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wY
ps) of
          PatchSet RL (Tagged rt p) Origin wX
ts' RL (PatchInfoAnd rt p) wX wY
ps' -> forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts' (RL (PatchInfoAnd rt p) wX wY
ps' forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt 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 rt p wStart wX
               -> SealedPatchSet rt p wStart
getMatchingTag :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher
m PatchSet rt p wStart wX
ps =
  case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m PatchSet rt p wStart wX
ps of
    PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
_ -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find a tag matching " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Matcher
m
    PatchSet RL (Tagged rt p) Origin wX
ps' RL (PatchInfoAnd rt p) wX wX
_ -> forall (a :: * -> *) wX. a wX -> Sealed a
seal forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ps' 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
                           , IsRepoType rt, MatchableRP p, ApplyState p ~ Tree
                           )
                        => PatchSetMatch
                        -> PatchSet rt p Origin wX
                        -> m ()
rollbackToPatchSetMatch :: forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, IsRepoType rt, MatchableRP p,
 ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet rt p Origin wX -> m ()
rollbackToPatchSetMatch PatchSetMatch
psm PatchSet rt p Origin wX
repo =
  case PatchSetMatch
psm of
    IndexMatch Int
n -> forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv (Int
nforall a. Num a => a -> a -> a
-Int
1) PatchSet rt p Origin wX
repo
    TagMatch Matcher
m ->
      case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m PatchSet rt p Origin wX
repo of
        PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
_ -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Matcher
m
        PatchSet RL (Tagged rt p) Origin wX
_ RL (PatchInfoAnd rt p) wX wX
extras -> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply RL (PatchInfoAnd rt p) wX wX
extras
    PatchMatch Matcher
m -> forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher Matcher
m PatchSet rt p Origin wX
repo
    ContextMatch AbsolutePath
_ -> 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 :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m)
                  => Matcher
                  -> PatchSet rt p Origin wX
                  -> m ()
applyInvToMatcher :: forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher Matcher
m (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) =
  forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> MatchFailure
MatchFailure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Matcher
m
applyInvToMatcher Matcher
m (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL) =
  forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
applyInvToMatcher Matcher
m (PatchSet RL (Tagged rt p) Origin wX
xs (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p))
  | forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp PatchInfoAnd rt p wY wX
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Matcher -> PatchSet rt p Origin wX -> m ()
applyInvToMatcher Matcher
m (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin 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 :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m)
          => Int -> PatchSet rt p Origin wX -> m ()
applyNInv :: forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv Int
n PatchSet rt p Origin wX
_ | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyNInv Int
_ (PatchSet RL (Tagged rt p) Origin wX
NilRL RL (PatchInfoAnd rt p) wX wX
NilRL) = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
"Index out of range"
applyNInv Int
n (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL) =
  forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv Int
n (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
applyNInv Int
n (PatchSet RL (Tagged rt p) Origin wX
xs (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p)) =
  forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp PatchInfoAnd rt p wY wX
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv (Int
n forall a. Num a => a -> a -> a
- Int
1) (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
xs RL (PatchInfoAnd rt p) wX wY
ps)

-- | @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, ApplyMonad (ApplyState p) m)
          => PatchInfoAnd rt p wX wY -> m ()
applyInvp :: forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
PatchInfoAnd rt p wX wY -> m ()
applyInvp = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {rt :: RepoType} {p :: * -> * -> *} {wA} {wB}.
PatchInfoAndG rt p wA wB -> p wA wB
fromHopefully
    where fromHopefully :: PatchInfoAndG rt p wA wB -> p wA wB
fromHopefully = forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
(Doc -> Doc) -> PatchInfoAndG rt p wA wB -> p wA wB
conscientiously forall a b. (a -> b) -> a -> b
$ \Doc
e ->
                     [Char] -> Doc
text [Char]
"Sorry, patch not available:"
                     Doc -> Doc -> Doc
$$ Doc
e
                     Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
""
                     Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
"If you think what you're trying to do is ok then"
                     Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
"report this as a bug on the darcs-user list."

-- | 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 rt p wR. MatchableRP p
             => [MatchFlag] -> PatchSet rt p Origin wR
             -> (PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR
matchingHead :: forall (rt :: RepoType) (p :: * -> * -> *) wR.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
matchingHead [MatchFlag]
matchFlags PatchSet rt p Origin wR
set =
    case forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh PatchSet rt p Origin wR
set of
        (PatchSet rt p Origin wZ
start :> RL (PatchInfoAnd rt p) wZ wR
patches) -> PatchSet rt p Origin wZ
start forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd rt p) wZ wR
patches
  where
    mh :: forall wX . PatchSet rt p Origin wX
       -> (PatchSet rt p :> RL (PatchInfoAnd rt p)) Origin wX
    mh :: forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh s :: PatchSet rt p Origin wX
s@(PatchSet RL (Tagged rt p) Origin wX
_ RL (PatchInfoAnd rt p) wX wX
x)
        | forall (t :: * -> *). Foldable t => t Bool -> Bool
or (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
matchFlags) RL (PatchInfoAnd rt p) wX wX
x) = forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wX wY
contextPatches PatchSet rt p Origin wX
s
    mh (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe [Char]
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
x) =
        case forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh (forall (rt :: RepoType) (p :: * -> * -> *) wY wY.
RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t)) of
            (PatchSet rt p Origin wZ
start :> RL (PatchInfoAnd rt p) wZ wX
patches) -> PatchSet rt p Origin wZ
start forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wZ wX
patches forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
x
    mh PatchSet rt p Origin wX
ps = PatchSet rt p Origin wX
ps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. RL a wX wX
NilRL