%  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.

\begin{code}
module Match ( match_first_patchset, match_second_patchset,
               match_patch,
               match_a_patch, doesnt_not_match, match_a_patchread,
               get_first_match, get_second_match,
               first_match, second_match, have_nonrange_match,
               have_patchset_match, get_one_patchset,
             ) where

import Pristine ( identifyPristine )
import Workaround ( getCurrentDirectory )
import Text.Regex ( mkRegex, matchRegex )
import Monad ( liftM )
import Maybe ( isJust )

import PatchInfo ( PatchInfo, just_name, human_friendly, patchinfo )
import Patch ( Patch, invert, patch2patchinfo, apply )
import Repository ( PatchSet )
import DarcsRepo ( read_repo, apply_patches, createPristineDirectoryTree )
import Depends ( get_patches_in_tag )

import Depends ( get_patches_beyond_tag, )

import FastPackedString ( mmapFilePS )
import PatchBundle ( scan_context )
import DarcsUtils ( withCurrentDirectory )
import DarcsArguments ( DarcsFlag( OnePatch, SeveralPatch, Context,
                                   AfterPatch, UpToPatch, LastN,
                                   OneTag, AfterTag, UpToTag,
                                   OnePattern, SeveralPattern,
                                   AfterPattern, UpToPattern ) )
import PatchMatch ( Matcher, match_pattern, apply_matcher, make_matcher )
import Printer ( errorDoc, text, ($$) )
#include "impossible.h"
\end{code}

\paragraph{Selecting patches}\label{selecting}

Many commands operate on a patch or patches that have already been recorded.
There are a number of options that specify which patches are selected for
these operations: \verb!--patch!, \verb!--match!, \verb!--tag!, and variants
on these, which for \verb!--patch! are \verb!--patches!,
\verb!--from-patch!, and \verb!--to-patch!.  The \verb!--patch! and
\verb!--tag! forms simply take (POSIX extended, aka \verb!egrep!) regular
expressions and match them against tag and patch names.  \verb!--match!,
described below, allows more powerful patterns.

The plural forms of these options select all matching patches.  The singular
forms select the last matching patch.  The range (from and to) forms select
patches after or up to (both inclusive) the last matching patch.

These options use the current order of patches in the repository.  darcs may
reorder patches, so this is not necessarily the order of creation or the
order in which patches were applied.  However, as long as you are just
recording patches in your own repository, they will remain in order.

\begin{code}
have_nonrange_match :: [DarcsFlag] -> Bool
have_nonrange_match fs = isJust (nonrange_matcher fs)

have_patchset_match :: [DarcsFlag] -> Bool
have_patchset_match fs = isJust (nonrange_matcher fs) || hasC fs
    where hasC [] = False
          hasC (Context _:_) = True
          hasC (_:xs) = hasC xs

first_match :: [DarcsFlag] -> Bool
first_match fs = isJust (has_lastn fs) || isJust (first_matcher fs)

get_first_match :: FilePath -> [DarcsFlag] -> IO ()
get_first_match r fs =
    case has_lastn fs of
    Just n -> get_dropn r n
    Nothing -> case first_matcher fs of
               Nothing -> fail "Pattern not specified in get_first_match."
               Just m -> if first_matcher_is_tag fs
                         then get_tag r m
                         else get_before_matcher r m

second_match :: [DarcsFlag] -> Bool
second_match fs = isJust $ second_matcher fs

get_second_match :: FilePath -> [DarcsFlag] -> IO ()
get_second_match r fs =
    case second_matcher fs of
    Nothing -> fail "Two patterns not specified in get_second_match."
    Just m -> if second_matcher_is_tag fs
              then get_tag r m
              else get_matcher r m
\end{code}

\begin{code}
tagmatch :: String -> Matcher
tagmatch r = make_matcher ("tag-name "++r) tm
    where tm (pinfo,_) =
              let n = just_name pinfo in
              take 4 n == "TAG " && isJust (matchRegex (mkRegex r) $ drop 4 n)

mymatch :: String -> Matcher
mymatch r = make_matcher ("patch-name "++r) mm
    where mm (pinfo,_) = isJust $ matchRegex (mkRegex r) $ just_name pinfo

nonrange_matcher :: [DarcsFlag] -> Maybe Matcher
nonrange_matcher [] = Nothing
nonrange_matcher (OnePattern m:_) = Just $ match_pattern m
nonrange_matcher (OneTag t:_) = Just $ tagmatch t
nonrange_matcher (OnePatch p:_) = Just $ mymatch p
nonrange_matcher (SeveralPattern m:_) = Just $ match_pattern m
nonrange_matcher (SeveralPatch p:_) = Just $ mymatch p
nonrange_matcher (_:fs) = nonrange_matcher fs

