%  Copyright (C) 2002-2003 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}
{-# OPTIONS -fffi -fglasgow-exts #-}
#include "gadts.h"
module Darcs.SelectChanges ( with_selected_changes',
                             with_selected_changes_to_files',
                             with_selected_last_changes_to_files',
                             with_selected_last_changes_reversed',
                       with_selected_changes,
                       with_selected_changes_to_files,
                       with_selected_last_changes_to_files,
                       with_selected_last_changes_to_files_reversed,
                       with_selected_last_changes_reversed,
                       view_changes,
                       with_selected_patch_from_repo,
                     ) where
import System.IO
import Data.List ( intersperse )
import Data.Maybe ( isJust, catMaybes )
import Data.Char ( toUpper )
import Control.Monad ( when )
import System ( exitWith, ExitCode(ExitSuccess) )

import English ( Noun(..), englishNum  )
import Darcs.Hopefully ( PatchInfoAnd, hopefully, n2pia )
import Darcs.Repository ( Repository, read_repo, read_pending )
import Darcs.Patch ( RepoPatch, Patchy, Prim, summary, commute,
                     fromPrims, invert, list_touched_files, anonymous )
import qualified Darcs.Patch ( thing, things )
import Darcs.Patch.Ordered ( FL(..), RL(..), (:<)(..), (:>)(..),
                             (+>+), lengthFL, concatRL, mapFL_FL,
                             spanFL, reverseFL, (+<+), mapFL )
import Darcs.Patch.Choices ( PatchChoices, patch_choices, patch_choices_tps,
                             force_first, force_last, make_uncertain, tag,
                      is_patch_first,
                      separate_first_middle_from_last,
                      separate_first_from_middle_last,
                      separate_middle_last_from_first,
                      select_all_middles,
                      separate_last_from_first_middle,
                      force_matching_last,
                      force_matching_first, make_everything_later,
                      TaggedPatch, tp_patch,
                    )
import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching )
import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager )
import Darcs.SlurpDirectory ( Slurpy )
import Darcs.Match ( have_nonrange_match, match_a_patch, doesnt_not_match )
import Darcs.Flags ( DarcsFlag( DryRun, All, Summary, DontGrabDeps, Verbose
                             ) )
import Darcs.Sealed ( Sealed(..) )
import Darcs.Utils ( askUser, promptCharFancy, without_buffering )
import Printer ( prefix, putDocLn )
#include "impossible.h"
\end{code}

\begin{code}
type WithPatches p a =
        String              -- jobname
     -> [DarcsFlag]         -- opts
     -> Slurpy              -- directory
     -> FL p                -- patches to select among
     -> (FL p :> FL p -> IO a) -- job
     -> IO a                -- result of running job

-- | The only difference with 'WithPatches' is the [FilePath] argument
type WithPatchesToFiles p a =
        String              -- jobname
     -> [DarcsFlag]         -- opts
     -> Slurpy              -- directory
     -> [FilePath]          -- files
     -> FL p                -- patches to select among
     -> (FL p :> FL p -> IO a) -- job
     -> IO a                -- result of running job

with_selected_changes'               :: WithPatches Prim a
with_selected_changes_to_files'      :: WithPatchesToFiles Prim a
with_selected_last_changes_to_files' :: WithPatchesToFiles Prim a
with_selected_last_changes_reversed' :: WithPatches Prim a
                                     
with_selected_changes'               = wasc  (Just First)
with_selected_changes_to_files'      = wasc_ (Just First)
with_selected_last_changes_to_files' = wasc_ (Just Last)
with_selected_last_changes_reversed' = wasc  (Just LastReversed)

with_selected_changes               :: RepoPatch p => WithPatches (PatchInfoAnd p) a
with_selected_changes_to_files      :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a
with_selected_last_changes_to_files :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a
with_selected_last_changes_to_files_reversed :: RepoPatch p => WithPatchesToFiles (PatchInfoAnd p) a
with_selected_last_changes_reversed :: RepoPatch p => WithPatches (PatchInfoAnd p) a
                                    
with_selected_changes               = wasc'  (Just First)
with_selected_changes_to_files      = wasc_' (Just First)
with_selected_last_changes_to_files = wasc_' (Just Last)
with_selected_last_changes_to_files_reversed = wasc_' (Just LastReversed)
with_selected_last_changes_reversed = wasc'  (Just LastReversed)

data WhichChanges = Last | LastReversed | First deriving (Eq, Show)

