%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{darcs record}
\begin{code}
module SelectChanges ( with_selected_changes,
                       with_selected_changes_to_files,
                       with_selected_last_changes_to_files,
                       with_selected_changes_reversed,
#ifdef HAVEWX
                       gui_change_selector,
#endif
                       with_selected_patch_from_repo,
                       promptChar,
                     ) where
#ifdef HAVEWX
import Graphics.UI.WX ( widget, floatLeft, text, staticText, command,
                        on, set, checked, get, clientSize, bestSize,
                        Layout, Window, CheckBox, ScrolledWindow,
                        Prop((:=)),
                        row, size, checkBox, column, layout, rigid,
                        scrolledWindow, scrollRate,
                        fill, hspace, hglue, margin, close, button,
                        panel, frame, start,
                      )
import Graphics.UI.WXCore ( windowSetSizeHints )
import Data.IORef
import System ( ExitCode( ExitSuccess ), exitWith )
#endif
import IO hiding ( bracket )
import System.IO ( hIsTerminalDevice )
import Control.Exception ( bracket )
import Maybe ( catMaybes )
import Char ( toUpper )
import Monad ( when )
import System ( exitWith, ExitCode(ExitSuccess) )

import Repository ( read_repo, read_pending )
import Patch ( Patch, patch2patchinfo, is_similar, patch_summary, commute,
               join_patches, invert,
             )
import PatchInfo ( PatchInfo, human_friendly )
import PatchChoices ( PatchChoices, patch_choices,
                      force_first, force_last, make_uncertain,
                      is_patch_first,
                      get_first_choice, get_middle_choice, get_last_choice,
                      force_matching_first, make_everything_later,
                    )
import TouchesFiles ( deselect_not_touching, select_not_touching )
import PrintPatch ( printPatch )
import SlurpDirectory ( Slurpy )
import Match ( have_nonrange_match, match_a_patch, doesnt_not_match )
import DarcsFlags ( DarcsFlag( DryRun, All ) )
#include "impossible.h"
\end{code}

\begin{code}
with_selected_changes :: String -> [DarcsFlag] -> Slurpy
                      -> [Patch]
                      -> (([Patch],[Patch]) -> IO a) -> IO a
with_selected_changes_to_files :: String -> [DarcsFlag] -> Slurpy
                              -> [FilePath] -> [Patch]
                              -> (([Patch],[Patch]) -> IO a) -> IO a
with_selected_last_changes_to_files :: String -> [DarcsFlag] -> Slurpy
                                    -> [FilePath] -> [Patch]
                                    -> (([Patch],[Patch]) -> IO a) -> IO a
with_any_selected_changes :: String -> [DarcsFlag] -> Slurpy
                          -> Bool -> Bool -> [FilePath] -> [Patch]
                          -> (([Patch],[Patch]) -> IO a) -> IO a
with_selected_changes_reversed :: String -> [DarcsFlag] -> Slurpy
                               -> [Patch]
                               -> (([Patch],[Patch]) -> IO a) -> IO a
with_selected_changes jobname opts s ps job =
    with_any_selected_changes jobname opts s False False [] ps job
with_selected_changes_to_files jobname opts s fs ps job =
    with_any_selected_changes jobname opts s False False fs ps job
with_selected_last_changes_to_files jobname opts s fs ps job =
    with_any_selected_changes jobname opts s True False fs ps job
with_selected_changes_reversed jobname opts s ps job =
    with_any_selected_changes jobname opts s True True [] ps job

with_selected_patch_from_repo :: String -> [DarcsFlag] -> Bool
                              -> ((Patch,[Patch]) -> IO ()) -> IO ()
\end{code}

\begin{code}
#ifdef HAVEWX
gui_select :: String -> Bool -> [DarcsFlag] -> [Patch]
           -> (([Patch],[Patch]) -> IO a) -> IO a
gui_select jn islast _ ps job = do start gs
                                   exitWith ExitSuccess
  where
  gs = do
    parent <- frame [text := cap_jn]
    f <- panel parent []
    pc <- newIORef $ patch_choices ps
    scrolled <- gui_change_selector f pc
    quit <- button f [text := "Cancel", on command := close parent]
    bs <- get quit bestSize
    set quit [clientSize := bs]
    rec <- button f [text := cap_jn,
                     on command := do
                       rpc <- readIORef pc
                       if islast
                           then job (get_last_choice rpc,
                                     get_first_choice rpc++get_middle_choice rpc)
                           else job (get_middle_choice rpc++get_last_choice rpc,
                                     get_first_choice rpc)
                       close parent
                    ]
    set rec [clientSize := bs]
    set f [layout := column 0 [fill $ widget scrolled,
                               margin 5 $ row 5 [hglue, widget quit,
                                                 widget rec,hspace 20]],
           clientSize := size 600 400 -- this is window actual size
          ]
    set parent [layout := fill $ widget f]
    where cap_jn = (toUpper $ head jn) : tail jn

