%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\begin{code}
module PatchMatch ( PatchMatch, Matcher,
                    patch_match, match_pattern,
                    apply_matcher, make_matcher,
                  ) where

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

import PatchInfo ( PatchInfo, just_name, 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 $ "Parse error '"++s++"':  "++show err
    Right m -> MATCH s m
\end{code}

\subsection{Match}

Currently \verb!--match! accepts three 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 regular expression which is checked against
the patch name.  The syntax is
\begin{verbatim}
darcs annotate --summary --match 'name foo'
\end{verbatim}
If you want to include spaces in the regular expression, it must be
enclosed in double quotes (`"'), and currently there is no provision for
escaping a double quote, so you have to choose between matching double
quotes and matching spaces.

The second 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).

There is also now rudimentary 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 yesterday'
darcs changes --from-match 'date "Sat Jun  30 11:31:30 EDT 2004"'
\end{verbatim}
currently date matching always matches only the day itself.  FIXME: It
should be extended to match the time as well if the time is specified.  In
general, a lot of cleanup is needed in the date matching code.

Because the date matching is only by day, you may prefer to combine it 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 patters 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 ]
          , [binary "||" or_match,
             binary "&&" 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
         <|> pname
         <|> phash
         <|> pdate
         <?> "simple match")

pname :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
pname = do trystring "name"
           spaces
           n <- quoted
           return $ mymatch n

phash :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
phash = do trystring "hash"
           spaces
           h <- quoted
           return $ hashmatch h
    where hashmatch h (pinfo,_) = let rh = make_filename pinfo in
                                      (rh == h) || (rh == h++".gz")

pdate :: CharParser st ((PatchInfo, Maybe Patch) -> Bool)
pdate = do trystring "date"
           spaces
           d <- quoted
           let dm = unsafePerformIO $ parseDateMatcher d
           return $ \(pinf,_) -> dm $ pi_date pinf

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 $ noneOf ['"'])
         <|> between spaces spaces (many $ noneOf " ()")
         <?> "string"
\end{code}

\begin{code}
mymatch :: String -> ((PatchInfo, Maybe Patch) -> Bool)
mymatch r (pinfo,_) = isJust $ matchRegex (mkRegex r) $ just_name pinfo
\end{code}