module System.Console.Haskeline(
InputT,
runInputT,
haveTerminalUI,
mapInputT,
Behavior,
runInputTBehavior,
defaultBehavior,
useFileHandle,
useFile,
preferTerm,
getInputLine,
getInputLineWithInitial,
getInputChar,
getPassword,
waitForAnyKey,
outputStr,
outputStrLn,
getExternalPrint,
Settings(..),
defaultSettings,
setComplete,
Prefs(),
readPrefs,
defaultPrefs,
runInputTWithPrefs,
runInputTBehaviorWithPrefs,
withRunInBase,
getHistory,
putHistory,
modifyHistory,
withInterrupt,
Interrupt(..),
handleInterrupt,
module System.Console.Haskeline.Completion)
where
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import System.Console.Haskeline.Vi
import System.Console.Haskeline.Emacs
import System.Console.Haskeline.Prefs
import System.Console.Haskeline.History
import System.Console.Haskeline.Monads
import System.Console.Haskeline.InputT
import System.Console.Haskeline.Completion
import System.Console.Haskeline.Term
import System.Console.Haskeline.Key
import System.Console.Haskeline.RunCommand
import Control.Monad.Catch (MonadMask, handle)
import Data.Char (isSpace, isPrint)
import Data.Maybe (isJust)
import System.IO
defaultSettings :: MonadIO m => Settings m
defaultSettings :: forall (m :: * -> *). MonadIO m => Settings m
defaultSettings = Settings {complete :: CompletionFunc m
complete = CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename,
historyFile :: Maybe FilePath
historyFile = Maybe FilePath
forall a. Maybe a
Nothing,
autoAddHistory :: Bool
autoAddHistory = Bool
True}
outputStr :: MonadIO m => String -> InputT m ()
outputStr :: forall (m :: * -> *). MonadIO m => FilePath -> InputT m ()
outputStr FilePath
xs = do
FilePath -> IO ()
putter <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(FilePath -> IO ())
-> InputT m (FilePath -> IO ())
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT (ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(FilePath -> IO ())
-> InputT m (FilePath -> IO ()))
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(FilePath -> IO ())
-> InputT m (FilePath -> IO ())
forall a b. (a -> b) -> a -> b
$ (RunTerm -> FilePath -> IO ())
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(FilePath -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RunTerm -> FilePath -> IO ()
putStrOut
IO () -> InputT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT m ()) -> IO () -> InputT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putter FilePath
xs
outputStrLn :: MonadIO m => String -> InputT m ()
outputStrLn :: forall (m :: * -> *). MonadIO m => FilePath -> InputT m ()
outputStrLn = FilePath -> InputT m ()
forall (m :: * -> *). MonadIO m => FilePath -> InputT m ()
outputStr (FilePath -> InputT m ())
-> (FilePath -> FilePath) -> FilePath -> InputT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
getInputLine :: (MonadIO m, MonadMask m)
=> String
-> InputT m (Maybe String)
getInputLine :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> InputT m (Maybe FilePath)
getInputLine = (TermOps -> Prefix -> InputT m (Maybe FilePath))
-> (FileOps -> IO (Maybe FilePath))
-> FilePath
-> InputT m (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput (InsertMode -> TermOps -> Prefix -> InputT m (Maybe FilePath)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
InsertMode -> TermOps -> Prefix -> InputT m (Maybe FilePath)
getInputCmdLine InsertMode
emptyIM) ((FileOps -> IO (Maybe FilePath))
-> FilePath -> InputT m (Maybe FilePath))
-> (FileOps -> IO (Maybe FilePath))
-> FilePath
-> InputT m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ MaybeT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO FilePath -> IO (Maybe FilePath))
-> (FileOps -> MaybeT IO FilePath)
-> FileOps
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileOps -> MaybeT IO FilePath
getLocaleLine
getInputLineWithInitial :: (MonadIO m, MonadMask m)
=> String
-> (String, String)
-> InputT m (Maybe String)
getInputLineWithInitial :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath, FilePath) -> InputT m (Maybe FilePath)
getInputLineWithInitial FilePath
prompt (FilePath
left,FilePath
right) = (TermOps -> Prefix -> InputT m (Maybe FilePath))
-> (FileOps -> IO (Maybe FilePath))
-> FilePath
-> InputT m (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput (InsertMode -> TermOps -> Prefix -> InputT m (Maybe FilePath)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
InsertMode -> TermOps -> Prefix -> InputT m (Maybe FilePath)
getInputCmdLine InsertMode
initialIM)
(MaybeT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO FilePath -> IO (Maybe FilePath))
-> (FileOps -> MaybeT IO FilePath)
-> FileOps
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileOps -> MaybeT IO FilePath
getLocaleLine) FilePath
prompt
where
initialIM :: InsertMode
initialIM = FilePath -> InsertMode -> InsertMode
insertString FilePath
left (InsertMode -> InsertMode) -> InsertMode -> InsertMode
forall a b. (a -> b) -> a -> b
$ InsertMode -> InsertMode
forall s. Move s => s -> s
moveToStart (InsertMode -> InsertMode) -> InsertMode -> InsertMode
forall a b. (a -> b) -> a -> b
$ FilePath -> InsertMode -> InsertMode
insertString FilePath
right (InsertMode -> InsertMode) -> InsertMode -> InsertMode
forall a b. (a -> b) -> a -> b
$ InsertMode
emptyIM
getInputCmdLine :: (MonadIO m, MonadMask m) => InsertMode -> TermOps -> Prefix -> InputT m (Maybe String)
getInputCmdLine :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
InsertMode -> TermOps -> Prefix -> InputT m (Maybe FilePath)
getInputCmdLine InsertMode
initialIM TermOps
tops Prefix
prefix = do
EditMode
emode <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
EditMode
-> InputT m EditMode
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT (ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
EditMode
-> InputT m EditMode)
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
EditMode
-> InputT m EditMode
forall a b. (a -> b) -> a -> b
$ (Prefs -> EditMode)
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
EditMode
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Prefs -> EditMode
editMode
Maybe FilePath
result <- TermOps
-> InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops (InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath))
-> InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case EditMode
emode of
EditMode
Emacs -> TermOps
-> Prefix
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
(Maybe FilePath)
-> InsertMode
-> InputCmdT m (Maybe FilePath)
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prefix KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
(Maybe FilePath)
InputKeyCmd InsertMode (Maybe FilePath)
emacsCommands InsertMode
initialIM
EditMode
Vi -> ViState m
-> StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
(Maybe FilePath)
-> InputCmdT m (Maybe FilePath)
forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
evalStateT' ViState m
forall (m :: * -> *). Monad m => ViState m
emptyViState (StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
(Maybe FilePath)
-> InputCmdT m (Maybe FilePath))
-> StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
(Maybe FilePath)
-> InputCmdT m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
TermOps
-> Prefix
-> KeyCommand
(StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m)))))))
InsertMode
(Maybe FilePath)
-> InsertMode
-> StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
(Maybe FilePath)
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prefix KeyCommand
(StateT
(ViState m)
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m)))))))
InsertMode
(Maybe FilePath)
InputKeyCmd InsertMode (Maybe FilePath)
viKeyCommands InsertMode
initialIM
Maybe FilePath -> InputT m ()
forall (m :: * -> *). MonadIO m => Maybe FilePath -> InputT m ()
maybeAddHistory Maybe FilePath
result
Maybe FilePath -> InputT m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
result
maybeAddHistory :: forall m . MonadIO m => Maybe String -> InputT m ()
maybeAddHistory :: forall (m :: * -> *). MonadIO m => Maybe FilePath -> InputT m ()
maybeAddHistory Maybe FilePath
result = do
Settings m
settings :: Settings m <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(Settings m)
-> InputT m (Settings m)
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
(Settings m)
forall r (m :: * -> *). MonadReader r m => m r
ask
HistoryDuplicates
histDupes <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
HistoryDuplicates
-> InputT m HistoryDuplicates
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT (ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
HistoryDuplicates
-> InputT m HistoryDuplicates)
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
HistoryDuplicates
-> InputT m HistoryDuplicates
forall a b. (a -> b) -> a -> b
$ (Prefs -> HistoryDuplicates)
-> ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
HistoryDuplicates
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Prefs -> HistoryDuplicates
historyDuplicates
case Maybe FilePath
result of
Just FilePath
line | Settings m -> Bool
forall (m :: * -> *). Settings m -> Bool
autoAddHistory Settings m
settings Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
line)
-> let adder :: FilePath -> History -> History
adder = case HistoryDuplicates
histDupes of
HistoryDuplicates
AlwaysAdd -> FilePath -> History -> History
addHistory
HistoryDuplicates
IgnoreConsecutive -> FilePath -> History -> History
addHistoryUnlessConsecutiveDupe
HistoryDuplicates
IgnoreAll -> FilePath -> History -> History
addHistoryRemovingAllDupes
in (History -> History) -> InputT m ()
forall (m :: * -> *).
MonadIO m =>
(History -> History) -> InputT m ()
modifyHistory (FilePath -> History -> History
adder FilePath
line)
Maybe FilePath
_ -> () -> InputT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getInputChar :: (MonadIO m, MonadMask m) => String
-> InputT m (Maybe Char)
getInputChar :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> InputT m (Maybe Char)
getInputChar = (TermOps -> Prefix -> InputT m (Maybe Char))
-> (FileOps -> IO (Maybe Char))
-> FilePath
-> InputT m (Maybe Char)
forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput TermOps -> Prefix -> InputT m (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
TermOps -> Prefix -> InputT m (Maybe Char)
getInputCmdChar ((FileOps -> IO (Maybe Char)) -> FilePath -> InputT m (Maybe Char))
-> (FileOps -> IO (Maybe Char))
-> FilePath
-> InputT m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ \FileOps
fops -> do
Maybe Char
c <- FileOps -> IO (Maybe Char)
getPrintableChar FileOps
fops
FileOps -> IO ()
maybeReadNewline FileOps
fops
Maybe Char -> IO (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
getPrintableChar :: FileOps -> IO (Maybe Char)
getPrintableChar :: FileOps -> IO (Maybe Char)
getPrintableChar FileOps
fops = do
Maybe Char
c <- MaybeT IO Char -> IO (Maybe Char)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Char -> IO (Maybe Char))
-> MaybeT IO Char -> IO (Maybe Char)
forall a b. (a -> b) -> a -> b
$ FileOps -> MaybeT IO Char
getLocaleChar FileOps
fops
case (Char -> Bool) -> Maybe Char -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isPrint Maybe Char
c of
Just Bool
False -> FileOps -> IO (Maybe Char)
getPrintableChar FileOps
fops
Maybe Bool
_ -> Maybe Char -> IO (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
getInputCmdChar :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m (Maybe Char)
getInputCmdChar :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
TermOps -> Prefix -> InputT m (Maybe Char)
getInputCmdChar TermOps
tops Prefix
prefix = TermOps -> InputCmdT m (Maybe Char) -> InputT m (Maybe Char)
forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops
(InputCmdT m (Maybe Char) -> InputT m (Maybe Char))
-> InputCmdT m (Maybe Char) -> InputT m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ TermOps
-> Prefix
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
(Maybe Char)
-> InsertMode
-> InputCmdT m (Maybe Char)
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prefix KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
(Maybe Char)
forall (m :: * -> *).
Monad m =>
KeyCommand m InsertMode (Maybe Char)
acceptOneChar InsertMode
emptyIM
acceptOneChar :: Monad m => KeyCommand m InsertMode (Maybe Char)
acceptOneChar :: forall (m :: * -> *).
Monad m =>
KeyCommand m InsertMode (Maybe Char)
acceptOneChar = [KeyMap (Command m InsertMode (Maybe Char))]
-> KeyMap (Command m InsertMode (Maybe Char))
forall a. [KeyMap a] -> KeyMap a
choiceCmd [(Char -> Command m InsertMode (Maybe Char))
-> KeyMap (Command m InsertMode (Maybe Char))
forall (m :: * -> *) s t.
(Char -> Command m s t) -> KeyCommand m s t
useChar ((Char -> Command m InsertMode (Maybe Char))
-> KeyMap (Command m InsertMode (Maybe Char)))
-> (Char -> Command m InsertMode (Maybe Char))
-> KeyMap (Command m InsertMode (Maybe Char))
forall a b. (a -> b) -> a -> b
$ \Char
c InsertMode
s -> (InsertMode -> InsertMode) -> Command m InsertMode InsertMode
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Char -> InsertMode -> InsertMode
insertChar Char
c) InsertMode
s
CmdM m InsertMode -> CmdM m (Maybe Char) -> CmdM m (Maybe Char)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Char -> CmdM m (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)
, Char -> Key
ctrlChar Char
'l' Key
-> Command m InsertMode (Maybe Char)
-> KeyMap (Command m InsertMode (Maybe Char))
forall a. Key -> a -> KeyMap a
+> Command m InsertMode InsertMode
forall (m :: * -> *) s. Command m s s
clearScreenCmd Command m InsertMode InsertMode
-> Command m InsertMode (Maybe Char)
-> Command m InsertMode (Maybe Char)
forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|>
KeyMap (Command m InsertMode (Maybe Char))
-> Command m InsertMode (Maybe Char)
forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t
keyCommand KeyMap (Command m InsertMode (Maybe Char))
forall (m :: * -> *).
Monad m =>
KeyCommand m InsertMode (Maybe Char)
acceptOneChar
, Char -> Key
ctrlChar Char
'd' Key
-> Command m InsertMode (Maybe Char)
-> KeyMap (Command m InsertMode (Maybe Char))
forall a. Key -> a -> KeyMap a
+> Command m InsertMode (Maybe Char)
forall (m :: * -> *) s a. Monad m => Command m s (Maybe a)
failCmd]
waitForAnyKey :: (MonadIO m, MonadMask m)
=> String
-> InputT m Bool
waitForAnyKey :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> InputT m Bool
waitForAnyKey = (TermOps -> Prefix -> InputT m Bool)
-> (FileOps -> IO Bool) -> FilePath -> InputT m Bool
forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput TermOps -> Prefix -> InputT m Bool
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
TermOps -> Prefix -> InputT m Bool
getAnyKeyCmd
((FileOps -> IO Bool) -> FilePath -> InputT m Bool)
-> (FileOps -> IO Bool) -> FilePath -> InputT m Bool
forall a b. (a -> b) -> a -> b
$ \FileOps
fops -> (Maybe Char -> Bool) -> IO (Maybe Char) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe Char) -> IO Bool)
-> (MaybeT IO Char -> IO (Maybe Char)) -> MaybeT IO Char -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT IO Char -> IO (Maybe Char)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Char -> IO Bool) -> MaybeT IO Char -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileOps -> MaybeT IO Char
getLocaleChar FileOps
fops
getAnyKeyCmd :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m Bool
getAnyKeyCmd :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
TermOps -> Prefix -> InputT m Bool
getAnyKeyCmd TermOps
tops Prefix
prefix = TermOps -> InputCmdT m Bool -> InputT m Bool
forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops
(InputCmdT m Bool -> InputT m Bool)
-> InputCmdT m Bool -> InputT m Bool
forall a b. (a -> b) -> a -> b
$ TermOps
-> Prefix
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
Bool
-> InsertMode
-> InputCmdT m Bool
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prefix KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
InsertMode
Bool
forall {b}.
KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
acceptAnyChar InsertMode
emptyIM
where
acceptAnyChar :: KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
acceptAnyChar = [KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)]
-> KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a. [KeyMap a] -> KeyMap a
choiceCmd
[ Char -> Key
ctrlChar Char
'd' Key
-> (b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a. Key -> a -> KeyMap a
+> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
-> b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
forall a b. a -> b -> a
const (Bool
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
, (Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)))
-> KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap ((Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)))
-> KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
-> (Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)))
-> KeyMap
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a b. (a -> b) -> a -> b
$ Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
-> Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
forall a b. a -> b -> a
const (Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
-> Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)))
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
-> Key
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
forall a b. (a -> b) -> a -> b
$ KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> Maybe
(KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
forall a. a -> Maybe a
Just ((b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a. a -> KeyConsumed a
Consumed ((b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool))
-> (b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> KeyConsumed
(b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
forall a b. (a -> b) -> a -> b
$ CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
-> b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
forall a b. a -> b -> a
const (CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
-> b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool)
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
-> b
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
forall a b. (a -> b) -> a -> b
$ Bool
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
]
getPassword :: (MonadIO m, MonadMask m) => Maybe Char
-> String -> InputT m (Maybe String)
getPassword :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Maybe Char -> FilePath -> InputT m (Maybe FilePath)
getPassword Maybe Char
x = (TermOps -> Prefix -> InputT m (Maybe FilePath))
-> (FileOps -> IO (Maybe FilePath))
-> FilePath
-> InputT m (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput
(\TermOps
tops Prefix
prefix -> TermOps
-> InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops
(InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath))
-> InputCmdT m (Maybe FilePath) -> InputT m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ TermOps
-> Prefix
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> Password
-> InputCmdT m (Maybe FilePath)
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prefix KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop
(Password -> InputCmdT m (Maybe FilePath))
-> Password -> InputCmdT m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Char -> Password
Password [] Maybe Char
x)
(\FileOps
fops -> FileOps
-> forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
withoutInputEcho FileOps
fops (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ MaybeT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO FilePath -> IO (Maybe FilePath))
-> MaybeT IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FileOps -> MaybeT IO FilePath
getLocaleLine FileOps
fops)
where
loop :: KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop = [KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)]
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a. [KeyMap a] -> KeyMap a
choiceCmd [ Char -> Key
simpleChar Char
'\n' Key
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a. Key -> a -> KeyMap a
+> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s.
(Monad m, Result s) =>
Command m s (Maybe FilePath)
finish
, BaseKey -> Key
simpleKey BaseKey
Backspace Key
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a. Key -> a -> KeyMap a
+> (Password -> Password)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change Password -> Password
deletePasswordChar
Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop'
, (Char
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath))
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s t.
(Char -> Command m s t) -> KeyCommand m s t
useChar ((Char
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath))
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath))
-> (Char
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath))
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ \Char
c -> (Password -> Password)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
forall t (m :: * -> *) s.
(LineState t, Monad m) =>
(s -> t) -> Command m s t
change (Char -> Password -> Password
addPasswordChar Char
c) Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop'
, Char -> Key
ctrlChar Char
'd' Key
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a. Key -> a -> KeyMap a
+> \Password
p -> if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Password -> FilePath
passwordState Password
p)
then Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s a. Monad m => Command m s (Maybe a)
failCmd Password
p
else Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s.
(Monad m, Result s) =>
Command m s (Maybe FilePath)
finish Password
p
, Char -> Key
ctrlChar Char
'l' Key
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall a. Key -> a -> KeyMap a
+> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
forall (m :: * -> *) s. Command m s s
clearScreenCmd Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
Password
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop'
]
loop' :: Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop' = KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t
keyCommand KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))))
Password
(Maybe FilePath)
loop
promptedInput :: MonadIO m => (TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a)
-> String -> InputT m a
promptedInput :: forall (m :: * -> *) a.
MonadIO m =>
(TermOps -> Prefix -> InputT m a)
-> (FileOps -> IO a) -> FilePath -> InputT m a
promptedInput TermOps -> Prefix -> InputT m a
doTerm FileOps -> IO a
doFile FilePath
prompt = do
IO () -> InputT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT m ()) -> IO () -> InputT m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
RunTerm
rterm <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
-> InputT m RunTerm
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
forall r (m :: * -> *). MonadReader r m => m r
ask
case RunTerm -> Either TermOps FileOps
termOps RunTerm
rterm of
Right FileOps
fops -> IO a -> InputT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> InputT m a) -> IO a -> InputT m a
forall a b. (a -> b) -> a -> b
$ do
RunTerm -> FilePath -> IO ()
putStrOut RunTerm
rterm FilePath
prompt
FileOps -> forall a. IO a -> IO a
wrapFileInput FileOps
fops (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ FileOps -> IO a
doFile FileOps
fops
Left TermOps
tops -> do
let prompt' :: Prefix
prompt' = FilePath -> Prefix
stringToGraphemes FilePath
prompt
let (Prefix
lastLine,Prefix
rest) = (Grapheme -> Bool) -> Prefix -> (Prefix, Prefix)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Grapheme -> Prefix -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath -> Prefix
stringToGraphemes FilePath
"\r\n")
(Prefix -> (Prefix, Prefix)) -> Prefix -> (Prefix, Prefix)
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix
forall a. [a] -> [a]
reverse Prefix
prompt'
FilePath -> InputT m ()
forall (m :: * -> *). MonadIO m => FilePath -> InputT m ()
outputStr (FilePath -> InputT m ()) -> FilePath -> InputT m ()
forall a b. (a -> b) -> a -> b
$ Prefix -> FilePath
graphemesToString (Prefix -> FilePath) -> Prefix -> FilePath
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix
forall a. [a] -> [a]
reverse Prefix
rest
TermOps -> Prefix -> InputT m a
doTerm TermOps
tops (Prefix -> InputT m a) -> Prefix -> InputT m a
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix
forall a. [a] -> [a]
reverse Prefix
lastLine
withInterrupt :: (MonadIO m, MonadMask m) => InputT m a -> InputT m a
withInterrupt :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> InputT m a
withInterrupt InputT m a
act = do
RunTerm
rterm <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
-> InputT m RunTerm
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
forall r (m :: * -> *). MonadReader r m => m r
ask
RunTerm
-> forall a (m :: * -> *). (MonadIO m, MonadMask m) => m a -> m a
wrapInterrupt RunTerm
rterm InputT m a
act
handleInterrupt :: MonadMask m => m a -> m a -> m a
handleInterrupt :: forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
handleInterrupt m a
f = (Interrupt -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle ((Interrupt -> m a) -> m a -> m a)
-> (Interrupt -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \Interrupt
Interrupt -> m a
f
getExternalPrint :: MonadIO m => InputT m (String -> IO ())
getExternalPrint :: forall (m :: * -> *). MonadIO m => InputT m (FilePath -> IO ())
getExternalPrint = do
RunTerm
rterm <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
-> InputT m RunTerm
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
RunTerm
forall r (m :: * -> *). MonadReader r m => m r
ask
(FilePath -> IO ()) -> InputT m (FilePath -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> IO ()) -> InputT m (FilePath -> IO ()))
-> (FilePath -> IO ()) -> InputT m (FilePath -> IO ())
forall a b. (a -> b) -> a -> b
$ case RunTerm -> Either TermOps FileOps
termOps RunTerm
rterm of
Right FileOps
_ -> RunTerm -> FilePath -> IO ()
putStrOut RunTerm
rterm
Left TermOps
tops -> TermOps -> FilePath -> IO ()
externalPrint TermOps
tops