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

import Prelude ()
import Darcs.Prelude

import Darcs.Patch
    ( IsRepoType, RepoPatch, PrimPatch, PrimOf, fromPrims
    , effect
    , summaryFL
    )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info ( PatchInfo,
                          piAuthor, piName, piLog, piDateString,
                          patchinfo, isInverted, invertName,
                        )
import Darcs.Patch.Named.Wrapped ( infopatch, getdeps, adddeps )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully, info )
import Darcs.Patch.Prim ( canonizeFL )

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

import Darcs.Repository ( Repository )
import Darcs.Util.Lock
    ( readTextFile
    , writeTextFile
    )

import Darcs.UI.External ( editFile )
import Darcs.UI.Flags ( getEasyAuthor, promptAuthor, getDate )
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 ( 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 )
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 :: forall prim wX wY . PrimPatch prim
       => 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
       -> FL prim wX wY                         -- ^ 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])
-> FL prim wX wY
-> IO (String, [String], Maybe String)
getLog m_name :: Maybe String
m_name has_pipe :: Bool
has_pipe log_file :: Logfile
log_file ask_long :: Maybe AskLongComment
ask_long m_old :: Maybe (String, [String])
m_old chs :: FL prim wX wY
chs = 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 True _ _ = do
      String
p <- case PName
patchname_specified of
             FlagPatchName p :: String
p  -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
             PriorPatchName p :: String
p -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
             NoPatchName      -> Bool -> IO String
prompt_patchname Bool
False
      String -> IO ()
putStrLn "What is the log?"
      [String]
thelog <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle -> IO String
Ratified.hGetContents Handle
stdin
      (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
thelog, Maybe String
forall a. Maybe a
Nothing)
  go _ (O.Logfile { _logfile :: Logfile -> Maybe AbsolutePath
O._logfile = Just f :: AbsolutePath
f }) _ = do
      [String]
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 (m :: * -> *) a. Monad m => a -> m a
return [])
      String
firstname <- case (PName
patchname_specified, [String]
mlp) of
                     (FlagPatchName  p :: String
p, []) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
                     (_, p :: String
p:_)               -> if String -> Bool
badName String
p
                                                 then Bool -> IO String
prompt_patchname Bool
True
                                                 else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p -- logfile trumps prior!
                     (PriorPatchName p :: String
p, []) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
                     (NoPatchName, [])      -> Bool -> IO String
prompt_patchname Bool
True
      AbsolutePath -> String -> IO ()
forall p. FilePathLike p => p -> String -> IO ()
append_info AbsolutePath
f String
firstname
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AskLongComment
ask_long Maybe AskLongComment -> Maybe AskLongComment -> Bool
forall a. Eq a => a -> a -> Bool
== AskLongComment -> Maybe AskLongComment
forall a. a -> Maybe a
Just AskLongComment
O.YesEditLongComment) (IO (ExitCode, Bool) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ExitCode, Bool) -> IO ()) -> IO (ExitCode, Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> IO (ExitCode, Bool)
forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile AbsolutePath
f)
      (name :: String
name, thelog :: [String]
thelog) <- AbsolutePath -> String -> IO (String, [String])
forall p. FilePathLike p => p -> String -> IO (String, [String])
read_long_comment AbsolutePath
f String
firstname
      (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [String]
thelog, if Logfile -> Bool
O._rmlogfile Logfile
log_file then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
f else Maybe String
forall a. Maybe a
Nothing)
  go _ _ (Just O.YesEditLongComment) =
      case PName
patchname_specified of
          FlagPatchName  p :: String
p  -> String -> IO (String, [String], Maybe String)
actually_get_log String
p
          PriorPatchName p :: String
p  -> String -> IO (String, [String], Maybe String)
actually_get_log String
p
          NoPatchName       -> String -> IO (String, [String], Maybe String)
actually_get_log ""
  go _ _ (Just O.NoEditLongComment) =
      case PName
patchname_specified of
          FlagPatchName  p :: String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
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 p :: String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing) -- amend
          NoPatchName       -> do String
p <- Bool -> IO String
prompt_patchname Bool
True -- record
                                  (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [], Maybe String
forall a. Maybe a
Nothing)
  go _ _ (Just O.PromptLongComment) =
      case PName
