module Darcs.UI.PatchHeader
    ( getLog
    , getAuthor
    , editLog
    , updatePatchHeader, AskAboutDeps(..)
    , PatchHeaderConfig
    , patchHeaderConfig
    , HijackT, HijackOptions(..)
    , runHijackT
    ) where

import Darcs.Prelude

import Darcs.Patch ( PrimOf, RepoPatch, summaryFL )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info
    ( PatchInfo
    , patchinfo
    , piAuthor
    , piDateString
    , piLog
    , piName
    )
import Darcs.Patch.Named
    ( Named
    , adddeps
    , getdeps
    , infopatch
    , patch2patchinfo
    , patchcontents
    , setinfo
    )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia )
import Darcs.Patch.Prim ( canonizeFL )

import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), (+>+) )

import Darcs.Util.Lock ( readTextFile, writeTextFile )

import Darcs.UI.External ( editFile )
import Darcs.UI.Flags ( getEasyAuthor, promptAuthor, getDate )
import Darcs.UI.Options ( Config, (?) )
import qualified Darcs.UI.Options.All as O
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.UI.SelectChanges ( askAboutDepends )

import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
import Darcs.Util.English ( capitalize )
import Darcs.Util.Global ( darcsLastMessage )
import Darcs.Util.Path ( FilePathLike, toFilePath )
import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar, promptYorn )
import Darcs.Util.Printer ( Doc, text, ($+$), vcat, prefixLines, renderString )
import qualified Darcs.Util.Ratified as Ratified ( hGetContents )

import Darcs.Util.Tree ( Tree )

import Control.Exception ( catch, IOException )
import Control.Monad ( when, void )
import Control.Monad.Trans              ( liftIO )
import Control.Monad.Trans.State.Strict ( StateT(..), evalStateT, get, put  )
import Data.List ( isPrefixOf, stripPrefix )
import Data.Maybe ( fromMaybe, isJust )
import System.Exit ( exitSuccess )
import System.IO ( stdin )

data PName = FlagPatchName String | PriorPatchName String | NoPatchName

-- | Options for how to deal with the situation where we are somehow
--   modifying a patch that is not our own
data HijackOptions = IgnoreHijack                  -- ^ accept all hijack requests
                   | RequestHijackPermission       -- ^ prompt once, accepting subsequent hijacks if yes
                   | AlwaysRequestHijackPermission -- ^ always prompt

-- | Transformer for interactions with a hijack warning state that we
--   need to thread through
type HijackT = StateT HijackOptions

-- | Get the patch name and long description from one of
--
--  * the configuration (flags, defaults, hard-coded)
--
--  * an existing log file
--
--  * stdin (e.g. a pipe)
--
--  * a text editor
--
-- It ensures the patch name is not empty nor starts with the prefix TAG.
--
-- The last result component is a possible path to a temporary file that should be removed later.
getLog :: Maybe String                          -- ^ patchname option
       -> Bool                                  -- ^ pipe option
       -> O.Logfile                             -- ^ logfile option
       -> Maybe O.AskLongComment                -- ^ askLongComment option
       -> Maybe (String, [String])              -- ^ possibly an existing patch name and long description
       -> Doc                                   -- ^ summary of changes to record
       -> IO (String, [String], Maybe String)   -- ^ patch name, long description and possibly the path
                                                --   to the temporary file that should be removed later
getLog :: Maybe String
-> Bool
-> Logfile
-> Maybe AskLongComment
-> Maybe (String, [String])
-> Doc
-> IO (String, [String], Maybe String)
getLog Maybe String
m_name Bool
has_pipe Logfile
log_file Maybe AskLongComment
ask_long Maybe (String, [String])
m_old Doc
chs =
  (String, [String], Maybe String)
-> (String, [String], Maybe String)
forall {b} {c}. (String, b, c) -> (String, b, c)
restoreTagPrefix ((String, [String], Maybe String)
 -> (String, [String], Maybe String))