-- | wasc and wasc_ are just shorthand for with_any_selected_changes
wasc  :: Patchy p => Maybe WhichChanges -> WithPatches p a
wasc mwch j o s = wasc_ mwch j o s []
wasc_ :: Patchy p => Maybe WhichChanges -> WithPatchesToFiles p a
wasc_ = with_any_selected_changes

wasc'  :: RepoPatch p => Maybe WhichChanges -> WithPatches (PatchInfoAnd p) a
wasc' mwch j o s = wasc_' mwch j o s []
wasc_' :: RepoPatch p => Maybe WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a
wasc_' = with_any_selected_changes'

with_any_selected_changes :: Patchy p => Maybe WhichChanges -> WithPatchesToFiles p a
with_any_selected_changes mwch jn opts s fs =
    with_any_selected_changes_ mwch (patches_to_consider mwch fs) jn opts s fs

with_any_selected_changes' :: RepoPatch p => Maybe WhichChanges -> WithPatchesToFiles (PatchInfoAnd p) a
with_any_selected_changes' mwch jn opts s fs =
    with_any_selected_changes_ mwch (patches_to_consider' mwch fs opts) jn opts s fs

view_changes :: RepoPatch p => [DarcsFlag] -> Slurpy -> [FilePath] -> FL (PatchInfoAnd p) -> IO ()
view_changes opts s fp ps =
    with_any_selected_changes' Nothing
                               "view changes" opts s fp ps (\_ -> return ())
\end{code}

\begin{code}
data KeyPress a = KeyPress { kp     :: Char
                           , kpHelp :: String }

helpFor :: String -> [[KeyPress a]] -> String
helpFor jobname options =
  unlines $ [ "How to use "++jobname++":" ]
            ++ (concat $ intersperse [""] $ map (map help) options)
            ++ [ ""
               , "?: show this help"
               , ""
               , "<Space>: accept the current default (which is capitalized)"
               ]
  where help i = kp i:(": "++kpHelp i)

keysFor :: [[KeyPress a]] -> [Char]
keysFor = concatMap (map kp)
\end{code}

\begin{code}
with_selected_patch_from_repo :: RepoPatch p => String -> Repository p -> [DarcsFlag] -> Bool
                              -> ((PatchInfoAnd p,[PatchInfoAnd p]) -> IO ()) -> IO ()
with_selected_patch_from_repo jn repository opts ignore_pending job = do
    Sealed p_s <- read_repo repository
    pend <- if ignore_pending
            then return NilFL
            else read_pending repository
    sp <- without_buffering $ wspfr jn (doesnt_not_match opts)
                              (concatRL p_s) [n2pia $ anonymous $ fromPrims pend]
    case sp of
        Just (selected, s_and_pend) ->
          case (last s_and_pend, init s_and_pend) of
          (pend',skipped) ->
            case commute (pend' :> selected) of
            Just (selected' :> _) -> job (selected', skipped)
            Nothing -> impossible
        Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected."
                      exitWith $ ExitSuccess

wspfr :: RepoPatch p => String -> (PatchInfoAnd p -> Bool)
      -> RL (PatchInfoAnd p) -> [PatchInfoAnd p]
      -> IO (Maybe (PatchInfoAnd p, [PatchInfoAnd p]))
wspfr _ _ NilRL _ = return Nothing
wspfr jn matches (p:<:pps) skipped
    | not $ matches p = wspfr jn matches pps (p:skipped)
    | otherwise =
    case commute_by (skipped :< p) of
    Nothing -> do putStr "\nSkipping depended-upon patch:"
                  printFriendly [] p
                  wspfr jn matches pps (p:skipped)
    Just (p' :< skipped') -> do
      printFriendly [] p
      let repeat_this  = wspfr jn matches (p:<:pps) skipped
          options = [[ KeyPress 'y' (jn++" this patch")
                     , KeyPress 'n' ("don't "++jn++" it")
                     , KeyPress 'v' "view this patch in full"
                     , KeyPress 'p' "view this patch in full with pager"
                     , KeyPress 'x' "view a summary of this patch"
                     , KeyPress 'q' ("cancel "++jn)
                    ]]
      let prompt  = "Shall I "++jn++" this patch?"
      yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h"
      case yorn of
        'y' -> return $ Just (p', skipped')
        'n' -> wspfr jn matches pps (p:skipped)
        'v' -> printPatch p >> repeat_this
        'p' -> printPatchPager p >> repeat_this
        'x' -> do putDocLn $ prefix "    " $ summary p
                  repeat_this
        'q' -> do putStrLn $ jn_cap++" cancelled."
                  exitWith $ ExitSuccess
        _   -> do putStrLn $ helpFor jn options
                  repeat_this
  where jn_cap = (toUpper $ head jn) : tail jn

commute_by :: Patchy p => [p] :< p -> Maybe (p :< [p])
commute_by ([] :< a) = Just (a :< [])
commute_by (p:ps :< a) =
    case commute (a :> p) of
    Nothing -> Nothing
    Just (p':>a') -> case commute_by (ps :< a') of
                     Nothing -> Nothing
                     Just (a'' :< ps') -> Just (a'' :< p':ps')
\end{code}

\begin{code}
with_any_selected_changes_ :: Patchy p => Maybe WhichChanges
                           -> (FL p -> FL p :> FL p)
                           -> WithPatchesToFiles p a
with_any_selected_changes_ mwhichch p2c
                          jobname opts _ _ ps job =
  case mwhichch of
  Nothing -> do without_buffering $ text_view jobname opts ps_len 0 NilRL init_tps init_pc
                job (ps_to_consider :> other_ps)
  Just whichch ->
   if All `elem` opts || DryRun `elem` opts
   then job $ case whichch of LastReversed -> invert other_ps :> invert ps_to_consider
                              _ -> ps_to_consider :> other_ps
   else do pc <- without_buffering $
                 tentatively_text_select "" jobname (Noun "patch") whichch
                                        opts ps_len 0 NilRL init_tps init_pc
           job $ selected_patches whichch rejected_ps pc
 where ps_to_consider :> other_ps = p2c ps
       rejected_ps = if mwhichch == Just Last then ps_to_consider else other_ps
       (init_pc, init_tps) = patch_choices_tps $ case mwhichch of Just Last -> other_ps
                                                                  _ -> ps_to_consider
       ps_len = lengthFL init_tps

patches_to_consider :: Patchy p => Maybe WhichChanges
                    -> [FilePath]  -- ^ files
                    -> FL p     -- ^ patches
                    -> (FL p :> FL p)
patches_to_consider mwhichch fs ps =
  let ps' = if mwhichch == Just LastReversed then invert ps else ps
      f = case mwhichch of Just Last -> separate_middle_last_from_first
                           _ -> separate_first_middle_from_last
      deal_with_fs = case mwhichch of Just Last -> select_not_touching   fs
                                      _ -> deselect_not_touching fs
  in if null fs then if mwhichch == Just Last then NilFL :> ps'  else ps' :> NilFL
                else tp_patches $ f $ deal_with_fs $ patch_choices ps'

patches_to_consider' :: RepoPatch p => Maybe WhichChanges
                     -> [FilePath]  -- ^ files
                     -> [DarcsFlag] -- ^ opts
                     -> FL (PatchInfoAnd p) -- ^ patches
                     -> FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)
patches_to_consider' mwhichch fs opts ps =
  let ps' = if mwhichch == Just LastReversed then invert ps else ps
      f = case mwhichch of Just Last -> separate_middle_last_from_first
                           _ -> separate_first_middle_from_last
      deal_with_fs = case mwhichch of Just Last -> select_not_touching   fs
                                      _ -> deselect_not_touching fs
      deselect_unwanted pc =
        if have_nonrange_match opts
        then case mwhichch of
             Just Last ->  bug "don't support patch matching with Last in wasp"
             _ -> if DontGrabDeps `elem` opts
                  then force_matching_last (not.iswanted) pc
                  else make_everything_later $ force_matching_first iswanted pc
        else pc
      iswanted = let maybe_invert = if mwhichch == Just LastReversed then invert else id
                 in (match_a_patch opts . hopefully . maybe_invert . tp_patch)
  in if null fs && not (have_nonrange_match opts)
     then if mwhichch == Just Last then NilFL :> ps'  else ps' :> NilFL
     else tp_patches $ f $ deal_with_fs $ deselect_unwanted $ patch_choices ps'

-- | Returns the results of a patch selection user interaction
selected_patches :: Patchy p => WhichChanges
                 -> FL p -- ^ patches set aside
                 -> PatchChoices p
                 -> (FL p :> FL p)
selected_patches whichch other_ps pc =
  case whichch of
  Last -> case separate_last_from_first_middle pc of
          xs :> ys -> other_ps +>+ mapFL_FL tp_patch xs :> mapFL_FL tp_patch ys
  First -> case separate_first_from_middle_last pc of
           xs :> ys -> mapFL_FL tp_patch xs :> mapFL_FL tp_patch ys +>+ other_ps
  LastReversed -> case separate_first_from_middle_last pc of
                  xs :> ys -> invert (mapFL_FL tp_patch ys +>+ other_ps) :> invert (mapFL_FL tp_patch xs)

text_select :: Patchy p => String -> WhichChanges -> [DarcsFlag] -> Int -> Int
            -> RL (TaggedPatch p) -> FL (TaggedPatch p) -> PatchChoices p
            -> IO (PatchChoices p)

text_select _ _ _ _ _ _ NilFL pc = return pc
text_select jn whichch opts n_max n
            tps_done tps_todo@(tp:>:tps_todo') pc = do
      printFriendly opts viewp
      repeat_this -- prompt the user
    where
        do_next_action ja je = tentatively_text_select ja jn je whichch opts
                                          n_max
                                          (n+1) (tp:<:tps_done) tps_todo'
        do_next = do_next_action "" (Noun "patch")
        helper :: PatchChoices p -> p
        helper = undefined
        thing  = Darcs.Patch.thing (helper pc)
        things = Darcs.Patch.things (helper pc)
        options_basic =
           [ KeyPress 'y' (jn++" this "++thing)
           , KeyPress 'n' ("don't "++jn++" it")
           , KeyPress 'w' ("wait and decide later, defaulting to no") ]
        options_file =
           [ KeyPress 's' ("don't "++jn++" the rest of the changes to this file")
           , KeyPress 'f' (jn++" the rest of the changes to this file") ]
        options_view =
           [ KeyPress 'v' ("view this "++thing++" in full")
           , KeyPress 'p' ("view this "++thing++" in full with pager") ]
        options_summary =
           [ KeyPress 'x' ("view a summary of this "++thing) ]
        options_quit =
           [ KeyPress 'd' (jn++" selected "++things++", skipping all the remaining "++things)
           , KeyPress 'a' (jn++" all the remaining "++things)
           , KeyPress 'q' ("cancel "++jn) ]
        options_nav =
           [ KeyPress 'j' ("skip to next "++thing)
           , KeyPress 'k' ("back up to previous "++thing) ]
        options = [options_basic]
                  ++ (if is_single_file_patch then [options_file] else [])
                  ++ [options_view ++
                      if Summary `elem` opts then [] else options_summary]
                  ++ [options_quit]
                  ++ [options_nav ]
        prompt = "Shall I "++jn++" this "++thing++"? "
               ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") "
        repeat_this = do
          yorn <- promptCharFancy prompt (keysFor options) (Just the_default) "?h"
          case yorn of
            'y' -> do_next $ force_yes (tag tp) pc
            'n' -> do_next $ force_no (tag tp) pc
            'w' -> do_next $ make_uncertain (tag tp) pc
            's' -> do_next_action "Skipped"  (Noun "change") $ skip_file
            'f' -> do_next_action "Included" (Noun "change") $ do_file
            'v' -> printPatch viewp >> repeat_this
            'p' -> printPatchPager viewp >> repeat_this
            'x' -> do putDocLn $ prefix "    " $ summary viewp
                      repeat_this
            'd' -> return pc
            'a' -> do ask_confirmation
                      return $ select_all_middles (whichch == Last) pc
            'q' -> do putStrLn $ jn_cap++" cancelled."
                      exitWith $ ExitSuccess
            'j' -> case tps_todo' of
                       NilFL -> -- May as well work out the length now we have all
                                -- the patches in memory
                                text_select jn whichch opts
                                    n_max n tps_done tps_todo pc
                       _ -> text_select jn whichch opts
                                n_max (n+1) (tp:<:tps_done) tps_todo' pc
            'k' -> case tps_done of
                        NilRL -> repeat_this
                        (tp':<:tps_done') ->
                           text_select jn whichch opts
                               n_max (n-1) tps_done' (tp':>:tps_todo) pc
            'c' -> text_select jn whichch opts
                                        n_max n tps_done tps_todo pc
            _   -> do putStrLn $ helpFor jn options
                      repeat_this
        force_yes = if whichch == Last then force_last else force_first
        force_no  = if whichch == Last then force_first else force_last
        patches_to_skip = (tag tp:) $ catMaybes
                        $ mapFL (\tp' -> if list_touched_files tp' == touched_files
                                         then Just (tag tp')
                                         else Nothing) tps_todo'
        skip_file = foldr force_no pc patches_to_skip
        do_file = foldr force_yes pc patches_to_skip
        the_default = get_default (whichch == Last) $ is_patch_first tp pc
        jn_cap = (toUpper $ head jn) : tail jn
        touched_files = list_touched_files $ tp_patch tp
        is_single_file_patch = length touched_files == 1
        viewp = if whichch == LastReversed then invert (tp_patch tp) else tp_patch tp
        ask_confirmation =
            if jn `elem` ["unpull", "unrecord", "obliterate"]
            then do yorn <- askUser $ "Really " ++ jn ++ " all undecided patches? "
                    case yorn of
                     ('y':_) -> return ()
                     _ -> exitWith $ ExitSuccess
            else return ()

text_view :: Patchy p => String -> [DarcsFlag] -> Int -> Int
            -> RL (TaggedPatch p) -> FL (TaggedPatch p) -> PatchChoices p
            -> IO (PatchChoices p)

text_view _ _ _ _ _ NilFL _ = return $ patch_choices NilFL --return pc
text_view jn opts n_max n
            tps_done tps_todo@(tp:>:tps_todo') pc = do
      printFriendly opts (tp_patch tp)
      putStr "\n"
      repeat_this -- prompt the user
    where
        prev_patch = case tps_done of
                       NilRL -> repeat_this
                       (tp':<:tps_done') ->
                         text_view jn opts
                            n_max (n-1) tps_done' (tp':>:tps_todo) pc
        next_patch = case tps_todo' of
                         NilFL -> -- May as well work out the length now we have all
                                  -- the patches in memory
                               text_view jn opts n_max
                                   n tps_done tps_todo' pc
                         _ -> text_view jn opts n_max
                                  (n+1) (tp:<:tps_done) tps_todo' pc
        options_yn =
          [ KeyPress 'y' "skip to the next patch"
          , KeyPress 'n' ("quit "++jn) ]
        options_view =
          [ KeyPress 'v' "view this patch in full"
          , KeyPress 'p' "view this patch in fill with pager" ]
        options_summary =
          [ KeyPress 'x' "view a summary of this patch" ]
        options_nav =
          [ KeyPress 'q' ("quit "++jn)
          , KeyPress 'k' "back up to previous patch"
          , KeyPress 'j' "skip to next patch" ]
        options = [ options_yn ]
                  ++ [ options_view ++
                       if Summary `elem` opts then [] else options_summary ]
                  ++ [ options_nav ]
        prompt = "Shall I continue to "++jn++"? "
               ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ")"
        repeat_this = do
          yorn <- promptCharFancy prompt (keysFor options) (Just 'y') "?h"
          case yorn of
            'y' -> next_patch
            'n' -> exitWith ExitSuccess
            'v' -> printPatch (tp_patch tp) >> repeat_this
            'p' -> printPatchPager (tp_patch tp) >> repeat_this
            'x' -> do putDocLn $ prefix "    " $ summary (tp_patch tp)
                      repeat_this
            'q' -> exitWith ExitSuccess
            'k' -> prev_patch
            'j' -> next_patch
            'c' -> text_view jn opts
                       n_max n tps_done tps_todo pc
            _   -> do putStrLn $ helpFor jn options
                      repeat_this

tentatively_text_select :: Patchy p => String -> String -> Noun -> WhichChanges -> [DarcsFlag]
                        -> Int -> Int -> RL (TaggedPatch p) -> FL (TaggedPatch p)
                        -> PatchChoices p
                        -> IO (PatchChoices p)
tentatively_text_select _ _ _ _ _ _ _ _ NilFL pc = return pc
tentatively_text_select jobaction jobname jobelement whichch opts n_max n ps_done
                        ps_todo pc = do
  when (numSkipped > 0) show_skipped
  text_select jobname whichch opts n_max (n + numSkipped)
    (reverseFL skipped +<+ ps_done) unskipped pc
 where
  skipped :> unskipped = spanFL (\p -> isJust $ is_patch_first p pc) ps_todo
  numSkipped  = lengthFL skipped
  show_skipped = do putStrLn $ _doing_ ++ _with_ ++ "."
                    when (Verbose `elem` opts) $ showskippedpatch skipped
    where
      _doing_  = _action_ ++ " " ++ jobname
      _with_   = " of " ++ show numSkipped ++ " " ++ _elem_ ""
      _action_ = if (length jobaction) == 0 then "Skipped" else jobaction
      _elem_ = englishNum numSkipped jobelement
      showskippedpatch (tp:>:tps) = (putDocLn $ prefix "    " $ summary (tp_patch tp)) >> showskippedpatch tps
      showskippedpatch NilFL = return ()

get_default :: Bool -> Maybe Bool -> Char
get_default _ Nothing = 'w'
get_default True (Just True) = 'n'
get_default True (Just False) = 'y'
get_default False (Just True) = 'y'
get_default False (Just False) = 'n'
\end{code}

\begin{code}
tp_patches :: (FL (TaggedPatch p) :> FL (TaggedPatch p)) C(x y)
           -> (FL p :> FL p) C(x y)
tp_patches (x:>y) = mapFL_FL tp_patch x :> mapFL_FL tp_patch y
\end{code}