patchname_specified of
          FlagPatchName p :: String
p   -> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p -- record (or amend) -m
          PriorPatchName p :: String
p  -> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p
          NoPatchName       -> Bool -> IO String
prompt_patchname Bool
True IO String
-> (String -> IO (String, [String], Maybe String))
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (String, [String], Maybe String)
prompt_long_comment
  go _ _ Nothing =
      case PName
patchname_specified of
          FlagPatchName  p :: String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
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 -> IO (String, [String], Maybe String)
actually_get_log ""
          PriorPatchName p :: String
p  -> (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, Maybe String
forall a. Maybe a
Nothing)
          NoPatchName       -> String -> IO (String, [String], Maybe String)
actually_get_log ""

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

  badName :: String -> Bool
badName "" = Bool
True
  badName n :: String
n  = "TAG" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
n

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

  prompt_patchname :: Bool -> IO String
prompt_patchname retry :: Bool
retry =
    do String
n <- String -> IO String
askUser "What is the patch name? "
       if String -> Bool
badName String
n
          then if Bool
retry then Bool -> IO String
prompt_patchname Bool
retry
                        else String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bad patch name!"
          else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n

  prompt_long_comment :: String -> IO (String, [String], Maybe String)
prompt_long_comment oldname :: String
oldname =
    do Bool
y <- String -> IO Bool
promptYorn "Do you want to add a long comment?"
       if Bool
y then String -> IO (String, [String], Maybe String)
actually_get_log String
oldname
            else (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
oldname, [], Maybe String
forall a. Maybe a
Nothing)

  actually_get_log :: String -> IO (String, [String], Maybe String)
actually_get_log p :: String
p = do let logf :: String
logf = String
darcsLastMessage
                          -- TODO: make sure encoding used for logf is the same everywhere
                          -- probably should be locale because the editor will assume it
                          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
                          (ExitCode, Bool)
_ <- String -> IO (ExitCode, Bool)
forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile String
logf
                          (name :: String
name,long :: [String]
long) <- String -> String -> IO (String, [String])
forall p. FilePathLike p => p -> String -> IO (String, [String])
read_long_comment String
logf String
p
                          if String -> Bool
badName String
name
                            then do String -> IO ()
putStrLn "WARNING: empty or incorrect patch name!"
                                    String
pn <- Bool -> IO String
prompt_patchname Bool
True
                                    (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
pn, [String]
long, Maybe String
forall a. Maybe a
Nothing)
                            else (String, [String], Maybe String)
-> IO (String, [String], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name,[String]
long,String -> Maybe String
forall a. a -> Maybe a
Just String
logf)

  read_long_comment :: FilePathLike p => p -> String -> IO (String, [String])
  read_long_comment :: p -> String -> IO (String, [String])
read_long_comment f :: p
f oldname :: String
oldname =
      do [String]