-> IO (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Logfile
-> Maybe AskLongComment
-> IO (String, [String], Maybe String)
go Bool
has_pipe Logfile
log_file Maybe AskLongComment
ask_long
 where
  go :: Bool
-> Logfile
-> Maybe AskLongComment
-> IO (String, [String], Maybe String)
go Bool
True Logfile
_ Maybe AskLongComment
_ = do
      p <- case PName
patchname_specified of
             FlagPatchName String
p  -> String -> IO ()
check_badname String
p IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
             PriorPatchName String
p -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
             PName
NoPatchName      -> Bool -> IO String
prompt_patchname Bool
False
      putStrLn "What is the log?"
      thelog <- lines `fmap` Ratified.hGetContents stdin
      return (p, thelog, Nothing)
  go Bool
_ (O.Logfile { _logfile :: Logfile -> Maybe AbsolutePath
O._logfile = Just AbsolutePath
f }) Maybe AskLongComment
_ = do
      mlp <- AbsolutePath -> IO [String]
forall p. FilePathLike p => p -> IO [String]
readTextFile AbsolutePath
f IO [String] -> (IOException -> IO [String]) -> IO [String]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      firstname <- case (patchname_specified, mlp) of
                     (FlagPatchName  String
p, []) -> String -> IO ()
check_badname String
p IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
                     (PName
_, String
p:[String]
_)               -> if String -> Bool
is_badname String
p
                                                 then Bool -> IO String
prompt_patchname Bool
True
                                                 else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p -- logfile trumps prior!
                     (PriorPatchName String
p, []) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
                     (PName
NoPatchName, [])      -> Bool -> IO String
prompt_patchname Bool
True
      append_info f firstname
      when (ask_long == Just O.YesEditLongComment) (void $ editFile f)
      (name, thelog) <- read_long_comment f firstname
      return (name, thelog, if O._rmlogfile log_file then Just $ toFilePath f else Nothing)
  go Bool
_ Logfile
_ (Just AskLongComment
O.YesEditLongComment) =
      case PName
patchname_specified of
          FlagPatchName  String
p  -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
p
          PriorPatchName String
p  -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
p
          PName
NoPatchName       -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
""
  go Bool
_ Logfile
_ (Just AskLongComment
O.NoEditLongComment) =
      case PName
patchname_specified of
          FlagPatchName  String
p  -> String -> IO ()
check_badname String
p IO ()
-> IO (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing) -- record (or amend) -m
          PriorPatchName String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing) -- amend
          PName
NoPatchName       -> do p <- Bool -> IO String
prompt_patchname Bool
True -- record
                                  return (p, [], Nothing)
  go Bool
_ Logfile
_ (Just AskLongComment
O.PromptLongComment) =
      case PName
patchname_specified of
          FlagPatchName String
