module Darcs.UI.PatchHeader
( getLog
, getAuthor
, updatePatchHeader, AskAboutDeps(..)
, HijackT, HijackOptions(..)
, runHijackT
) where
import Darcs.Prelude
import Darcs.Patch
( IsRepoType, RepoPatch, PrimPatch, PrimOf
, summaryFL
)
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info ( PatchInfo,
piAuthor, piName, piLog, piDateString,
patchinfo
)
import Darcs.Patch.Named
( Named, patchcontents, patch2patchinfo, infopatch, getdeps, adddeps
)
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia )
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, stripPrefix )
import Data.Maybe ( fromMaybe, isJust )
import System.Exit ( exitSuccess )
import System.IO ( stdin )
data PName = FlagPatchName String | PriorPatchName String | NoPatchName
data HijackOptions = IgnoreHijack
| RequestHijackPermission
| AlwaysRequestHijackPermission
type HijackT = StateT HijackOptions
getLog :: forall prim wX wY . PrimPatch prim
=> Maybe String
-> Bool
-> O.Logfile
-> Maybe O.AskLongComment
-> Maybe (String, [String])
-> FL prim wX wY
-> IO (String, [String], Maybe String)
getLog :: 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
m_name Bool
has_pipe Logfile
log_file Maybe AskLongComment
ask_long Maybe (String, [String])
m_old FL prim wX wY
chs =
forall {b} {c}. (String, b, c) -> (String, b, c)
restoreTagPrefix 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
String
p <- case PName
patchname_specified of
FlagPatchName String
p -> String -> IO ()
check_badname String
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
p
PriorPatchName String
p -> forall (m :: * -> *) a. Monad m => a -> m a
return String
p
PName
NoPatchName -> Bool -> IO String
prompt_patchname Bool
False
String -> IO ()
putStrLn String
"What is the log?"
[String]
thelog <- String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle -> IO String
Ratified.hGetContents Handle
stdin
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
thelog, forall a. Maybe a
Nothing)
go Bool
_ (O.Logfile { _logfile :: Logfile -> Maybe AbsolutePath
O._logfile = Just AbsolutePath
f }) Maybe AskLongComment
_ = do
[String]
mlp <- forall p. FilePathLike p => p -> IO [String]
readTextFile AbsolutePath
f forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
String
firstname <- case (PName
patchname_specified, [String]
mlp) of
(FlagPatchName String
p, []) -> String -> IO ()
check_badname String
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a. Monad m => a -> m a
return String
p
(PriorPatchName String
p, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
p
(PName
NoPatchName, []) -> Bool -> IO String
prompt_patchname Bool
True
forall {p}. FilePathLike p => p -> String -> IO ()
append_info AbsolutePath
f String
firstname
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AskLongComment
ask_long forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AskLongComment
O.YesEditLongComment) (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile AbsolutePath
f)
(String
name, [String]
thelog) <- forall p. FilePathLike p => p -> String -> IO (String, [String])
read_long_comment AbsolutePath
f String
firstname
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [String]
thelog, if Logfile -> Bool
O._rmlogfile Logfile
log_file then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
f else forall a. Maybe a
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, forall a. Maybe a
Nothing)
PriorPatchName String
p -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, forall a. Maybe a
Nothing)
PName
NoPatchName -> do String
p <- Bool -> IO String
prompt_patchname Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [], forall a. Maybe a
Nothing)
go Bool
_ Logfile
_ (Just AskLongComment
O.PromptLongComment) =
case PName
patchname_specified of
FlagPatchName String
p -> String -> IO ()
check_badname String
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p
PriorPatchName String
p -> String -> IO (String, [String], Maybe String)
prompt_long_comment String
p
PName
NoPatchName -> Bool -> IO String
prompt_patchname Bool
True 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, forall a. Maybe a
Nothing)
PriorPatchName String
"" -> String -> IO (String, [String], Maybe String)
get_log_using_editor String
""
PriorPatchName String
p -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [String]
default_log, 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 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 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 = forall a. a -> Maybe a -> a
fromMaybe String
name forall a b. (a -> b) -> a -> b
$ 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) a. MonadFail m => String -> m a
fail 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
String
n <- String -> IO String
askUser String
"What is the patch name? "
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return String
n) String -> IO String
prompt_again forall a b. (a -> b) -> a -> b
$ String -> Maybe String
just_a_badname String
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 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n then
forall a. a -> Maybe a
Just String
"Error: The patch name must not be empty!"
else if String -> Bool
hasTagPrefix String
n then
forall a. a -> Maybe a
Just String
"Error: The patch name must not start with \"TAG \"!"
else
forall a. Maybe a
Nothing
is_badname :: String -> Bool
is_badname = forall a. Maybe a -> Bool
isJust 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"
Bool
y <- String -> IO Bool
promptYorn forall a b. (a -> b) -> a -> b
$ String
"Do you want to "forall a. [a] -> [a] -> [a]
++String
verbforall a. [a] -> [a] -> [a]
++String
" long comment?"
if Bool
y then String -> IO (String, [String], Maybe String)
get_log_using_editor String
oldname
else forall (m :: * -> *) a. Monad m => a -> m a
return (String
oldname, [String]
default_log, forall a. Maybe a
Nothing)
get_log_using_editor :: String -> IO (String, [String], Maybe String)
get_log_using_editor String
p =
do let logf :: String
logf = String
darcsLastMessage
forall {p}. FilePathLike p => p -> String -> IO ()
writeTextFile String
logf forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
p forall a. a -> [a] -> [a]
: [String]
default_log
forall {p}. FilePathLike p => p -> String -> IO ()
append_info String
logf String
p
(ExitCode, Bool)
_ <- forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile String
logf
(String
name,[String]
long) <- forall p. FilePathLike p => p -> String -> IO (String, [String])
read_long_comment String
logf String
p
String -> IO ()
check_badname String
name
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name,[String]
long,forall a. a -> Maybe a
Just String
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 [String]
t <- forall p. FilePathLike p => p -> IO [String]
readTextFile p
f
let filter_out_info :: [String] -> [String]
filter_out_info = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.(String
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
case forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [String] -> [String]
filter_out_info [String]
t of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
oldname, [])
(String
n:[String]
ls) -> do
String -> IO ()
check_badname String
n
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
[String]
fc <- forall p. FilePathLike p => p -> IO [String]
readTextFile p
f
forall {p}. FilePathLike p => p -> String -> IO ()
writeTextFile p
f forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fc then [String
oldname] else [String]
fc)
Doc -> Doc -> Doc
$$ String -> Doc
text String
"# Please enter the patch name in the first line, and"
Doc -> Doc -> Doc
$$ String -> Doc
text String
"# optionally, a long description in the following lines."
Doc -> Doc -> Doc
$$ String -> Doc
text String
"#"
Doc -> Doc -> Doc
$$ String -> Doc
text String
"# Lines starting with '#' will be ignored."
Doc -> Doc -> Doc
$$ String -> Doc
text String
"#"
Doc -> Doc -> Doc
$$ String -> Doc
text String
"#"
Doc -> Doc -> Doc
$$ String -> Doc
text String
"# Summary of selected changes:"
Doc -> Doc -> Doc
$$ String -> Doc
text String
"#"
Doc -> Doc -> Doc
$$ Doc -> Doc -> Doc
prefixLines (String -> Doc
text String
"#") (forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL FL prim wX wY
chs)
data AskAboutDeps rt p wR wU wT = AskAboutDeps (Repository rt p wR wU wT) | NoAskAboutDeps
runHijackT :: Monad m => HijackOptions -> HijackT m a -> m a
runHijackT :: forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
updatePatchHeader :: forall rt p wX wY wR wU wT . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> String
-> AskAboutDeps rt p wR wU wT
-> S.PatchSelectionOptions
-> D.DiffAlgorithm
-> Bool
-> Bool
-> Maybe String
-> Maybe String
-> Maybe O.AskLongComment
-> Named (PrimOf p) wT wX
-> FL (PrimOf p) wX wY
-> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
String
verb AskAboutDeps rt p wR wU wT
ask_deps PatchSelectionOptions
pSelOpts DiffAlgorithm
da Bool
nKeepDate Bool
nSelectAuthor Maybe String
nAuthor Maybe String
nPatchname Maybe AskLongComment
nAskLongComment Named (PrimOf p) wT wX
oldp FL (PrimOf p) wX wY
chs = do
let newchs :: FL (PrimOf p) wT wY
newchs = forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named (PrimOf p) wT wX
oldp 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 = forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named (PrimOf p) wT wX
oldp
[PatchInfo]
newdeps <-
case AskAboutDeps rt p wR wU wT
ask_deps of
AskAboutDeps Repository rt p wR wU wT
repository -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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
AskAboutDeps rt p wR wU wT
NoAskAboutDeps -> forall (m :: * -> *) a. Monad m => a -> m a
return [PatchInfo]
old_pdeps
let old_pinf :: PatchInfo
old_pinf = forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named (PrimOf 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 forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo -> String
piDateString PatchInfo
old_pinf) else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
(String
new_name, [String]
new_log, Maybe String
mlogf) <- 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 forall a. Maybe a
Nothing Bool
False) Maybe AskLongComment
nAskLongComment (forall a. a -> Maybe a
Just (String, [String])
prior) FL (PrimOf p) wX wY
chs
PatchInfo
new_pinf <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
new_name String
new_author [String]
new_log
let newp :: PatchInfoAndG rt (Named p) wT wY
newp = forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia (forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
new_pinf FL (PrimOf p) wT wY
newchs) [PatchInfo]
newdeps)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
mlogf, forall {rt :: RepoType}. PatchInfoAndG rt (Named p) wT wY
newp)
getAuthor :: String
-> Bool
-> Maybe String
-> PatchInfo
-> HijackT IO String
getAuthor :: String
-> Bool
-> Maybe String
-> PatchInfo
-> StateT HijackOptions IO String
getAuthor String
_ Bool
True Maybe String
_ PatchInfo
_ = do
String
auth <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> IO String
promptAuthor Bool
False Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return String
auth
getAuthor String
_ Bool
False (Just String
new) PatchInfo
_ =
forall (m :: * -> *) a. Monad m => a -> m a
return String
new
getAuthor String
verb Bool
False Maybe String
Nothing PatchInfo
pinfo = do
[String]
whitelist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO [String]
getEasyAuthor
HijackOptions
hj <- forall (m :: * -> *) s. Monad m => StateT s m s
get
if String
orig 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HijackOptions -> IO Char
askAboutHijack HijackOptions
hj
case Char
hijackResp of
Char
'y' -> StateT HijackOptions IO String
allowHijack
Char
'a' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put HijackOptions
IgnoreHijack forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT HijackOptions IO String
allowHijack
Char
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 [] forall a. Maybe a
Nothing [])
where
msg :: String
msg = String
"You're not " forall a. [a] -> [a] -> [a]
++ String
orig forall a. [a] -> [a] -> [a]
++String
"! " forall a. [a] -> [a] -> [a]
++ String -> String
capitalize String
verb 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 = forall (m :: * -> *) a. Monad m => a -> m a
return String
orig
orig :: String
orig = PatchInfo -> String
piAuthor PatchInfo
pinfo