t <- p -> IO [String]
forall p. FilePathLike p => p -> IO [String]
readTextFile p
f
         let filter_out_info :: [String] -> [String]
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 -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
         case [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
filter_out_info [String]
t of
            []     -> (String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
oldname, [])
            (n :: String
n:ls :: [String]
ls) -> (String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, [String]
ls)

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

-- |specify whether to ask about dependencies with respect to a particular repository, or not
data AskAboutDeps rt p wR wU wT = AskAboutDeps (Repository rt p wR wU wT) | NoAskAboutDeps

-- | Run a job that involves a hijack confirmation prompt.
--
--   See 'RequestHijackPermission' for initial values
runHijackT :: Monad m => HijackOptions -> HijackT m a -> m a
runHijackT :: 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

-- | 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 rt p wX wY wR wU wT . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                  => String -- ^ verb: command name
                  -> AskAboutDeps rt p wR wU wT
                  -> S.PatchSelectionOptions
                  -> D.DiffAlgorithm
                  -> Bool -- keepDate
                  -> Bool -- selectAuthor
                  -> Maybe String -- author
                  -> Maybe String -- patchname
                  -> Maybe O.AskLongComment
                  -> PatchInfoAnd rt p wT wX
                  -> FL (PrimOf p) wX wY
                  -> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
updatePatchHeader :: String
-> AskAboutDeps rt p wR wU wT
-> PatchSelectionOptions
-> DiffAlgorithm
-> Bool
-> Bool
-> Maybe String
-> Maybe String
-> Maybe AskLongComment
-> PatchInfoAnd rt p wT wX
-> FL (PrimOf p) wX wY
-> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
updatePatchHeader verb :: String
verb ask_deps :: AskAboutDeps rt p wR wU wT
ask_deps pSelOpts :: PatchSelectionOptions
pSelOpts da :: DiffAlgorithm
da nKeepDate :: Bool
nKeepDate nSelectAuthor :: Bool
nSelectAuthor nAuthor :: Maybe String
nAuthor nPatchname :: Maybe String
nPatchname nAskLongComment :: Maybe AskLongComment
nAskLongComment oldp :: PatchInfoAnd rt p wT wX
oldp chs :: FL (PrimOf p) wX wY
chs = do

    let newchs :: FL (PrimOf p) wT wY
newchs = DiffAlgorithm -> FL (PrimOf p) wT wY -> FL (PrimOf p) wT wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (PatchInfoAnd rt p wT wX -> FL (PrimOf (PatchInfoAnd rt p)) wT wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wT wX
oldp FL (PrimOf p) wT wX -> FL (PrimOf p) wX wY -> FL (PrimOf p) wT wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wX wY
chs)

    let old_pdeps :: [PatchInfo]
old_pdeps = WrappedNamed rt p wT wX -> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> [PatchInfo]
getdeps (WrappedNamed rt p wT wX -> [PatchInfo])
-> WrappedNamed rt p wT wX -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wT wX -> WrappedNamed rt p wT wX
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully PatchInfoAnd rt p wT wX
oldp
    [PatchInfo]
newdeps <-
        case AskAboutDeps rt p wR wU wT
ask_deps of
           AskAboutDeps repository :: Repository rt p wR wU wT
repository -> IO [PatchInfo] -> StateT HijackOptions IO [PatchInfo]
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
$ Repository rt p wR wU wT
-> FL (PrimOf p) wT wY
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> FL (PrimOf p) wT wY
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
askAboutDepends Repository rt p wR wU wT
repository FL (PrimOf p) wT wY
newchs PatchSelectionOptions
pSelOpts [PatchInfo]
old_pdeps
           NoAskAboutDeps -> [PatchInfo] -> StateT HijackOptions IO [PatchInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
old_pdeps

    let old_pinf :: PatchInfo
old_pinf = PatchInfoAnd rt p wT wX -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wT wX
oldp
        prior :: (String, [String])
prior    = (PatchInfo -> String
piName PatchInfo
old_pinf, PatchInfo -> [String]
piLog PatchInfo
old_pinf)
    String
date <- if Bool
nKeepDate then String -> StateT HijackOptions IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> String
piDateString PatchInfo
old_pinf) else IO String -> StateT HijackOptions IO String
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 -> IO String
getDate Bool
False
    String
new_author <- String
-> Bool
-> Maybe String
-> PatchInfo
-> StateT HijackOptions IO String
getAuthor String
verb Bool
nSelectAuthor Maybe String
nAuthor PatchInfo
old_pinf
    IO (Maybe String, PatchInfoAnd rt p wT wY)
-> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String, PatchInfoAnd rt p wT wY)
 -> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY))
-> IO (Maybe String, PatchInfoAnd rt p wT wY)
-> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
forall a b. (a -> b) -> a -> b
$ do
        (new_name :: String
new_name, new_log :: [String]
new_log, mlogf :: Maybe String
mlogf) <- Maybe String
-> Bool
-> Logfile
-> Maybe AskLongComment
-> Maybe (String, [String])
-> FL (PrimOf p) wX wY
-> IO (String, [String], Maybe String)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
Maybe String
-> Bool
-> Logfile
-> Maybe AskLongComment
-> Maybe (String, [String])
-> FL prim wX wY
-> IO (String, [String], Maybe String)
getLog
            Maybe String