nonrange_matcher_is_tag :: [DarcsFlag] -> Bool
nonrange_matcher_is_tag [] = False
nonrange_matcher_is_tag (OneTag _:_) = True
nonrange_matcher_is_tag (_:fs) = nonrange_matcher_is_tag fs

first_matcher :: [DarcsFlag] -> Maybe Matcher
first_matcher [] = Nothing
first_matcher (OnePattern m:_) = Just $ match_pattern m
first_matcher (AfterPattern m:_) = Just $ match_pattern m
first_matcher (AfterTag t:_) = Just $ tagmatch t
first_matcher (OnePatch p:_) = Just $ mymatch p
first_matcher (AfterPatch p:_) = Just $ mymatch p
first_matcher (_:fs) = first_matcher fs

first_matcher_is_tag :: [DarcsFlag] -> Bool
first_matcher_is_tag [] = False
first_matcher_is_tag (AfterTag _:_) = True
first_matcher_is_tag (_:fs) = first_matcher_is_tag fs

second_matcher :: [DarcsFlag] -> Maybe Matcher
second_matcher [] = Nothing
second_matcher (OnePattern m:_) = Just $ match_pattern m
second_matcher (UpToPattern m:_) = Just $ match_pattern m
second_matcher (OnePatch p:_) = Just $ mymatch p
second_matcher (UpToPatch p:_) = Just $ mymatch p
second_matcher (UpToTag t:_) = Just $ tagmatch t
second_matcher (_:fs) = second_matcher fs

second_matcher_is_tag :: [DarcsFlag] -> Bool
second_matcher_is_tag [] = False
second_matcher_is_tag (UpToTag _:_) = True
second_matcher_is_tag (_:fs) = second_matcher_is_tag fs
\end{code}

\begin{code}
doesnt_not_match :: [DarcsFlag] -> (PatchInfo, Maybe Patch) -> Bool
doesnt_not_match fs =
    case nonrange_matcher fs of
    Nothing -> \_ -> True
    Just m -> apply_matcher m

match_a_patchread :: [DarcsFlag] -> (PatchInfo, Maybe Patch) -> Bool
match_a_patchread fs = case nonrange_matcher fs of
                       Nothing -> bug "Couldn't match_a_patch."
                       Just m -> apply_matcher m

match_a_patch :: [DarcsFlag] -> Patch -> Bool
match_a_patch fs p =
    case nonrange_matcher fs of
    Nothing -> bug "Couldn't match_a_patch."
    Just m ->
        case patch2patchinfo p of
        Nothing -> apply_matcher m (patchinfo "NAMELESS MATCHING" "" "" [],
                                    Just p)
        Just pinfo -> apply_matcher m (pinfo, Just p)

match_patch :: [DarcsFlag] -> PatchSet -> Patch
match_patch fs ps = case nonrange_matcher fs of
                    Nothing -> bug "Couldn't match_patch"
                    Just m -> find_a_patch m ps

get_one_patchset :: [DarcsFlag] -> IO PatchSet
get_one_patchset fs =
    case nonrange_matcher fs of
        Just m -> do ps <- read_repo "."
                     if nonrange_matcher_is_tag fs
                        then return $ get_matching_tag m ps
                        else return $ match_a_patchset m ps
        Nothing -> scan_context `liftM` mmapFilePS (context_f fs)
    where context_f [] = bug "Couldn't match_nonrange_patchset"
          context_f (Context f:_) = f
          context_f (_:xs) = context_f xs

has_lastn :: [DarcsFlag] -> Maybe Int
has_lastn [] = Nothing
has_lastn (LastN (-1):_) = error "--last requires an integer argument."
has_lastn (LastN n:_) = Just n
has_lastn (_:fs) = has_lastn fs

match_first_patchset :: [DarcsFlag] -> PatchSet -> PatchSet
match_first_patchset fs patchset =
    case has_lastn fs of
    Just n -> dropn n patchset
    Nothing -> case first_matcher fs of
               Nothing -> bug "Couldn't match_first_patchset"
               Just m -> dropn 1 $ if first_matcher_is_tag fs
                                   then get_matching_tag m patchset
                                   else match_a_patchset m patchset
    where dropn :: Int -> PatchSet -> PatchSet
          dropn n ([]:ps) = dropn n ps
          dropn 0 ps = ps
          dropn _ [] = [[]]
          dropn n ((_:ps):xs) = dropn (n-1) $ ps:xs

match_second_patchset :: [DarcsFlag] -> PatchSet -> PatchSet
match_second_patchset fs ps =
    case second_matcher fs of
    Nothing -> bug "Couldn't match_second_patchset"
    Just m -> if second_matcher_is_tag fs
              then get_matching_tag m ps
              else match_a_patchset m ps

