--  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 Text.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 -> String
show (MATCH String
s MatchFun
_) = Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

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 -> String
(Int -> MatchFlag -> ShowS)
-> (MatchFlag -> String)
-> ([MatchFlag] -> ShowS)
-> Show MatchFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchFlag] -> ShowS
$cshowList :: [MatchFlag] -> ShowS
show :: MatchFlag -> String
$cshow :: MatchFlag -> String
showsPrec :: Int -> MatchFlag -> ShowS
$cshowsPrec :: Int -> MatchFlag -> ShowS
Show)

makeMatcher :: String -> MatchFun -> Matcher
makeMatcher :: String -> MatchFun -> Matcher
makeMatcher = String -> MatchFun -> Matcher
MATCH

-- | @applyMatcher@ applies a matcher to a patch.
applyMatcher :: Matchable p => Matcher -> p wX wY -> Bool
applyMatcher :: Matcher -> p wX wY -> Bool
applyMatcher (MATCH String
_ (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 :: String -> Either String Matcher
parseMatch String
pattern =
    case Parsec String () MatchFun
-> String -> String -> Either ParseError MatchFun
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () MatchFun
forall st. CharParser st MatchFun
matchParser String
"match" String
pattern of
    Left ParseError
err -> String -> Either String Matcher
forall a b. a -> Either a b
Left (String -> Either String Matcher)
-> String -> Either String Matcher
forall a b. (a -> b) -> a -> b
$ String
"Invalid --match pattern '"String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pattern String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
"'.\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err) -- indent
    Right MatchFun
m -> Matcher -> Either String Matcher
forall a b. b -> Either a b
Right (String -> MatchFun -> Matcher
makeMatcher String
pattern MatchFun
m)

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

matchParser :: CharParser st MatchFun
matchParser :: CharParser st MatchFun
matchParser = CharParser st MatchFun
forall st. CharParser st MatchFun
submatcher CharParser st MatchFun -> String -> CharParser st MatchFun
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
helpfulErrorMsg
  where
    submatcher :: ParsecT String u Identity MatchFun
submatcher = do
        MatchFun
m <- MatchFun
-> ParsecT String u Identity MatchFun
-> ParsecT String 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 String u Identity MatchFun
forall st. CharParser st MatchFun
submatch
        ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        MatchFun -> ParsecT String u Identity MatchFun
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 :: String
helpfulErrorMsg = String
"valid expressions over: "
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((String, String, String, [String], String -> MatchFun) -> String)
-> [(String, String, String, [String], String -> MatchFun)]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String
_, String
_, [String]
_, String -> MatchFun
_) -> String
name) [(String, String, String, [String], String -> MatchFun)]
ps)
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nfor more help, see `darcs help patterns`."

    ps :: [(String, String, String, [String], String -> MatchFun)]