gui_change_selector :: Window a -> IORef PatchChoices -> IO (ScrolledWindow ())
gui_change_selector w pc = gen_gui_change_selector w pc False

gen_gui_change_selector :: Window a -> IORef PatchChoices -> Bool
                        -> IO (ScrolledWindow ())
gen_gui_change_selector w pc islast = do
    scrolled <- scrolledWindow w [scrollRate := size 20 20]
    rpc <- readIORef pc
    ps <- return $ get_first_choice rpc++get_middle_choice rpc++get_last_choice rpc
    guibps <- sequence $ map (boxpatch scrolled) ps
    set_callbacks islast pc $ zip (map fst guibps) ps
    set scrolled [layout :=  rigid $ column 0 $ map bps2l guibps]
    windowSetSizeHints scrolled (-1) (-1) (-1) (-1) (-1) (-1)
    set scrolled [clientSize := size 40 20] -- this is minimum size
    return scrolled

bps2l (x,y) = row 0 [widget x, y]
boxpatch :: Window a -> Patch -> IO (CheckBox (), Layout)
boxpatch w p = do gp <- guipatch w p
                  b <- checkBox w []
                  bs <- get b bestSize
                  set b [clientSize := bs]
                  return (b,gp)

set_callbacks :: Bool -> IORef PatchChoices -> [(CheckBox (),Patch)] -> IO ()
set_callbacks islast pc cps = sequence_ $ map set_cmd cps
    where setstate rpc (cb,p) =
              set cb [checked := is_patch_first p rpc == Just (not islast)]
          update_state = do real_pc <- readIORef pc
                            sequence_ $ map (setstate real_pc) cps
          force_yes = if islast then force_last else force_first
          force_no  = if islast then force_first else force_last
          the_cmd (cb,p) = do am_checked <- get cb checked
                              if am_checked then modifyIORef pc $ force_yes p
                                            else modifyIORef pc $ force_no p
                              update_state
          set_cmd (cb,p) = set cb [on command := the_cmd (cb,p)]

guipatch :: Window a -> Patch -> IO Layout
guipatch w p = do st <- staticText w [text := head $ lines $ show p]
                  return $ floatLeft $ widget st
#endif
\end{code}