find_a_patch :: Matcher -> PatchSet -> Patch
find_a_patch m [] = error $ "Couldn't find patch matching " ++ show m
find_a_patch m ([]:xs) = find_a_patch m xs
find_a_patch m ((p:ps):xs) | apply_matcher m $ p = the_p
                           | otherwise = find_a_patch m (ps:xs)
    where the_p = case p of
                  (_, Just foo) -> foo
                  (pinf, Nothing) -> errorDoc $ text "Couldn't read patch:"
                                             $$ human_friendly pinf

match_a_patchset :: Matcher -> PatchSet -> PatchSet
match_a_patchset m [] = error $ "Couldn't find patch matching " ++ show m
match_a_patchset m ([]:xs) = match_a_patchset m xs
match_a_patchset m ((p:ps):xs) | apply_matcher m $ p = ((p:ps):xs)
                               | otherwise = match_a_patchset m (ps:xs)

get_matching_tag :: Matcher -> PatchSet -> PatchSet
get_matching_tag m [] = error $ "Couldn't find a tag matching " ++ show m
get_matching_tag m ([]:xs) = get_matching_tag m xs
get_matching_tag m xxx@((p:ps):xs)
    | apply_matcher m $ p = case p of (pinf,_) -> get_patches_in_tag pinf xxx
    | otherwise = get_matching_tag m (ps:xs)
\end{code}

\begin{code}
match_exists :: Matcher -> PatchSet -> Bool
match_exists _ [] = False
match_exists m ([]:xs) = match_exists m xs
match_exists m ((p:ps):xs) | apply_matcher m $ p = True
                           | otherwise = match_exists m (ps:xs)
\end{code}

\begin{code}
createRemotePristineDirectoryTree :: FilePath -> IO ()
createRemotePristineDirectoryTree r
 = do d <- getCurrentDirectory
      withCurrentDirectory r $ do
          pris <- identifyPristine
          createPristineDirectoryTree pris d

get_matcher :: String -> Matcher -> IO ()
get_matcher r m = do repo <- read_repo r
                     if match_exists m repo
                        then do createRemotePristineDirectoryTree r
                                apply_foo repo
                        else fail $ "Couldn't match pattern "++ show m
    where apply_foo [] = impossible
          apply_foo ([]:xs) = apply_foo xs
          apply_foo ((p:ps):xs)
              | apply_matcher m p = return ()
              | otherwise = apply_invp p >> apply_foo (ps:xs)

get_before_matcher :: String -> Matcher -> IO ()
get_before_matcher r m =
    do repo <- read_repo r
       if match_exists m repo
          then do createRemotePristineDirectoryTree r
                  apply_foo repo
          else fail $ "Couldn't match pattern "++ show m
    where apply_foo [] = impossible
          apply_foo ([]:xs) = apply_foo xs
          apply_foo ((p:ps):xs)
              | apply_matcher m p = apply_invp p
              | otherwise = apply_invp p >> apply_foo (ps:xs)

apply_invp :: (PatchInfo, Maybe Patch) -> IO ()
apply_invp p = apply [] (invert $ fromJustP p) `catch` \e ->
                   fail ("Inverse patch failed!\n" ++ show e)
    where fromJustP (_, Just pa) = pa
          fromJustP (pinf, Nothing) =
             errorDoc $ text "Sorry, partial repository problem.  The patch"
                     $$ human_friendly pinf
                     $$ text "is not available."
                     $$ text ""
                     $$ text "If you think what you're trying to do is ok then"
                     $$ text "report this as a bug on the darcs-user list."

get_dropn :: String -> Int -> IO ()
get_dropn r n = do createRemotePristineDirectoryTree r
                   repo <- read_repo r
                   apply_patches [] silently silently $
                                 map invit $ safetake n $ concat repo
    where invit (pinf, Nothing) = (pinf, Nothing)
          invit (pinf, Just p) = (pinf, Just $ invert p)
          safetake 0 _ = []
          safetake _ [] = error "There aren't that many patches..."
          safetake i (a:as) = a : safetake (i-1) as
          silently _ = return ()
\end{code}

\begin{code}
get_tag :: String -> Matcher -> IO ()
get_tag r match = do
    ps <- read_repo r
    let pinfo = fromJust $ patch2patchinfo $ find_a_patch match ps
    case get_patches_beyond_tag pinfo ps of
        [extras] -> do createRemotePristineDirectoryTree r
                       apply_patches [] noPut noPut $ map invert_it extras
        _ -> impossible
    where noPut _ = return ()
          invert_it (pin, Just p) = (pin, Just $ invert p)
          invert_it (pin, Nothing) =
              errorDoc $ text "Couldn't read patch:" $$ human_friendly pin
\end{code}