src/Darcs/Patch/Match.lhs

   1 %  Copyright (C) 2004 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \begin{code}
  19 {-# OPTIONS_GHC -cpp #-}
  20 {-# LANGUAGE CPP #-}
  21
  22 #include "gadts.h"
  23
  24 module Darcs.Patch.Match ( PatchMatch, Matcher, MatchFun,
  25                     patch_match, match_pattern,
  26                     apply_matcher, make_matcher,
  27                     parseMatch,
  28                     match_parser, helpOnMatchers,
  29                   ) where
  30
  31 import Text.ParserCombinators.Parsec
  32 import Text.ParserCombinators.Parsec.Expr
  33 import Text.Regex ( mkRegex, matchRegex )
  34 import Data.Maybe ( isJust )
  35 import System.IO.Unsafe ( unsafePerformIO )
  36
  37 import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )
  38 import Darcs.Patch ( Patch, Patchy, list_touched_files, patchcontents )
  39 import Darcs.Patch.Info ( just_name, just_author, make_filename,
  40                           pi_date )
  41 import Darcs.Sealed ( Sealed2(..), seal2 )
  42 import DateMatcher ( parseDateMatcher )
  43
  44 import Darcs.Patch.MatchData ( PatchMatch(..), patch_match )
  45
  46 -- | A type for predicates over patches which do not care about
  47 -- contexts
  48 type MatchFun p = Sealed2 (PatchInfoAnd p) -> Bool
  49
  50 -- | A @Matcher@ is made of a 'MatchFun' which we will use to match
  51 -- patches and a @String@ representing it.
  52 data Matcher p = MATCH String (MatchFun p)
  53
  54 instance Show (Matcher p) where
  55     show (MATCH s _) = '"':s ++ "\""
  56
  57 make_matcher :: String -> (Sealed2 (PatchInfoAnd p) -> Bool) -> Matcher p
  58 make_matcher s m = MATCH s m
  59
  60 -- | @apply_matcher@ applies a matcher to a patch.
  61 apply_matcher :: Matcher p -> PatchInfoAnd p C(x y) -> Bool
  62 apply_matcher (MATCH _ m) = m . seal2
  63
  64 parseMatch :: Patchy p => PatchMatch -> Either String (MatchFun p)
  65 parseMatch (PatternMatch s) =
  66     case parse match_parser "match" s of
  67     Left err -> Left $ "Invalid -"++"-match pattern '"++s++
  68                 "'.\n"++ unlines (map ("    "++) $ lines $ show err) -- indent
  69     Right m -> Right m
  70
  71 match_pattern :: Patchy p => PatchMatch -> Matcher p
  72 match_pattern p@(PatternMatch s) =
  73     case parseMatch p of
  74     Left err -> error err
  75     Right m -> make_matcher s m
  76
  77 trivial :: Patchy p => MatchFun p
  78 trivial = const True
  79 \end{code}
  80
  81 \paragraph{Match}
  82
  83 Currently \verb!--match! accepts six primitive match types, although
  84 there are plans to expand it to match more patterns.  Also, note that the
  85 syntax is still preliminary and subject to change.
  86
  87 The first match type accepts a literal string which is checked against
  88 the patch name.  The syntax is
  89 \begin{verbatim}
  90 darcs annotate --summary --match 'exact foo+bar'
  91 \end{verbatim}
  92 This is useful for situations where a patch name contains characters that
  93 could be considered special for regular expressions.
  94
  95 In this and the other match types, the argument must be enclosed in double
  96 quotes if it contains spaces.  You can escape a quote in the argument with a
  97 backslash; backslash escapes itself, but it is treated literally if followed
  98 by a character other than a double quote or backslash, so it is typically not
  99 necessary to escape a backslash.  No such escaping is necessary unless the
 100 argument is enclosed in double quotes.
 101
 102 The second match type accepts a regular expression which is checked against
 103 the patch name.  The syntax is
 104 \begin{verbatim}
 105 darcs annotate --summary --match 'name foo'
 106 \end{verbatim}
 107 Note that to match regexp metacharacters, such as \verb|(|, literally, they
 108 must be escaped with backslash along with any embedded double quotes.  To
 109 match a literal backslash it must be written quadrupled in general, but often
 110 it need not be escaped, since backslash is only special in regexps when
 111 followed by a metacharacter.  In the following example pairs, the first
 112 literal is matched by the second sequence in the match name:
 113 ``\verb|"|'':``\verb|\"|'', ``\verb|\|'':``\verb|\\\\|'',
 114 ``\verb|\x|'':``\verb|\x|'', ``\verb|(|'':``\verb|\(|''.
 115
 116 The third match type matches the darcs hash for each patch:
 117 \begin{verbatim}
 118 darcs annotate --summary --match \
 119   'hash 20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef'
 120 \end{verbatim}
 121 Note you need to provide the full hash string as above.
 122 This is intended to be used, for example, by programs allowing you to view
 123 darcs repositories (e.g.\ CGI scripts like viewCVS).
 124
 125 The fourth match type accepts a regular expression which is checked against
 126 the patch author.  The syntax is
 127 \begin{verbatim}
 128 darcs annotate --summary --match 'author foo'
 129 \end{verbatim}
 130
 131 There is also support for matching by date.  This is done using commands such as
 132 \begin{verbatim}
 133 darcs annotate --summary --match 'date "last week"'
 134 darcs annotate --summary --match 'date yesterday'
 135 darcs annotate --summary --match 'date "today 14:00"'
 136 darcs annotate --summary --match 'date "tea time yesterday"'
 137 darcs annotate --summary --match 'date "3 days before last year at 17:00"'
 138 darcs changes --from-match 'date "Sat Jun  30 11:31:30 EDT 2004"'
 139 \end{verbatim}
 140
 141 Notes: when matching on the ISO format, a partial date is treated as a range.
 142 English dates can either refer to a specific day (``6 months ago',``day before
 143 yesterday''), or to an interval
 144 from some past date (``last month'') to the present.  Putting this all
 145 together, if today is ``2004-07-24'' then the following matches should work:
 146
 147 \begin{tabular}{|ll|}
 148 \hline
 149 \textbf{date} & \textbf{patches selected} \\
 150 \hline
 151 2004          & from 2004-01-01 up to and including 2004-12-31 \\
 152 2004-01       & from 2004-01-01 up to and including 2004-01-31 \\
 153 2004-01-01    & during 2004-01-01 \\
 154 \hline
 155 today         & during 2004-07-24 (starting midnight in your timezone) \\
 156 yesterday     & during 2004-07-23 \\
 157 6 months ago  & during 2004-01-23 \\
 158 \hline
 159 last 6 months & since  2004-01-23 \\
 160 last month    & since  2004-06-23 (not 2004-06-01!) \\
 161 last week     & since  2004-07-16 \\
 162 \hline
 163 \end{tabular}
 164
 165 For more precise control, you may specify an interval, either
 166 in a small subset of English or
 167 of \htmladdnormallinkfoot{the ISO 8601 format}{http://www.w3.org/TR/NOTE-datetime}.
 168 If you use the ISO format, note that durations, when
 169 specified alone, are interpreted as being relative to the current date and time.
 170 \begin{verbatim}
 171 darcs annotate --summary --match 'date "between 2004-03-12 and last week"'
 172 darcs annotate --summary --match 'date "after 2005"'
 173 darcs annotate --summary --match 'date "in the last 3 weeks"'
 174 darcs annotate --summary --match 'date "P3M/2006-03-17"'
 175 darcs annotate --summary --match 'date "2004-01-02/2006-03-17"'
 176 darcs annotate --summary --match 'date "P2M6D"'
 177 \end{verbatim}
 178
 179 You may also prefer to combine date matching with a more specific pattern.
 180 \begin{verbatim}
 181 darcs annotate --summary --match 'date "last week" && name foo'
 182 \end{verbatim}
 183
 184 The sixth match type accepts a regular expression which is checked against
 185 file paths that the patch touches.  The syntax is
 186 \begin{verbatim}
 187 darcs annotate --summary --match 'touch foo/bar.c'
 188 \end{verbatim}
 189
 190 The \verb!--match! pattern can include the logical operators \verb!&&!,
 191 \verb!||! and \verb!not!, as well as grouping of patterns with parentheses.
 192 For example
 193 \begin{verbatim}
 194 darcs annotate --summary --match 'name record && not name overrode'
 195 \end{verbatim}
 196
 197 \begin{code}
 198 match_parser :: Patchy p => CharParser st (MatchFun p)
 199 match_parser = do m <- option trivial submatch
 200                   eof
 201                   return m
 202
 203 submatch :: Patchy p => CharParser st (MatchFun p)
 204 submatch = buildExpressionParser table match <?> "match rule"
 205
 206 table :: OperatorTable Char st (MatchFun p)
 207 table   = [ [prefix "not" negate_match,
 208              prefix "!" negate_match ]
 209           , [binary "||" or_match,
 210              binary "or" or_match,
 211              binary "&&" and_match,
 212             binary "and" and_match ]
 213           ]
 214     where binary name fun =
 215               Infix (do trystring name
 216                         spaces
 217                         return fun) AssocLeft
 218           prefix  name fun = Prefix $ do trystring name
 219                                          spaces
 220                                          return fun
 221           negate_match a p = not (a p)
 222           or_match m1 m2 p = (m1 p) || (m2 p)
 223           and_match m1 m2 p = (m1 p) && (m2 p)
 224
 225 trystring :: String -> CharParser st String
 226 trystring s = try $ string s
 227
 228 match :: Patchy p => CharParser st (MatchFun p)
 229 match = between spaces spaces
 230         (parens submatch
 231          <|> choice matchers_
 232          <?> "simple match")
 233         where matchers_ = map createMatchHelper primitiveMatchers
 234
 235
 236 createMatchHelper :: (String, String, [String], String -> MatchFun p)
 237                   -> CharParser st (MatchFun p)
 238 createMatchHelper (key,_,_,matcher) =
 239   do trystring key
 240      spaces
 241      q <- quoted
 242      return $ matcher q
 243
 244 helpOnMatchers :: String
 245 helpOnMatchers =
 246   let blurb :: (String, String, [String], String -> MatchFun Patch) -> String
 247       blurb (key, help, examples, _) =
 248         "'" ++ key ++ "' " ++ help ++
 249         ", e.g.:\n" ++ (unlines $ map (mkExample key) examples)
 250       mkExample key x =
 251         "  darcs annotate --summary --match '" ++ key ++ " " ++ x ++ "'"
 252   in "Matching patches:\n"
 253      ++ (unlines $ map blurb primitiveMatchers) ++ "\n"
 254      ++ "You can also use logical operators 'and', '&&', 'or', '||', 'not', '!'"
 255      ++ " to combine match expressions, as well as parentheses for grouping. "
 256      ++ " For more details on matching, see the manual."
 257
 258 primitiveMatchers :: Patchy p => [(String, String, [String], String -> MatchFun p)]
 259 primitiveMatchers =
 260  [ ("exact", "checks a literal string against the patch name"
 261            , ["\"my most excellent patch\""]
 262            , exactmatch )
 263  , ("name", "checks a regular expression against the patch name"
 264           , ["[eE]xcellent"]
 265           , mymatch )
 266  , ("author", "checks a regular expression against the author name"
 267             , ["foo@bar"]
 268             , authormatch )
 269  , ("hash",  "matches the darcs hash for a patch"
 270           ,  ["20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef"]
 271           ,  hashmatch )
 272  , ("date", "matches the patch date"
 273           , ["\"tea time yesterday\"", "\"2006-04-02 22:41\""]
 274           , datematch )
 275  , ("touch", "matches file paths for a patch"
 276           , ["\"foo|bar|splotz.*(c|h)\"", "\"some/thing/\""]
 277           , touchmatch ) ]
 278
 279 parens :: CharParser st (MatchFun p)
 280        -> CharParser st (MatchFun p)
 281 parens p  = between (string "(") (string ")") p
 282
 283 quoted :: CharParser st String
 284 quoted = between (char '"') (char '"')
 285                  (many $ do { char '\\' -- allow escapes
 286                             ; try (oneOf ['\\', '"']) <|> return '\\'
 287                             }
 288                          <|>  noneOf ['"'])
 289          <|> between spaces spaces (many $ noneOf " ()")
 290          <?> "string"
 291 \end{code}
 292
 293 \begin{code}
 294 mymatch, exactmatch, authormatch, hashmatch, datematch, touchmatch :: Patchy p => String -> MatchFun p
 295
 296 mymatch r (Sealed2 hp) = isJust $ matchRegex (mkRegex r) $ just_name (info hp)
 297
 298 exactmatch r (Sealed2 hp) = r == (just_name (info hp))
 299
 300 authormatch a (Sealed2 hp) = isJust $ matchRegex (mkRegex a) $ just_author (info hp)
 301
 302 hashmatch h (Sealed2 hp) = let rh = make_filename (info hp) in
 303                                   (rh == h) || (rh == h++".gz")
 304
 305 datematch d (Sealed2 hp) = let dm = unsafePerformIO $ parseDateMatcher d
 306                                   in dm $ pi_date (info hp)
 307
 308 touchmatch r (Sealed2 hp) = let files = list_touched_files $ patchcontents $ hopefully hp
 309                             in or $ map (isJust . matchRegex (mkRegex r)) files
 310 \end{code}