--  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
'"'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
    | 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-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]
""]
  [[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 (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 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 = SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart))
-> SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 = SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart))
-> SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 =
    SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart))
-> SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a b. (a -> b) -> a -> b
$ (forall wX. PatchSet rt p wStart wX -> SealedPatchSet rt p wStart)
-> SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop Int
1) (SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart)
-> SealedPatchSet rt p wStart -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
firstMatcherIsTag [MatchFlag]
fs
      then Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 = Maybe (SealedPatchSet rt 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 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 = SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart))
-> SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a b. (a -> b) -> a -> b
$ Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PatchSet rt p wStart wX
ps
  | Just Matcher
m <- [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs =
    SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a. a -> Maybe a
Just (SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart))
-> SealedPatchSet rt p wStart -> Maybe (SealedPatchSet rt p wStart)
forall a b. (a -> b) -> a -> b
$
    if [MatchFlag] -> Bool
secondMatcherIsTag [MatchFlag]
fs
      then Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
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 = Maybe (SealedPatchSet rt 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 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) =
  MatchFailure -> SealedPatchSet rt p wStart
forall a e. Exception e => e -> a
throw (MatchFailure -> SealedPatchSet rt p wStart)
-> MatchFailure -> SealedPatchSet rt 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 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) =
  Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
matchAPatchset Matcher
m (PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p))
  | Matcher -> PatchInfoAnd rt p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p = PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
ps RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
p))
  | Bool
otherwise = Matcher -> PatchSet rt p wStart wY -> SealedPatchSet rt p wStart
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX 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)
    | Matcher -> PatchInfoAnd rt p wY wX -> Bool
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 = Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
psRL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
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
    | Matcher -> PatchInfoAnd rt p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p =
        case PatchInfo
-> PatchSet rt p Origin wX -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX -> Maybe (PatchSet rt p wStart wX)
splitOnTag (PatchInfoAnd rt p wY wX -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wY wX
p) (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (RL (PatchInfoAnd rt p) wX wY
psRL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:PatchInfoAnd rt p wY wX
p)) of
          Just PatchSet rt p Origin wX
x -> PatchSet rt p wStart wX
PatchSet rt p Origin wX
x
          Maybe (PatchSet rt p Origin wX)
Nothing -> [Char] -> PatchSet rt p wStart wX
forall a. HasCallStack => [Char] -> a
error [Char]
"splitOnTag failed"
    | Bool
otherwise =
        case Matcher -> PatchSet rt p Origin wY -> PatchSet rt p Origin wY
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
splitOnMatchingTag Matcher
m (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX 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' -> RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts' (RL (PatchInfoAnd rt p) wX wY
ps' RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
p)

-- | @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 Matcher -> PatchSet rt p wStart wX -> PatchSet rt p wStart wX
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
_ -> IOError -> SealedPatchSet rt p wStart
forall a e. Exception e => e -> a
throw (IOError -> SealedPatchSet rt p wStart)
-> IOError -> SealedPatchSet rt 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 rt p) Origin wX
ps' RL (PatchInfoAnd rt p) wX wX
_ -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p wStart wX -> SealedPatchSet rt p wStart)
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ps' RL (PatchInfoAnd rt 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
                           , 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 -> Int -> PatchSet rt p Origin wX -> m ()
forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) PatchSet rt p Origin wX
repo
    TagMatch Matcher
m ->
      case Matcher -> PatchSet rt p Origin wX -> PatchSet rt p Origin wX
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
_ -> 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 rt p) Origin wX
_ RL (PatchInfoAnd rt p) wX wX
extras -> RL (PatchInfoAnd rt p) wX wX -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RL (PatchInfoAnd rt p))) m =>
RL (PatchInfoAnd rt p) wX wY -> m ()
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 -> Matcher -> PatchSet rt p Origin wX -> 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
_ -> [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 :: (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) =
  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 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) =
  Matcher -> PatchSet rt p Origin wX -> 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 (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
applyInvToMatcher Matcher
m (PatchSet RL (Tagged rt p) Origin wX
xs (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p))
  | Matcher -> PatchInfoAnd rt p wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
Matcher -> p wX wY -> Bool
applyMatcher Matcher
m PatchInfoAnd rt p wY wX
p = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = PatchInfoAnd rt p wY wX -> m ()
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 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 rt p Origin wY -> 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 (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX 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 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 rt p) Origin wX
NilRL RL (PatchInfoAnd rt 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 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) =
  Int -> PatchSet rt p Origin wX -> m ()
forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv Int
n (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t))
applyNInv Int
n (PatchSet RL (Tagged rt p) Origin wX
xs (RL (PatchInfoAnd rt p) wX wY
ps :<: PatchInfoAnd rt p wY wX
p)) =
  PatchInfoAnd rt p wY wX -> m ()
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 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 rt p Origin wY -> m ()
forall (rt :: RepoType) (p :: * -> * -> *) (m :: * -> *) wX.
(IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m) =>
Int -> PatchSet rt p Origin wX -> m ()
applyNInv (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX 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 = Named p wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (Named p)) m =>
Named p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply (Named p wX wY -> m ())
-> (PatchInfoAnd rt p wX wY -> Named p wX wY)
-> PatchInfoAnd rt p wX wY
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wX wY -> Named p wX wY
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 = (Doc -> Doc) -> PatchInfoAndG rt p wA wB -> p wA wB
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
(Doc -> Doc) -> PatchInfoAndG rt p wA wB -> p wA wB
conscientiously ((Doc -> Doc) -> PatchInfoAndG rt p wA wB -> p wA wB)
-> (Doc -> Doc) -> PatchInfoAndG rt p wA wB -> p wA wB
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 PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wR
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 PatchSet rt p Origin wZ
-> FL (PatchInfoAnd rt p) wZ wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wZ wR -> FL (PatchInfoAnd rt p) wZ wR
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)
        | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((forall wW wZ. PatchInfoAnd rt p wW wZ -> Bool)
-> RL (PatchInfoAnd rt p) wX wX -> [Bool]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL ([MatchFlag] -> PatchInfoAnd rt p wW wZ -> Bool
forall (p :: * -> * -> *) wX wY.
Matchable p =>
[MatchFlag] -> p wX wY -> Bool
matchAPatch [MatchFlag]
matchFlags) RL (PatchInfoAnd rt p) wX wX
x) = PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
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 PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t)) of
            (PatchSet rt p Origin wZ
start :> RL (PatchInfoAnd rt p) wZ wX
patches) -> PatchSet rt p Origin wZ
start PatchSet rt p Origin wZ
-> RL (PatchInfoAnd rt p) wZ wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wZ wX
patches RL (PatchInfoAnd rt p) wZ wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wZ wX
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 PatchSet rt p Origin wX
-> RL (PatchInfoAnd rt p) wX wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL