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

\begin{code}
module PatchMatch ( PatchMatch, Matcher,
                    patch_match, match_pattern,
                    apply_matcher, make_matcher,
                    match_parser, helpOnMatchers,
                  ) where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.Regex ( mkRegex, matchRegex )
import Maybe ( isJust )
import System.IO.Unsafe ( unsafePerformIO )

import PatchInfo ( PatchInfo, just_name, just_author, make_filename, pi_date )
import Patch ( Patch )
import DateMatcher ( parseDateMatcher )

import PatchMatchData ( PatchMatch(..), patch_match )

data Matcher = MATCH String ((PatchInfo, Maybe Patch) -> Bool)

instance Show Matcher where
    show (MATCH s _) = '"':s ++ "\""

make_matcher :: String -> ((PatchInfo, Maybe Patch) -> Bool) -> Matcher
make_matcher s m = MATCH s m

apply_matcher :: Matcher -> (PatchInfo, Maybe Patch) -> Bool
apply_matcher (MATCH _ m) = m

match_pattern :: PatchMatch -> Matcher
match_pattern (PatternMatch s) =
    case parse match_parser "match" s of
    Left err -> error $ "Invalid -"++"-match pattern '"++s++
                "'.\n    "++indent (show err)
        where indent ('\n':cs) = "\n    " ++ indent cs
              indent (c:cs) = c : indent cs
              indent [] = []
    Right m -> MATCH s m
\end{code}

\paragraph{Match}

Currently \verb!--match! accepts five primitive match types, although
there are plans to expand it to match more patterns.  Also, note that the
syntax is still preliminary and subject to change.

The first match type accepts a literal string which is checked against
the patch name.  The syntax is
\begin{verbatim}
darcs annotate --summary --match 'exact foo+bar'
\end{verbatim}
This is useful for situations where a patch name contains characters that
could be considered special for regular expressions.

In this and the other match types, the argument must be enclosed in double
quotes if it contains spaces.  You can escape a quote in the argument with a
backslash; backslash escapes itself, but it is treated literally if followed
by a character other than a double quote or backslash, so it is typically not
necessary to escape a backslash.  No such escaping is necessary unless the
argument is enclosed in double quotes.