\begin{code}
with_selected_patch_from_repo jn opts ignore_pending job = do
    p_s <- read_repo "."
    pend <- if ignore_pending
            then return $ Just $ join_patches []
            else read_pending
    sp <- without_buffering $ wspfr jn (doesnt_not_match opts)
                              (concat p_s) [join_patches $ catMaybes [pend]]
    case sp of
        Just (selected, s_and_pend) ->
          case (head $ reverse s_and_pend, reverse $ tail $ reverse s_and_pend) of
          (pend',skipped) ->
            case commute (selected, pend') of
            Just (_, selected') -> job (selected', skipped)
            Nothing -> impossible
        Nothing -> do putStr $ "Cancelling "++jn++" since no patch was selected.\n"
                      exitWith $ ExitSuccess


foreign import ccall "compat.h get_raw_mode" get_raw_mode :: IO Int
foreign import ccall "compat.h set_raw_mode" set_raw_mode :: Int -> IO ()

without_buffering :: IO a -> IO a
without_buffering job = do
    bracket nobuf rebuf $ \_ -> job
    where nobuf = do is_term <- hIsTerminalDevice stdin
                     bi <- hGetBuffering stdin
                     raw <- get_raw_mode
                     when is_term $ do hSetBuffering stdin NoBuffering
                                       set_raw_mode 1
                     return (bi,raw)
          rebuf (bi,raw) = do is_term <- hIsTerminalDevice stdin
#if SYS == windows
                              buffers <- hGetBuffering stdin
                              hSetBuffering stdin NoBuffering `catch` \_ -> return ()
                              drop_returns
                              hSetBuffering stdin buffers `catch` \_ -> return ()
#else
                              drop_returns
#endif                              
                              when is_term $ do hSetBuffering stdin bi
                                                set_raw_mode raw
          drop_returns = do is_ready <- hReady stdin
                            when is_ready $
                              do c <- hLookAhead stdin `catch` \_ -> return ' '
                                 when (c == '\n') $
                                   do getChar
                                      drop_returns

wspfr :: String -> ((PatchInfo, Maybe Patch) -> Bool)
      -> [(PatchInfo, Maybe Patch)] -> [Patch]
      -> IO (Maybe (Patch, [Patch]))
wspfr _ _ [] _ = return Nothing
wspfr jn matches ((pinf, Just p):pps) skipped
    | not $ matches (pinf, Just p) = wspfr jn matches pps (p:skipped)
    | otherwise =
    case commute_by (skipped, p) of
    Nothing -> do putStr "\nSkipping depended-upon patch:"
                  print_p p
                  wspfr jn matches pps (p:skipped)
    Just (p', skipped') -> do
      print_p p
      putStr $ "Shall I "++jn++" this patch? [yNvq?] "
      hFlush stdout
      yorn <- get_non_ret_char
      putStr "\n"
      case fixanswer yorn of
        'y' -> return $ Just (p', skipped')
        'n' -> wspfr jn matches pps (p:skipped)
        'v' -> do printPatch p
                  wspfr jn matches ((pinf, Just p):pps) skipped
        'q' -> do putStr $ jn_cap++" cancelled.\n"
                  exitWith $ ExitSuccess
        _ -> do putStr $ wspfr_help jn
                wspfr jn matches ((pinf, Just p):pps) skipped
        where fixanswer ' ' = 'n'
              fixanswer '\n' = 'n'
              fixanswer c = c
              jn_cap = (toUpper $ head jn) : tail jn
              
wspfr jn _ ((pinf, Nothing):_) _ =
    fail $ "\nCan't " ++ jn ++ " patch\n" ++ human_friendly pinf ++
             "since I can't read it.\n\n" ++
             "The most likely reason is that you are using a 'partial' " ++
             "repository that doesn't contain this patch."

commute_by :: ([Patch], Patch) -> Maybe (Patch, [Patch])
commute_by ([], a) = Just (a, [])
commute_by (p:ps, a) =
    case commute (p, a) of
    Nothing -> Nothing
    Just (a', p') -> case commute_by (ps, a') of
                     Nothing -> Nothing
                     Just (a'', ps') -> Just (a'', p':ps')

wspfr_help :: String -> String
wspfr_help jn =
  "How to use "++jn++":\n"++
  "y: "++jn++" this patch\n"++
  "n: don't "++jn++" it\n"++
  "v: view this patch in full\n"++
  "q: cancel "++jn++"\n\n"++
  "h or ?: show this help\n"++
  "\n<Space>: accept the current default (which is capitalized)\n"
\end{code}

\begin{code}
with_any_selected_changes jobname opts _ islast isreversed fs ps job =
 if All `elem` opts || DryRun `elem` opts
 then if islast then job $ cleanboth (ps_to_consider, other_ps)
                else job $ cleanboth (other_ps, ps_to_consider)
 else
#ifdef HAVEWX
  if Gui `elem` opts
  then gui_select jobname islast opts ps job
  else
#endif
    do pc <- without_buffering $
             tentatively_text_select jobname islast isreversed
                                     opts (length ps_to_consider) 0
                                     [] ps_to_consider init_pc
       if islast
          then job $ cleanboth
                   (get_last_choice pc,
                    other_ps ++ get_first_choice pc++get_middle_choice pc)
          else job $ cleanboth
                   (get_middle_choice pc++get_last_choice pc ++ other_ps,
                    get_first_choice pc)
    where cleanup = if isreversed then reverse . (map invert) else \a->a
          ps' = cleanup ps
          consider_pc = deal_with_fs $ deselect_unwanted $ patch_choices ps'
          (ps_to_consider, other_ps)
              = if islast
                then (get_middle_choice consider_pc ++
                      get_last_choice consider_pc,
                      get_first_choice consider_pc)
                else (get_first_choice consider_pc ++
                      get_middle_choice consider_pc,
                      get_last_choice consider_pc)
          init_pc = patch_choices ps_to_consider
          deal_with_fs = if islast
                         then select_not_touching fs
                         else deselect_not_touching fs
          deselect_unwanted pc =
              if have_nonrange_match opts
              then if islast
                   then bug "don't support patch matching with islast in wasp"
                   else make_everything_later $
                        force_matching_first (match_a_patch opts) pc
              else pc
          cleanboth (a,b) = if isreversed then (cleanup b, cleanup a)
                                          else (cleanup a, cleanup b)

text_select :: String -> Bool -> Bool -> [DarcsFlag] -> Int -> Int
            -> [Patch] -> [Patch] -> PatchChoices -> IO PatchChoices

text_select _ _ _ _ _ _ _ [] pc = return pc
text_select jn islast isinverted opts n_max n ps_done ps_todo@(p:ps_todo') pc = do
    print_p viewp
    putStr $ "Shall I "++jn++" this patch? " ++
           "(" ++ show (n+1) ++ "/" ++ show n_max ++ ") " ++
           set_default the_default (if patch2patchinfo p == Nothing
                                    then "[ynwsfqdjk?] "
                                    else "[ynwvxqdjk?] ")
    hFlush stdout
    yorn <- get_non_ret_char
    putStr "\n"
    let do_next = tentatively_text_select jn islast isinverted opts n_max
                                          (n+1) (p:ps_done) ps_todo'
        repeat_this = text_select jn islast isinverted opts n_max n
                      ps_done ps_todo pc
    case fixanswer yorn of
      'y' -> do_next $ force_yes p pc
      'n' -> do_next $ force_no p pc
      's' -> do_next $ skip_file
      'f' -> do_next $ do_file
      'v' -> do printPatch viewp
                repeat_this
      'x' -> do putStr $ patch_summary viewp
                repeat_this
      'w' -> do_next $ make_uncertain p pc
      'k' -> case ps_done of
                 [] -> repeat_this
                 (p':ps_done') -> text_select jn islast isinverted opts n_max
                                  (n-1) ps_done' (p':ps_todo) pc
      'd' -> return pc
      'q' -> do putStr $ jn_cap++" cancelled.\n"
                exitWith $ ExitSuccess
      'j' -> case ps_todo' of
                 [] -> repeat_this
                 _ -> text_select jn islast isinverted opts n_max (n+1)
                                  (p:ps_done) ps_todo' pc
      _ -> do putStr $ text_select_help jn p
              repeat_this
      where force_yes = if islast then force_last else force_first
            force_no  = if islast then force_first else force_last
            patches_to_skip = (p:) $ filter (is_similar p) $ ps_todo'
            skip_file = foldr force_no pc patches_to_skip
            do_file = foldr force_yes pc patches_to_skip
            the_default = get_default islast $ is_patch_first p pc
            fixanswer a | a == ' ' = the_default
            fixanswer a = a
            jn_cap = (toUpper $ head jn) : tail jn
            viewp = if isinverted then invert p else p

print_p :: Patch -> IO ()
print_p p = case patch2patchinfo p of
            Nothing -> printPatch p
            Just pinf -> putStr $ "\n"++human_friendly pinf

tentatively_text_select :: String -> Bool -> Bool -> [DarcsFlag]
                        -> Int -> Int -> [Patch] -> [Patch] -> PatchChoices
                        -> IO PatchChoices
tentatively_text_select _ _ _ _ _ _ _ [] pc = return pc
tentatively_text_select jn islast isinverted opts n_max n ps_done
                        ps_todo@(p:ps_todo') pc
    | is_patch_first p pc /= Nothing
        = tentatively_text_select jn islast isinverted opts n_max (n+1)
          (p:ps_done) ps_todo' pc
    | otherwise = text_select jn islast isinverted opts n_max n ps_done ps_todo pc

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'

set_default :: Char -> String -> String
set_default d s = map set_upper s
  where set_upper c = if d == c then toUpper c else c

text_select_help :: String -> Patch -> String
text_select_help jn p =
  "How to use "++jn++"...\n"++
  "y: "++jn++" this patch\n"++
  "n: don't "++jn++" it\n"++
  "w: wait and decide later, defaulting to no\n\n"++
  (if patch2patchinfo p == Nothing
     then "s: don't "++jn++" the rest of the changes to this file\n"++
          "f: "++jn++" the rest of the changes to this file\n\n"
     else "v: view this patch in full\n"++
          "x: view a summary of this patch\n\n")
  ++"d: "++jn++" selected patches\n"++
  "q: cancel "++jn++"\n\n"++
  "j: skip to next patch\n"++
  "k: back up to previous patch\n"++
  "h or ?: show this help\n"++
  "\n<Space>: accept the current default (which is capitalized)\n"
\end{code}

\begin{code}
get_non_ret_char :: IO Char
get_non_ret_char = do c <- getChar
                      if c == '\n'
                         then get_non_ret_char
                         else return c

promptChar :: String -> String -> IO Char
promptChar p chs = do
    a <- without_buffering $ do putStr $ p ++ " ["++chs++"] "
                                hFlush stdout
                                get_non_ret_char
    putStr "\n"
    if a `elem` chs
       then return a
       else do putStr "Invalid response, try again!\n"
               promptChar p chs
\end{code}