ps = [(String, String, String, [String], String -> 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 :: CharParser st MatchFun
submatch = OperatorTable Char st MatchFun
-> CharParser st MatchFun -> CharParser 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 CharParser st MatchFun
forall st. CharParser st MatchFun
match

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

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

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

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

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

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

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

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

namematch :: String -> MatchFun
namematch String
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 [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justName (p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

exactmatch :: String -> MatchFun
exactmatch String
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) -> String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo -> String
justName (p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

authormatch :: String -> MatchFun
authormatch String
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 [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
a) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justAuthor (p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

logmatch :: String -> MatchFun
logmatch String
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 [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
l) (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PatchInfo -> String
justLog (p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)

hunkmatch :: String -> MatchFun
hunkmatch String
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 [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool)
-> (ByteString -> Maybe [String]) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r) (String -> Maybe [String])
-> (ByteString -> String) -> ByteString -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack
     in (ByteString -> Bool) -> 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 :: String -> MatchFun
hashmatch String
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 :: String
rh = SHA1 -> String
forall a. Show a => a -> String
show (SHA1 -> String) -> SHA1 -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> SHA1
makePatchname (p wX wY -> PatchId p
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident p wX wY
hp)
        lh :: String
lh = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
h
     in (String
lh String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
rh) Bool -> Bool -> Bool
|| (String
lh String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rh String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".gz")

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

touchmatch :: String -> MatchFun
touchmatch String
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 (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
hp
     in (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool)
-> (String -> Maybe [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex String
r)) ((AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> AnchoredPath -> String
anchorPath String
".") [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 String
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
$ String -> Matcher
tagmatch String
t
patchSetMatch (OnePattern String
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
$ String -> Matcher
matchPattern String
m
patchSetMatch (OnePatch String
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
$ String -> Matcher
patchmatch String
p
patchSetMatch (OneHash String
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
$ String -> Matcher
hashmatch' String
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 String
getMatchPattern [MatchFlag]
opts of
    Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just String
p ->
      (String -> IO ())
-> (Matcher -> IO ()) -> Either String Matcher -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> 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 (m :: * -> *) a. Monad m => a -> m a
return ())
        (String -> Either String Matcher
parseMatch String
p)

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

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

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

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


-- | strictJust is a strict version of the Just constructor, used to ensure
-- that if we claim we've got a pattern match, that the pattern will
-- actually match (rathern than fail to compile properly).
strictJust :: a -> Maybe a
strictJust :: a -> Maybe a
strictJust 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 String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
nonrangeMatcher (OneTag String
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
tagmatch String
t
nonrangeMatcher (OnePatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
p
nonrangeMatcher (OneHash String
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
hashmatch' String
h
nonrangeMatcher (SeveralPattern String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
nonrangeMatcher (SeveralPatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
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 String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
firstMatcher (AfterPattern String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
firstMatcher (AfterTag String
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
tagmatch String
t
firstMatcher (OnePatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
p
firstMatcher (AfterPatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
p
firstMatcher (OneHash String
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
hashmatch' String
h
firstMatcher (AfterHash String
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
hashmatch' String
h
firstMatcher (MatchFlag
_:[MatchFlag]
fs) = [MatchFlag] -> Maybe Matcher
firstMatcher [MatchFlag]
fs

firstMatcherIsTag :: [MatchFlag] -> Bool
firstMatcherIsTag :: [MatchFlag] -> Bool
firstMatcherIsTag [] = Bool
False
firstMatcherIsTag (AfterTag String
_:[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 String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
secondMatcher (UpToPattern String
m:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
matchPattern String
m
secondMatcher (OnePatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
p
secondMatcher (UpToPatch String
p:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
patchmatch String
p
secondMatcher (OneHash String
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
hashmatch' String
h
secondMatcher (UpToHash String
h:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
hashmatch' String
h
secondMatcher (UpToTag String
t:[MatchFlag]
_) = Matcher -> Maybe Matcher
forall a. a -> Maybe a
strictJust (Matcher -> Maybe Matcher) -> Matcher -> Maybe Matcher
forall a b. (a -> b) -> a -> b
$ String -> Matcher
tagmatch String
t
secondMatcher (MatchFlag
_:[MatchFlag]
fs) = [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs

secondMatcherIsTag :: [MatchFlag] -> Bool
secondMatcherIsTag :: [MatchFlag] -> Bool
secondMatcherIsTag [] = Bool
False
secondMatcherIsTag (UpToTag String
_:[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 :: [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]
_) = String -> Maybe Int
forall a. HasCallStack => String -> a
error String
"--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 :: [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 :: [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 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
             String -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => String -> a
error String
"index matches not supported by splitSecondPatchesFL"
   Maybe (Int, Int)
Nothing ->
     case [MatchFlag] -> Maybe Matcher
secondMatcher [MatchFlag]
fs of
     Maybe Matcher
Nothing -> String -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => String -> a
error String
"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 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 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 = String -> (:>) (FL q) (FL q) wX wY
forall a. HasCallStack => String -> a
error (String -> (:>) (FL q) (FL q) wX wY)
-> String -> (:>) (FL q) (FL q) wX wY
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find a patch matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher -> String
forall a. Show a => a -> String
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 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 -> String
show (MatchFailure String
m) =
    String
"Couldn't find a patch matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
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 :: 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
$ String -> MatchFailure
MatchFailure (String -> MatchFailure) -> String -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> String
forall a. Show a => a -> String
show Matcher
m
matchAPatchset Matcher
m (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe String
_ RL (PatchInfoAnd rt p) wY wY
ps) RL (PatchInfoAnd rt p) wX wX
NilRL) =
  Matcher -> PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
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 Origin wX -> SealedPatchSet rt p Origin
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 Origin wY -> SealedPatchSet rt p Origin
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 :: 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 String
_ 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 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 (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
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 -> String -> PatchSet rt p wStart wX
forall a. HasCallStack => String -> a
error String
"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 :: 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
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find a tag matching " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matcher -> String
forall a. Show a => a -> String
show Matcher
m
    PatchSet RL (Tagged rt p) Origin wX
ps' RL (PatchInfoAnd rt p) wX wX
_ -> PatchSet rt p Origin wX -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p Origin wX -> Sealed (PatchSet rt p Origin))
-> PatchSet rt p Origin wX -> Sealed (PatchSet rt p Origin)
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 :: 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
$ String -> MatchFailure
MatchFailure (String -> MatchFailure) -> String -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> String
forall a. Show a => a -> String
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 (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
_ -> String -> m ()
forall a. HasCallStack => String -> a
error String
"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 :: 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
$ String -> MatchFailure
MatchFailure (String -> MatchFailure) -> String -> MatchFailure
forall a b. (a -> b) -> a -> b
$ Matcher -> String
forall a. Show a => a -> String
show Matcher
m
applyInvToMatcher Matcher
m (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe String
_ 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 (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 (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 :: 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 (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
$ String -> IOError
userError String
"Index out of range"
applyNInv Int
n (PatchSet (RL (Tagged rt p) Origin wY
ts :<: Tagged PatchInfoAnd rt p wY wX
t Maybe String
_ 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 (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 :: PatchInfoAnd rt p wX wY -> m ()
applyInvp = 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 ->
                     String -> Doc
text String
"Sorry, patch not available:"
                     Doc -> Doc -> Doc
$$ Doc
e
                     Doc -> Doc -> Doc
$$ String -> Doc
text String
""
                     Doc -> Doc -> Doc
$$ String -> Doc
text String
"If you think what you're trying to do is ok then"
                     Doc -> Doc -> Doc
$$ String -> Doc
text String
"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 :: [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 :: 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 String
_ 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