The second match type accepts a regular expression which is checked against
the patch name.  The syntax is
\begin{verbatim}
darcs annotate --summary --match 'name foo'
\end{verbatim}
Note that to match regexp metacharacters, such as \verb|(|, literally, they
must be escaped with backslash along with any embedded double quotes.  To
match a literal backslash it must be written quadrupled in general, but often
it need not be escaped, since backslash is only special in regexps when
followed by a metacharacter.  In the following example pairs, the first
literal is matched by the second sequence in the match name:
``\verb|"|'':``\verb|\"|'', ``\verb|\|'':``\verb|\\\\|'',
``\verb|\x|'':``\verb|\x|'', ``\verb|(|'':``\verb|\(|''.

The third match type matches the darcs hash for each patch:
\begin{verbatim}
darcs annotate --summary --match \
  'hash 20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef'
\end{verbatim}
This is intended to be used, for example, by programs allowing you to view
darcs repositories (e.g.\ CGI scripts like viewCVS).

The fourth match type accepts a regular expression which is checked against
the patch author.  The syntax is
\begin{verbatim}
darcs annotate --summary --match 'author foo'
\end{verbatim}

There is also support for matching by date.  This is done using commands such as
\begin{verbatim}
darcs annotate --summary --match 'date "last week"'
darcs annotate --summary --match 'date yesterday'
darcs annotate --summary --match 'date "today 14:00"'
darcs annotate --summary --match 'date "tea time yesterday"'
darcs annotate --summary --match 'date "3 days before last year at 17:00"'
darcs changes --from-match 'date "Sat Jun  30 11:31:30 EDT 2004"'
\end{verbatim}

Note that you may also specify intervals, either in a small subset of English or
of \htmladdnormallinkfoot{the ISO 8601 format}{http://www.w3.org/TR/NOTE-datetime}.
If you use the ISO format, note that durations, when
specified alone, are interpreted as being relative to the current date and time.
\begin{verbatim}
darcs annotate --summary --match 'date "between 2004-03-12 and last week"'
darcs annotate --summary --match 'date "after 2005"'
darcs annotate --summary --match 'date "in the last 3 weeks"'
darcs annotate --summary --match 'date "P3M/2006-03-17"'
darcs annotate --summary --match 'date "2004-01-02/2006-03-17"'
darcs annotate --summary --match 'date "P2M6D"'
\end{verbatim}

You may also prefer to combine date matching with a more specific pattern.
\begin{verbatim}
darcs annotate --summary --match 'date "last week" && name foo'
\end{verbatim}

The \verb!--match! pattern can include the logical operators \verb!&&!,
\verb!||! and \verb!not!, as well as grouping of patterns with parentheses.
For example
\begin{verbatim}
darcs annotate --summary --match 'name record && not name overrode'
\end{verbatim}

\begin{code}
match_parser :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
match_parser = do m <- submatch
                  eof
                  return m

submatch :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
submatch = buildExpressionParser table match <?> "match rule"

table :: OperatorTable Char st ((PatchInfo, Maybe Patch) -> Bool)
table   = [ [prefix "not" negate_match,
             prefix "!" negate_match ]
          , [binary "||" or_match,
             binary "or" or_match,
             binary "&&" and_match,
            binary "and" and_match ]
          ]
    where binary name fun =
              Infix (do trystring name
                        spaces
                        return fun) AssocLeft
          prefix  name fun = Prefix $ do trystring name
                                         spaces
                                         return fun
          negate_match a p = not (a p)
          or_match m1 m2 p = (m1 p) || (m2 p)
          and_match m1 m2 p = (m1 p) && (m2 p)

trystring :: String -> CharParser st String
trystring s = try $ string s

match :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
match = between spaces spaces
        (parens submatch
         <|> choice matchers_
         <?> "simple match")
        where matchers_ = map createMatchHelper primitiveMatchers

type MatchHelper = (PatchInfo, Maybe Patch) -> Bool

createMatchHelper :: (String, String, [String], String -> MatchHelper)
                  -> CharParser st MatchHelper
createMatchHelper (key,_,_,matcher) =
  do trystring key
     spaces
     q <- quoted
     return $ matcher q

helpOnMatchers :: String
helpOnMatchers =
  let blurb (key, help, examples, _) =
        "'" ++ key ++ "' " ++ help ++
        ", e.g.:\n" ++ (unlines $ map (mkExample key) examples)
      mkExample key x =
        "  darcs annotate --summary --match '" ++ key ++ " " ++ x ++ "'"
  in "Matching patches:\n"
     ++ (unlines $ map blurb primitiveMatchers) ++ "\n"
     ++ "You can also use logical operators 'and', '&&', 'or', '||', 'not', '!'"
     ++ " to combine match expressions, as well as parentheses for grouping. "
     ++ " For more details on matching, see the manual."

primitiveMatchers :: [(String, String, [String], String -> MatchHelper)]
primitiveMatchers =
 [ ("exact", "checks a literal string against the patch name"
           , ["\"my most excellent patch\""]
           , exactmatch )
 , ("name", "checks a regular expression against the patch name"
          , ["[eE]xcellent"]
          , mymatch )
 , ("author", "checks a regular expression against the author name"
            , ["foo@bar"]
            , authormatch )
 , ("hash",  "matches the darcs hash for a patch"
          ,  ["20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef"]
          ,  hashmatch )
 , ("date", "matches the patch date"
          , ["\"tea time yesterday\"", "\"2006-04-02 22:41\""]
          , datematch ) ]

parens :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
       -> CharParser st ((PatchInfo, Maybe Patch) -> Bool)
parens p  = between (string "(") (string ")") p

quoted :: CharParser st String
quoted = between (char '"') (char '"')
                 (many $ do { char '\\' -- allow escapes
                            ; try (oneOf ['\\', '"']) <|> return '\\'
                            }
                         <|>  noneOf ['"'])
         <|> between spaces spaces (many $ noneOf " ()")
         <?> "string"
\end{code}

\begin{code}
mymatch, exactmatch, authormatch, hashmatch, datematch :: String -> MatchHelper

mymatch r (pinfo,_) = isJust $ matchRegex (mkRegex r) $ just_name pinfo

exactmatch r (pinfo,_) = r == (just_name pinfo)

authormatch a (pinfo,_) = isJust $ matchRegex (mkRegex a) $ just_author pinfo

hashmatch h (pinfo,_) = let rh = make_filename pinfo in
                        (rh == h) || (rh == h++".gz")

datematch d (pinfo,_) = let dm = unsafePerformIO $ parseDateMatcher d
                        in dm $ pi_date pinfo
\end{code}