nPatchname Bool
False (Maybe AbsolutePath -> Bool -> Logfile
O.Logfile Maybe AbsolutePath
forall a. Maybe a
Nothing Bool
False) Maybe AskLongComment
nAskLongComment ((String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String, [String])
prior) FL (PrimOf p) wX wY
chs
        let maybe_invert :: PatchInfo -> PatchInfo
maybe_invert = if PatchInfo -> Bool
isInverted PatchInfo
old_pinf then PatchInfo -> PatchInfo
invertName else PatchInfo -> PatchInfo
forall a. a -> a
id
        PatchInfo
new_pinf <- PatchInfo -> PatchInfo
maybe_invert (PatchInfo -> PatchInfo) -> IO PatchInfo -> IO PatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
new_name String
new_author [String]
new_log
        let newp :: PatchInfoAnd rt p wT wY
newp = WrappedNamed rt p wT wY -> PatchInfoAnd rt p wT wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> PatchInfoAnd rt p wX wY
n2pia (WrappedNamed rt p wT wY -> [PatchInfo] -> WrappedNamed rt p wT wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> [PatchInfo] -> WrappedNamed rt p wX wY
adddeps (PatchInfo -> FL p wT wY -> WrappedNamed rt p wT wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
PatchInfo -> FL p wX wY -> WrappedNamed rt p wX wY
infopatch PatchInfo
new_pinf (FL (PrimOf (FL p)) wT wY -> FL p wT wY
forall (p :: * -> * -> *) wX wY.
FromPrims p =>
FL (PrimOf p) wX wY -> p wX wY
fromPrims FL (PrimOf p) wT wY
FL (PrimOf (FL p)) wT wY
newchs)) [PatchInfo]
newdeps)
        (Maybe String, PatchInfoAnd rt p wT wY)
-> IO (Maybe String, PatchInfoAnd rt p wT wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
mlogf, PatchInfoAnd rt p wT wY
forall (rt :: RepoType). PatchInfoAnd rt p wT wY
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 _ True  _ _  = do
    String
auth <- IO String -> StateT HijackOptions IO String
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
    String -> StateT HijackOptions IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
auth
getAuthor _    False (Just new :: String
new) _   =
    String -> StateT HijackOptions IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
new
getAuthor verb :: String
verb False Nothing pinfo :: PatchInfo
pinfo = do
    [String]
whitelist <- IO [String] -> StateT HijackOptions IO [String]
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
    HijackOptions
hj <- StateT HijackOptions IO HijackOptions
forall (m :: * -> *) s. Monad m => StateT s m s
get
    if String
orig String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
whitelist Bool -> Bool -> Bool
|| HijackOptions -> Bool
canIgnore HijackOptions
hj
        then StateT HijackOptions IO String
allowHijack
        else do
            Char
hijackResp <- IO Char -> StateT HijackOptions IO Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> StateT HijackOptions IO Char)
-> IO Char -> StateT HijackOptions IO Char
forall a b. (a -> b) -> a -> b
$ HijackOptions -> IO Char
askAboutHijack HijackOptions
hj
            case Char
hijackResp of
                'y' -> StateT HijackOptions IO String
allowHijack
                '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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT HijackOptions IO String
allowHijack
                _   -> IO String -> StateT HijackOptions IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
forall a. IO a
exitSuccess
  where
    askAboutHijack :: HijackOptions -> IO Char
askAboutHijack hj :: 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  = "You're not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
orig String -> String -> String
forall a. [a] -> [a] -> [a]
++"! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
capitalize String
verb String -> String -> String
forall a. [a] -> [a] -> [a]
++ " anyway? "
         opts :: String
opts = case HijackOptions
hj of
             AlwaysRequestHijackPermission -> "yn"
             _ -> "yna"
    canIgnore :: HijackOptions -> Bool
canIgnore IgnoreHijack                  = Bool
True
    canIgnore RequestHijackPermission       = Bool
False
    canIgnore AlwaysRequestHijackPermission = Bool
False
    allowHijack :: StateT HijackOptions IO String
allowHijack = String -> StateT HijackOptions IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
orig
    orig :: String
orig = PatchInfo -> String
piAuthor PatchInfo
pinfo