p   -> String -> IO ()
check_badname String
p IO ()
-> IO (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p -- record (or amend) -m
          PriorPatchName String
p  -> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p
          PName
NoPatchName       -> Bool -> IO String
prompt_patchname Bool
True IO String
-> (String -> IO (String, [String], Maybe String))
-> IO (String, [String], Maybe String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (String, [String], Maybe String)
prompt_long_comment
  go Bool
_ Logfile
_ Maybe AskLongComment
Nothing =
      case PName
patchname_specified of
          FlagPatchName  String
p  -> String -> IO ()
check_badname String
p IO ()
-> IO (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing)  -- record (or amend) -m
          PriorPatchName String
"" -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
""
          PriorPatchName String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing)
          PName
NoPatchName       -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
""

  tagPrefix :: String
tagPrefix = String
"TAG "

  hasTagPrefix :: String -> Bool
hasTagPrefix String
name = String
tagPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name

  restoreTagPrefix :: (String, b, c) -> (String, b, c)
restoreTagPrefix (String
name, b
log, c
file)
    | Just (String
old_name, [String]
_) <- Maybe (String, [String])
m_old
    , String -> Bool
hasTagPrefix String
old_name = (String
tagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name, b
log, c
file)
  restoreTagPrefix (String, b, c)
args = (String, b, c)
args

  stripTagPrefix :: String -> String
stripTagPrefix String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
name (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
tagPrefix String
name

  patchname_specified :: PName
patchname_specified =
    case (Maybe String
m_name, Maybe (String, [String])
m_old) of
      (Just String
name, Maybe (String, [String])
_)              -> String -> PName
FlagPatchName String
name
      (Maybe String
Nothing,   Just (String
name, [String]
_)) -> String -> PName
PriorPatchName (String -> String
stripTagPrefix String
name)
      (Maybe String
Nothing,   Maybe (String, [String])
Nothing)        -> PName
NoPatchName

  default_log :: [String]
default_log = case Maybe (String, [String])
m_old of
                  Maybe (String, [String])
Nothing    -> []
                  Just (String
_,[String]
l) -> [String]
l

  check_badname :: String -> IO ()
check_badname = IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Maybe String -> IO ())
-> (String -> Maybe String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
just_a_badname

  prompt_patchname :: Bool -> IO String
prompt_patchname Bool
retry = do
      n <- String -> IO String
askUser String
"What is the patch name? "
      maybe (return n) prompt_again $ just_a_badname n
    where
      prompt_again :: String -> IO String
prompt_again String
msg = do
        String -> IO ()
putStrLn String
msg
        if Bool
retry then Bool -> IO String
prompt_patchname Bool
retry else String -> IO String
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Bad patch name!"

  just_a_badname :: String -> Maybe String
just_a_badname String
n =
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n then
      String -> Maybe String
forall a. a -> Maybe a
Just String
"Error: The patch name must not be empty!"
    else if String -> Bool
hasTagPrefix String
n then
      String -> Maybe String
forall a. a -> Maybe a
Just String
"Error: The patch name must not start with \"TAG \"!"
    else
      Maybe String
forall a. Maybe a
Nothing

  is_badname :: String -> Bool
is_badname = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
just_a_badname

  prompt_long_comment :: String -> IO (String, [String], Maybe String)
prompt_long_comment String
oldname =
    do let verb :: String
verb = case Maybe (String, [String])
m_old of Maybe (String, [String])
Nothing -> String
"add a"; Just (String, [String])
_ -> String
"edit the"
       y <- String -> IO Bool
promptYorn (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"Do you want to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
verbString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" long comment?"
       if y then get_log_using_editor oldname
            else return (oldname, default_log, Nothing)

  get_log_using_editor :: String -> IO (String, [String], Maybe String)
get_log_using_editor String
p =
                       do let logf :: String
logf = String
darcsLastMessage
                          String -> String -> IO ()
forall {p}. FilePathLike p => p -> String -> IO ()
writeTextFile String
logf (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
p String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
default_log
                          String -> String -> IO ()
forall {p}. FilePathLike p => p -> String -> IO ()
append_info String
logf String
p
                          _ <- String -> IO (ExitCode, Bool)
forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile String
logf
                          (name,long) <- read_long_comment logf p
                          check_badname name
                          return (name,long,Just logf)

  read_long_comment :: FilePathLike p => p -> String -> IO (String, [String])
  read_long_comment :: forall p. FilePathLike p => p -> String -> IO (String, [String])
read_long_comment p
f String
oldname =
      do t <- p -> IO [String]
forall p. FilePathLike p => p -> IO [String]
readTextFile p
f
         let filter_out_info = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String
"#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
         case reverse $ dropWhile null $ reverse $ filter_out_info t of
            []     -> (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
oldname, [])
            (String
n:[String]
ls) -> do
                String -> IO ()
check_badname String
n
                (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, [String]
ls)

  append_info :: p -> String -> IO ()
append_info p
f String
oldname = do
    fc <- p -> IO [String]
forall p. FilePathLike p => p -> IO [String]
readTextFile p
f
    writeTextFile f $ renderString
      $ vcat (map text $ if null fc then [oldname] else fc)
      $+$ vcat
        [ text "# Please enter the patch name in the first line, and"
        , text "# optionally, a long description in the following lines."
        , text "#"
        , text "# Lines starting with '#' will be ignored."
        , text "#"
        , text "#"
        , text "# Summary of selected changes:"
        , text "#"
        , prefixLines (text "#") chs
        ]

editLog :: Named prim wX wY -> IO (Named prim wX wY)
editLog :: forall (prim :: * -> * -> *) wX wY.
Named prim wX wY -> IO (Named prim wX wY)
editLog Named prim wX wY
p = do
  let pi :: PatchInfo
pi = Named prim wX wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wX wY
p
  (name, log, _) <-
    Maybe String
-> Bool
-> Logfile
-> Maybe AskLongComment
-> Maybe (String, [String])
-> Doc
-> IO (String, [String], Maybe String)
getLog Maybe String
forall a. Maybe a
Nothing Bool
False (Maybe AbsolutePath -> Bool -> Logfile
O.Logfile Maybe AbsolutePath
forall a. Maybe a
Nothing Bool
False)
      (AskLongComment -> Maybe AskLongComment
forall a. a -> Maybe a
Just AskLongComment
O.YesEditLongComment) ((String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (PatchInfo -> String
piName PatchInfo
pi, PatchInfo -> [String]
piLog PatchInfo
pi)) Doc
forall a. Monoid a => a
mempty
  pi' <- patchinfo (piDateString pi) name (piAuthor pi) log
  return $ setinfo pi' p

-- | Specify whether to ask about dependencies with respect to a particular
-- 'PatchSet', or not
data AskAboutDeps p wX where
  AskAboutDeps :: (RL (PatchInfoAnd p) w wX) -> AskAboutDeps p wX
  NoAskAboutDeps :: AskAboutDeps p wX

-- | Run a job that involves a hijack confirmation prompt.
--
--   See 'RequestHijackPermission' for initial values
runHijackT :: Monad m => HijackOptions -> HijackT m a -> m a
runHijackT :: forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT = (HijackT m a -> HijackOptions -> m a)
-> HijackOptions -> HijackT m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HijackT m a -> HijackOptions -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT

data PatchHeaderConfig = PatchHeaderConfig
  { PatchHeaderConfig -> DiffAlgorithm
diffAlgorithm :: D.DiffAlgorithm
  , PatchHeaderConfig -> Bool
keepDate :: Bool
  , PatchHeaderConfig -> Bool
selectAuthor :: Bool
  , PatchHeaderConfig -> Maybe String
author :: Maybe String
  , PatchHeaderConfig -> Maybe String
patchname :: Maybe String
  , PatchHeaderConfig -> Maybe AskLongComment
askLongComment :: Maybe O.AskLongComment
  }

patchHeaderConfig :: Config -> PatchHeaderConfig
patchHeaderConfig :: Config -> PatchHeaderConfig
patchHeaderConfig Config
cfg = PatchHeaderConfig
  { diffAlgorithm :: DiffAlgorithm
diffAlgorithm   = PrimOptSpec DarcsOptDescr Flag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm PrimDarcsOption DiffAlgorithm -> Config -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  , keepDate :: Bool
keepDate        = PrimOptSpec DarcsOptDescr Flag a Bool
PrimDarcsOption Bool
O.keepDate PrimDarcsOption Bool -> Config -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  , selectAuthor :: Bool
selectAuthor    = PrimOptSpec DarcsOptDescr Flag a Bool
PrimDarcsOption Bool
O.selectAuthor PrimDarcsOption Bool -> Config -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  , author :: Maybe String
author          = PrimOptSpec DarcsOptDescr Flag a (Maybe String)
PrimDarcsOption (Maybe String)
O.author PrimDarcsOption (Maybe String) -> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  , patchname :: Maybe String
patchname       = PrimOptSpec DarcsOptDescr Flag a (Maybe String)
PrimDarcsOption (Maybe String)
O.patchname PrimDarcsOption (Maybe String) -> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  , askLongComment :: Maybe AskLongComment
askLongComment  = PrimOptSpec DarcsOptDescr Flag a (Maybe AskLongComment)
PrimDarcsOption (Maybe AskLongComment)
O.askLongComment PrimDarcsOption (Maybe AskLongComment)
-> Config -> Maybe AskLongComment
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
cfg
  }

-- | Update the metadata for a patch.
--   This potentially involves a bit of interactivity, so we may return @Nothing@
--   if there is cause to abort what we're doing along the way
updatePatchHeader :: forall p wX wY wZ . (RepoPatch p, ApplyState p ~ Tree)
                  => String -- ^ verb: command name
                  -> AskAboutDeps p wX
                  -> S.PatchSelectionOptions
                  -> PatchHeaderConfig
                  -> Named (PrimOf p) wX wY
                  -- ^ patch to edit, must be conflict-free as conflicts can't
                  -- be preserved when changing the identity of a patch. If
                  -- necessary this can be achieved by calling @fmapFL_Named
                  -- effect@ on an @Named p@ first, but some callers might
                  -- already have @Named (PrimOf p)@ available.
                  -> FL (PrimOf p) wY wZ -- ^new primitives to add
                  -> HijackT IO (Maybe String, PatchInfoAnd p wX wZ)
updatePatchHeader :: forall (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> AskAboutDeps p wX
-> PatchSelectionOptions
-> PatchHeaderConfig
-> Named (PrimOf p) wX wY
-> FL (PrimOf p) wY wZ
-> HijackT IO (Maybe String, PatchInfoAnd p wX wZ)
updatePatchHeader String
verb AskAboutDeps p wX
ask_deps PatchSelectionOptions
pSelOpts PatchHeaderConfig{Bool
Maybe String
Maybe AskLongComment
DiffAlgorithm
diffAlgorithm :: PatchHeaderConfig -> DiffAlgorithm
keepDate :: PatchHeaderConfig -> Bool
selectAuthor :: PatchHeaderConfig -> Bool
author :: PatchHeaderConfig -> Maybe String
patchname :: PatchHeaderConfig -> Maybe String
askLongComment :: PatchHeaderConfig -> Maybe AskLongComment
diffAlgorithm :: DiffAlgorithm
keepDate :: Bool
selectAuthor :: Bool
author :: Maybe String
patchname :: Maybe String
askLongComment :: Maybe AskLongComment
..} Named (PrimOf p) wX wY
oldp FL (PrimOf p) wY wZ
chs = do

    let newchs :: FL (PrimOf p) wX wZ
newchs = DiffAlgorithm -> FL (PrimOf p) wX wZ -> FL (PrimOf p) wX wZ
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
diffAlgorithm (Named (PrimOf p) wX wY -> FL (PrimOf p) wX wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named (PrimOf p) wX wY
oldp FL (PrimOf p) wX wY -> FL (PrimOf p) wY wZ -> FL (PrimOf p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wY wZ
chs)

    let old_pdeps :: [PatchInfo]
old_pdeps = Named (PrimOf p) wX wY -> [PatchInfo]
forall wX wY. Named (PrimOf p) wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named (PrimOf p) wX wY
oldp
    newdeps <-
        case AskAboutDeps p wX
ask_deps of
           AskAboutDeps RL (PatchInfoAnd p) w wX
patches ->
              IO [PatchInfo] -> StateT HijackOptions IO [PatchInfo]
forall a. IO a -> StateT HijackOptions IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PatchInfo] -> StateT HijackOptions IO [PatchInfo])
-> IO [PatchInfo] -> StateT HijackOptions IO [PatchInfo]
forall a b. (a -> b) -> a -> b
$ RL (PatchInfoAnd p) w wX
-> FL (PrimOf p) wX wZ
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
forall (p :: * -> * -> *) wX wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
RL (PatchInfoAnd p) wX wR
-> FL (PrimOf p) wR wT
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
askAboutDepends RL (PatchInfoAnd p) w wX
patches FL (PrimOf p) wX wZ
newchs PatchSelectionOptions
pSelOpts [PatchInfo]
old_pdeps
           AskAboutDeps p wX
NoAskAboutDeps -> [PatchInfo] -> StateT HijackOptions IO [PatchInfo]
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
old_pdeps

    let old_pinf = Named (PrimOf p) wX wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named (PrimOf p) wX wY
oldp
        prior    = (PatchInfo -> String
piName PatchInfo
old_pinf, PatchInfo -> [String]
piLog PatchInfo
old_pinf)
    date <- if keepDate then return (piDateString old_pinf) else liftIO $ getDate False
    new_author <- getAuthor verb selectAuthor author old_pinf
    liftIO $ do
        (new_name, new_log, mlogf) <- getLog
            patchname False (O.Logfile Nothing False) askLongComment (Just prior) (summaryFL chs)
        new_pinf <- patchinfo date new_name new_author new_log
        let newp = Named p wX wZ -> PatchInfoAnd p wX wZ
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia (Named p wX wZ -> [PatchInfo] -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps (PatchInfo -> FL (PrimOf p) wX wZ -> Named p wX wZ
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
new_pinf FL (PrimOf p) wX wZ
newchs) [PatchInfo]
newdeps)
        return (mlogf, newp)


-- | @getAuthor@ tries to return the updated author for the patch.
--   There are two different scenarios:
--
--   * [explicit] Either we want to override the patch author, be it by
--     prompting the user (@select@) or having them pass it in from
--     the UI (@new_author@), or
--
--   * [implicit] We want to keep the original author, in which case we
--     also double-check that we are not inadvertently \"hijacking\"
--     somebody else's patch (if the patch author is not the same as the
--     repository author, we give them a chance to abort the whole
--     operation)
getAuthor :: String          -- ^ verb:   command name
          -> Bool            -- ^ select: prompt for new auhor
          -> Maybe String    -- ^ new author: explict new author
          -> PatchInfo       -- ^ patch to update
          -> HijackT IO String
getAuthor :: String
-> Bool
-> Maybe String
-> PatchInfo
-> StateT HijackOptions IO String
getAuthor String
_ Bool
True  Maybe String
_ PatchInfo
_  = do
    auth <- IO String -> StateT HijackOptions IO String
forall a. IO a -> StateT HijackOptions IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> StateT HijackOptions IO String)
-> IO String -> StateT HijackOptions IO String
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> IO String
promptAuthor Bool
False Bool
True
    return auth
getAuthor String
_    Bool
False (Just String
new) PatchInfo
_   =
    String -> StateT HijackOptions IO String
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
new
getAuthor String
verb Bool
False Maybe String
Nothing PatchInfo
pinfo = do
    whitelist <- IO [String] -> StateT HijackOptions IO [String]
forall a. IO a -> StateT HijackOptions IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> StateT HijackOptions IO [String])
-> IO [String] -> StateT HijackOptions IO [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
getEasyAuthor
    hj <- get
    if orig `elem` whitelist || canIgnore hj
        then allowHijack
        else do
            hijackResp <- liftIO $ askAboutHijack hj
            case hijackResp of
                Char
'y' -> StateT HijackOptions IO String
allowHijack
                Char
'a' -> HijackOptions -> StateT HijackOptions IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HijackOptions
IgnoreHijack StateT HijackOptions IO ()
-> StateT HijackOptions IO String -> StateT HijackOptions IO String
forall a b.
StateT HijackOptions IO a
-> StateT HijackOptions IO b -> StateT HijackOptions IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT HijackOptions IO String
allowHijack
                Char
_   -> IO String -> StateT HijackOptions IO String
forall a. IO a -> StateT HijackOptions IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
forall a. IO a
exitSuccess
  where
    askAboutHijack :: HijackOptions -> IO Char
askAboutHijack HijackOptions
hj = PromptConfig -> IO Char
promptChar (String -> String -> String -> Maybe Char -> String -> PromptConfig
PromptConfig String
msg String
opts [] Maybe Char
forall a. Maybe a
Nothing [])
       where
         msg :: String
msg  = String
"You're not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
orig String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
capitalize String
verb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" anyway? "
         opts :: String
opts = case HijackOptions
hj of
             HijackOptions
AlwaysRequestHijackPermission -> String
"yn"
             HijackOptions
_ -> String
"yna"
    canIgnore :: HijackOptions -> Bool
canIgnore HijackOptions
IgnoreHijack                  = Bool
True
    canIgnore HijackOptions
RequestHijackPermission       = Bool
False
    canIgnore HijackOptions
AlwaysRequestHijackPermission = Bool
False
    allowHijack :: StateT HijackOptions IO String
allowHijack = String -> StateT HijackOptions IO String
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
orig
    orig :: String
orig = PatchInfo -> String
piAuthor PatchInfo
pinfo