{-# Language BangPatterns, OverloadedStrings, NondecreasingIndentation, PatternSynonyms #-}
module Client.EventLoop
( eventLoop
, updateTerminalSize
, ClientEvent(..)
) where
import Client.CApi (ThreadEntry, popTimer)
import Client.Commands (CommandResult(..), execute, executeUserCommand, tabCompletion)
import Client.Configuration (configJumpModifier, configKeyMap, configWindowNames, configDigraphs, configNotifications)
import Client.Configuration.Notifications (notifyCmd)
import Client.Configuration.ServerSettings ( ssReconnectAttempts )
import Client.EventLoop.Actions (keyToAction, Action(..))
import Client.EventLoop.Errors (exceptionToLines)
import Client.EventLoop.Network (clientResponse)
import Client.Hook (applyMessageHooks, messageHookStateful)
import Client.Image (clientPicture)
import Client.Image.Layout (scrollAmount)
import Client.Image.StatusLine (clientTitle)
import Client.Log ( writeLogLine )
import Client.Message
import Client.Network.Async
import Client.State
import Client.State.EditBox qualified as Edit
import Client.State.Extensions
import Client.State.Focus (Subfocus(FocusMessages))
import Client.State.Network
import Control.Concurrent.STM
import Control.Exception (SomeException, Exception(fromException), catch)
import Control.Lens
import Control.Monad (when, MonadPlus(mplus), foldM, unless, void)
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Data.Foldable (Foldable(foldl'), find, asum, traverse_)
import Data.HashMap.Strict qualified as HashMap
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Encoding.Error qualified as Text
import Data.Time
import Data.Time.Format.ISO8601 (formatParseM, iso8601Format)
import Data.Traversable (for)
import GHC.IO.Exception (IOErrorType(..), ioe_type)
import Graphics.Vty
import Hookup (ConnectionFailure(..))
import Irc.Codes (pattern RPL_STARTTLS)
import Irc.Message (IrcMsg(Reply, Notice), cookIrcMsg, msgTarget)
import Irc.RawIrcMsg (RawIrcMsg, TagEntry(..), asUtf8, msgTags, parseRawIrcMsg)
import LensUtils (setStrict)
import System.Process.Typed (startProcess, setStdin, setStdout, setStderr, nullStream)
data ClientEvent
= VtyEvent InternalEvent
| NetworkEvents (NonEmpty (Text, NetworkEvent))
| TimerEvent Text TimedAction
| ExtTimerEvent Int
| ThreadEvent Int ThreadEntry
getEvent ::
Vty ->
ClientState ->
IO ClientEvent
getEvent :: Vty -> ClientState -> IO ClientEvent
getEvent Vty
vty ClientState
st =
do STM ClientEvent
timer <- IO (STM ClientEvent)
prepareTimer
forall a. STM a -> IO a
atomically (forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [STM ClientEvent
timer, STM ClientEvent
vtyEvent, STM ClientEvent
networkEvents, STM ClientEvent
threadJoin])
where
vtyEvent :: STM ClientEvent
vtyEvent = InternalEvent -> ClientEvent
VtyEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TChan a -> STM a
readTChan (Input -> TChan InternalEvent
eventChannel (Vty -> Input
inputIface Vty
vty))
networkEvents :: STM ClientEvent
networkEvents =
do [[(Text, NetworkEvent)]]
xs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall k v. HashMap k v -> [(k, v)]
HashMap.toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (HashMap Text NetworkState)
clientConnections ClientState
st)) forall a b. (a -> b) -> a -> b
$ \(Text
network, NetworkState
conn) ->
do [NetworkEvent]
ys <- NetworkConnection -> STM [NetworkEvent]
recv (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState NetworkConnection
csSocket NetworkState
conn)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map ((,) Text
network) [NetworkEvent]
ys)
case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Text, NetworkEvent)]]
xs) of
Just NonEmpty (Text, NetworkEvent)
events1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Text, NetworkEvent) -> ClientEvent
NetworkEvents NonEmpty (Text, NetworkEvent)
events1)
Maybe (NonEmpty (Text, NetworkEvent))
Nothing -> forall a. STM a
retry
prepareTimer :: IO (STM ClientEvent)
prepareTimer =
case ClientState -> Maybe (UTCTime, ClientEvent)
earliestEvent ClientState
st of
Maybe (UTCTime, ClientEvent)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. STM a
retry
Just (UTCTime
runAt,ClientEvent
event) ->
do UTCTime
now <- IO UTCTime
getCurrentTime
let microsecs :: Int
microsecs = forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime
1000000 forall a. Num a => a -> a -> a
* UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
runAt UTCTime
now)
TVar Bool
var <- Int -> IO (TVar Bool)
registerDelay (forall a. Ord a => a -> a -> a
max Int
0 Int
microsecs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do Bool
ready <- forall a. TVar a -> STM a
readTVar TVar Bool
var
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ready forall a. STM a
retry
forall (m :: * -> *) a. Monad m => a -> m a
return ClientEvent
event
threadJoin :: STM ClientEvent
threadJoin =
do (Int
i,ThreadEntry
r) <- forall a. TQueue a -> STM a
readTQueue (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (TQueue (Int, ThreadEntry))
clientThreadJoins ClientState
st)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ThreadEntry -> ClientEvent
ThreadEvent Int
i ThreadEntry
r)
earliestEvent :: ClientState -> Maybe (UTCTime, ClientEvent)
earliestEvent :: ClientState -> Maybe (UTCTime, ClientEvent)
earliestEvent ClientState
st = forall {a} {b}.
Ord a =>
Maybe (a, b) -> Maybe (a, b) -> Maybe (a, b)
earliest2 Maybe (UTCTime, ClientEvent)
networkEvent Maybe (UTCTime, ClientEvent)
extensionEvent
where
earliest2 :: Maybe (a, b) -> Maybe (a, b) -> Maybe (a, b)
earliest2 (Just (a
time1, b
action1)) (Just (a
time2, b
action2))
| a
time1 forall a. Ord a => a -> a -> Bool
< a
time2 = forall a. a -> Maybe a
Just (a
time1, b
action1)
| Bool
otherwise = forall a. a -> Maybe a
Just (a
time2, b
action2)
earliest2 Maybe (a, b)
x Maybe (a, b)
y = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe (a, b)
x Maybe (a, b)
y
mkEventN :: (Text, (a, TimedAction)) -> (a, ClientEvent)
mkEventN (Text
network, (a
time, TimedAction
action)) = (a
time, Text -> TimedAction -> ClientEvent
TimerEvent Text
network TimedAction
action)
networkEvent :: Maybe (UTCTime, ClientEvent)
networkEvent =
forall a s.
Getting (Endo (Endo (Maybe a))) s a
-> (a -> a -> Ordering) -> s -> Maybe a
minimumByOf
(Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding NetworkState -> Maybe (UTCTime, TimedAction)
nextTimedAction) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {a}. (Text, (a, TimedAction)) -> (a, ClientEvent)
mkEventN)
(forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
ClientState
st
mkEventE :: (Int, (a, b, c, d, e)) -> (a, ClientEvent)
mkEventE (Int
i, (a
time,b
_,c
_,d
_,e
_)) = (a
time, Int -> ClientEvent
ExtTimerEvent Int
i)
extensionEvent :: Maybe (UTCTime, ClientEvent)
extensionEvent =
forall a s.
Getting (Endo (Endo (Maybe a))) s a
-> (a -> a -> Ordering) -> s -> Maybe a
minimumByOf
(Lens' ClientState ExtensionState
clientExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ExtensionState (IntMap ActiveExtension)
esActive forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ActiveExtension
-> Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
popTimer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {a} {b} {c} {d} {e}.
(Int, (a, b, c, d, e)) -> (a, ClientEvent)
mkEventE)
(forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
ClientState
st
eventLoop :: Vty -> ClientState -> IO ()
eventLoop :: Vty -> ClientState -> IO ()
eventLoop Vty
vty ClientState
st =
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientBell ClientState
st) (Vty -> IO ()
beep Vty
vty)
ClientState -> IO ()
processNotifications ClientState
st
ClientState -> IO ()
processLogEntries ClientState
st
let (Picture
pic, ClientState
st') = ClientState -> (Picture, ClientState)
clientPicture (ClientState -> ClientState
clientTick ClientState
st)
Vty -> Picture -> IO ()
update Vty
vty Picture
pic
Vty -> String -> IO ()
setWindowTitle Vty
vty (ClientState -> String
clientTitle ClientState
st)
ClientEvent
event <- Vty -> ClientState -> IO ClientEvent
getEvent Vty
vty ClientState
st'
case ClientEvent
event of
ExtTimerEvent Int
i ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ClientState -> IO ClientState
clientExtTimer Int
i ClientState
st'
ThreadEvent Int
i ThreadEntry
result ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ThreadEntry -> ClientState -> IO ClientState
clientThreadJoin Int
i ThreadEntry
result ClientState
st'
TimerEvent Text
networkId TimedAction
action ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> TimedAction -> ClientState -> IO ClientState
doTimerEvent Text
networkId TimedAction
action ClientState
st'
VtyEvent (InputEvent Event
vtyEvent) ->
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Vty -> ClientState -> IO ()
eventLoop Vty
vty) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vty -> Event -> ClientState -> IO (Maybe ClientState)
doVtyEvent Vty
vty Event
vtyEvent ClientState
st'
VtyEvent InternalEvent
ResumeAfterInterrupt ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vty -> ClientState -> IO ClientState
updateTerminalSize Vty
vty ClientState
st
NetworkEvents NonEmpty (Text, NetworkEvent)
networkEvents ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ClientState -> (Text, NetworkEvent) -> IO ClientState
doNetworkEvent ClientState
st' NonEmpty (Text, NetworkEvent)
networkEvents
doNetworkEvent :: ClientState -> (Text, NetworkEvent) -> IO ClientState
doNetworkEvent :: ClientState -> (Text, NetworkEvent) -> IO ClientState
doNetworkEvent ClientState
st (Text
net, NetworkEvent
networkEvent) =
case NetworkEvent
networkEvent of
NetworkLine ZonedTime
time ByteString
line -> Text -> ZonedTime -> ByteString -> ClientState -> IO ClientState
doNetworkLine Text
net ZonedTime
time ByteString
line ClientState
st
NetworkError ZonedTime
time SomeException
ex -> Text -> ZonedTime -> SomeException -> ClientState -> IO ClientState
doNetworkError Text
net ZonedTime
time SomeException
ex ClientState
st
NetworkOpen ZonedTime
time -> Text -> ZonedTime -> ClientState -> IO ClientState
doNetworkOpen Text
net ZonedTime
time ClientState
st
NetworkTLS [Text]
txts -> Text -> [Text] -> ClientState -> IO ClientState
doNetworkTLS Text
net [Text]
txts ClientState
st
NetworkClose ZonedTime
time -> Text -> ZonedTime -> ClientState -> IO ClientState
doNetworkClose Text
net ZonedTime
time ClientState
st
beep :: Vty -> IO ()
beep :: Vty -> IO ()
beep = Output -> IO ()
ringTerminalBell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vty -> Output
outputIface
processLogEntries :: ClientState -> IO ()
processLogEntries :: ClientState -> IO ()
processLogEntries =
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ LogLine -> IO ()
writeLogLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [LogLine]
clientLogQueue
processNotifications :: ClientState -> IO ()
processNotifications :: ClientState -> IO ()
processNotifications ClientState
st =
case NotifyWith -> Maybe ((Text, Text) -> ProcessConfig () () ())
notifyCmd (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration NotifyWith
configNotifications) ClientState
st) of
Just (Text, Text) -> ProcessConfig () () ()
cmd | Bool -> Bool
not (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientUiFocused ClientState
st) -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall {p} {stdin0} {stdout0} {stderr0}.
(p -> ProcessConfig stdin0 stdout0 stderr0) -> p -> IO ()
spawn (Text, Text) -> ProcessConfig () () ()
cmd) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Text, Text)]
clientNotifications ClientState
st)
Maybe ((Text, Text) -> ProcessConfig () () ())
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
handleException :: SomeException -> IO ()
handleException :: SomeException -> IO ()
handleException SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
spawn :: (p -> ProcessConfig stdin0 stdout0 stderr0) -> p -> IO ()
spawn p -> ProcessConfig stdin0 stdout0 stderr0
cmd p
pair = do
let procCfg :: ProcessConfig () () ()
procCfg = forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall a b. (a -> b) -> a -> b
$ p -> ProcessConfig stdin0 stdout0 stderr0
cmd p
pair
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig () () ()
procCfg)) SomeException -> IO ()
handleException
doNetworkOpen ::
Text ->
ZonedTime ->
ClientState ->
IO ClientState
doNetworkOpen :: Text -> ZonedTime -> ClientState -> IO ClientState
doNetworkOpen Text
networkId ZonedTime
time ClientState
st =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
networkId) ClientState
st of
Maybe NetworkState
Nothing -> forall a. HasCallStack => String -> a
error String
"doNetworkOpen: Network missing"
Just NetworkState
cs ->
do let msg :: ClientMessage
msg = ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
time
, _msgNetwork :: Text
_msgNetwork = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs
, _msgBody :: MessageBody
_msgBody = Text -> MessageBody
NormalBody Text
"connection opened"
}
let cs' :: NetworkState
cs' = NetworkState
cs forall a b. a -> (a -> b) -> b
& Lens' NetworkState (Maybe UTCTime)
csLastReceived forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
time)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
setStrict (Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
networkId) NetworkState
cs' ClientState
st
doNetworkTLS ::
Text ->
[Text] ->
ClientState ->
IO ClientState
doNetworkTLS :: Text -> [Text] -> ClientState -> IO ClientState
doNetworkTLS Text
network [Text]
cert ClientState
st =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
network) NetworkState -> NetworkState
upd ClientState
st
where
upd :: NetworkState -> NetworkState
upd = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' NetworkState [Text]
csCertificate [Text]
cert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' NetworkState PingStatus
csPingStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field3 s t a b => Lens s t a b
_3) ConnectRestriction
NoRestriction
doNetworkClose ::
Text ->
ZonedTime ->
ClientState ->
IO ClientState
doNetworkClose :: Text -> ZonedTime -> ClientState -> IO ClientState
doNetworkClose Text
networkId ZonedTime
time ClientState
st =
do let (NetworkState
cs,ClientState
st1) = Text -> ClientState -> (NetworkState, ClientState)
removeNetwork Text
networkId ClientState
st
msg :: ClientMessage
msg = ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
time
, _msgNetwork :: Text
_msgNetwork = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs
, _msgBody :: MessageBody
_msgBody = Text -> MessageBody
NormalBody Text
"connection closed"
}
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg ClientState
st1)
doNetworkError ::
Text ->
ZonedTime ->
SomeException ->
ClientState ->
IO ClientState
doNetworkError :: Text -> ZonedTime -> SomeException -> ClientState -> IO ClientState
doNetworkError Text
networkId ZonedTime
time SomeException
ex ClientState
st =
do let (NetworkState
cs,ClientState
st1) = Text -> ClientState -> (NetworkState, ClientState)
removeNetwork Text
networkId ClientState
st
st2 :: ClientState
st2 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ClientState
acc String
msg -> ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
time (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs) (String -> Text
Text.pack String
msg) ClientState
acc) ClientState
st1
forall a b. (a -> b) -> a -> b
$ SomeException -> NonEmpty String
exceptionToLines SomeException
ex
SomeException -> NetworkState -> ClientState -> IO ClientState
reconnectLogicOnFailure SomeException
ex NetworkState
cs ClientState
st2
reconnectLogicOnFailure ::
SomeException ->
NetworkState ->
ClientState ->
IO ClientState
reconnectLogicOnFailure :: SomeException -> NetworkState -> ClientState -> IO ClientState
reconnectLogicOnFailure SomeException
ex NetworkState
cs ClientState
st
| Bool
shouldReconnect =
do (Int
attempts, Maybe UTCTime
mbDisconnectTime) <- IO (Int, Maybe UTCTime)
computeRetryInfo
Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
attempts Maybe UTCTime
mbDisconnectTime forall a. Maybe a
Nothing (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs) ClientState
st
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st
where
computeRetryInfo :: IO (Int, Maybe UTCTime)
computeRetryInfo =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
PingConnecting Int
n Maybe UTCTime
tm ConnectRestriction
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
nforall a. Num a => a -> a -> a
+Int
1, Maybe UTCTime
tm)
PingStatus
_ | Just UTCTime
tm <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState (Maybe UTCTime)
csLastReceived NetworkState
cs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, forall a. a -> Maybe a
Just UTCTime
tm)
| Bool
otherwise -> do UTCTime
now <- IO UTCTime
getCurrentTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, forall a. a -> Maybe a
Just UTCTime
now)
reconnectAttempts :: Int
reconnectAttempts = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState ServerSettings
csSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ServerSettings Int
ssReconnectAttempts) NetworkState
cs
shouldReconnect :: Bool
shouldReconnect =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
PingConnecting Int
n Maybe UTCTime
_ ConnectRestriction
_ | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> Int
reconnectAttempts -> Bool
False
PingStatus
_ | Just ConnectionFailure{} <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just HostnameResolutionFailure{} <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just TerminationReason
PingTimeout <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just IOErrorType
ResourceVanished <- IOException -> IOErrorType
ioe_type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just IOErrorType
NoSuchThing <- IOException -> IOErrorType
ioe_type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Bool
otherwise -> Bool
False
doNetworkLine ::
Text ->
ZonedTime ->
ByteString ->
ClientState ->
IO ClientState
doNetworkLine :: Text -> ZonedTime -> ByteString -> ClientState -> IO ClientState
doNetworkLine Text
networkId ZonedTime
time ByteString
line ClientState
st =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
networkId) ClientState
st of
Maybe NetworkState
Nothing -> forall a. HasCallStack => String -> a
error String
"doNetworkLine: Network missing"
Just NetworkState
cs ->
let network :: Text
network = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs in
case Text -> Maybe RawIrcMsg
parseRawIrcMsg (ByteString -> Text
asUtf8 ByteString
line) of
Maybe RawIrcMsg
_ | PingConnecting Int
_ Maybe UTCTime
_ ConnectRestriction
WaitTLSRestriction <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState PingStatus
csPingStatus NetworkState
cs ->
ClientState
st forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
StartTLSFailed (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
Just RawIrcMsg
raw
| PingConnecting Int
_ Maybe UTCTime
_ ConnectRestriction
StartTLSRestriction <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState PingStatus
csPingStatus NetworkState
cs ->
Text -> NetworkState -> ClientState -> RawIrcMsg -> IO ClientState
startTLSLine Text
networkId NetworkState
cs ClientState
st RawIrcMsg
raw
Maybe RawIrcMsg
Nothing ->
do let msg :: Text
msg = String -> Text
Text.pack (String
"Malformed message: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
line)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
time Text
network Text
msg ClientState
st
Just RawIrcMsg
raw ->
do (ClientState
st1,Bool
passed) <- Text -> RawIrcMsg -> ClientState -> IO (ClientState, Bool)
clientNotifyExtensions Text
network RawIrcMsg
raw ClientState
st
if Bool -> Bool
not Bool
passed then forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st1 else do
let time' :: ZonedTime
time' = ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime ZonedTime
time (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags RawIrcMsg
raw)
(IrcMsg -> Maybe IrcMsg
stateHook, IrcMsg -> Maybe IrcMsg
viewHook)
= forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both [MessageHook] -> IrcMsg -> Maybe IrcMsg
applyMessageHooks
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' MessageHook Bool
messageHookStateful)
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState [MessageHook]
csMessageHooks NetworkState
cs
case IrcMsg -> Maybe IrcMsg
stateHook (RawIrcMsg -> IrcMsg
cookIrcMsg RawIrcMsg
raw) of
Maybe IrcMsg
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st1
Just IrcMsg
irc ->
do
let st2 :: ClientState
st2 =
case IrcMsg -> Maybe IrcMsg
viewHook IrcMsg
irc of
Maybe IrcMsg
Nothing -> ClientState
st1
Just IrcMsg
irc'
| IrcMsg -> Bool
hideMessage IrcMsg
irc' -> ClientState
st1
| Bool
otherwise -> Text
-> MessageTarget -> ClientMessage -> ClientState -> ClientState
recordIrcMessage Text
network MessageTarget
target ClientMessage
msg ClientState
st1
where
myNick :: Identifier
myNick = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs
target :: MessageTarget
target = Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
myNick IrcMsg
irc
msg :: ClientMessage
msg = ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
time'
, _msgNetwork :: Text
_msgNetwork = Text
network
, _msgBody :: MessageBody
_msgBody = IrcMsg -> MessageBody
IrcBody IrcMsg
irc'
}
let ([RawIrcMsg]
replies, ClientState
st3) =
ZonedTime
-> IrcMsg
-> Text
-> NetworkState
-> ClientState
-> ([RawIrcMsg], ClientState)
applyMessageToClientState ZonedTime
time IrcMsg
irc Text
networkId NetworkState
cs ClientState
st2
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) [RawIrcMsg]
replies
ZonedTime
-> IrcMsg -> NetworkState -> ClientState -> IO ClientState
clientResponse ZonedTime
time' IrcMsg
irc NetworkState
cs ClientState
st3
startTLSLine :: Text -> NetworkState -> ClientState -> RawIrcMsg -> IO ClientState
startTLSLine :: Text -> NetworkState -> ClientState -> RawIrcMsg -> IO ClientState
startTLSLine Text
network NetworkState
cs ClientState
st RawIrcMsg
raw =
do ZonedTime
now <- IO ZonedTime
getZonedTime
let irc :: IrcMsg
irc = RawIrcMsg -> IrcMsg
cookIrcMsg RawIrcMsg
raw
myNick :: Identifier
myNick = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs
target :: MessageTarget
target = Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
myNick IrcMsg
irc
msg :: ClientMessage
msg = ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
now
, _msgNetwork :: Text
_msgNetwork = Text
network
, _msgBody :: MessageBody
_msgBody = IrcMsg -> MessageBody
IrcBody IrcMsg
irc
}
st1 :: ClientState
st1 = Text
-> MessageTarget -> ClientMessage -> ClientState -> ClientState
recordIrcMessage Text
network MessageTarget
target ClientMessage
msg ClientState
st
case IrcMsg
irc of
Notice{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientState
st1
Reply Text
_ ReplyCode
RPL_STARTTLS [Text]
_ ->
do NetworkConnection -> IO ()
upgrade (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s t a b. ASetter s t a b -> b -> s -> t
set ( Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState PingStatus
csPingStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field3 s t a b => Lens s t a b
_3)
ConnectRestriction
WaitTLSRestriction ClientState
st1)
IrcMsg
_ -> ClientState
st1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
StartTLSFailed (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
computeEffectiveTime :: ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime :: ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime ZonedTime
time [TagEntry]
tags = forall a. a -> Maybe a -> a
fromMaybe ZonedTime
time Maybe ZonedTime
zncTime
where
isTimeTag :: TagEntry -> Bool
isTimeTag (TagEntry Text
key Text
_) = Text
key forall a. Eq a => a -> a -> Bool
== Text
"time"
zncTime :: Maybe ZonedTime
zncTime =
do TagEntry Text
_ Text
txt <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TagEntry -> Bool
isTimeTag [TagEntry]
tags
UTCTime
tagTime <- String -> Maybe UTCTime
parseZncTime (Text -> String
Text.unpack Text
txt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> UTCTime -> ZonedTime
utcToZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
time) UTCTime
tagTime)
parseZncTime :: String -> Maybe UTCTime
parseZncTime :: String -> Maybe UTCTime
parseZncTime = forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM forall t. ISO8601 t => Format t
iso8601Format
updateTerminalSize :: Vty -> ClientState -> IO ClientState
updateTerminalSize :: Vty -> ClientState -> IO ClientState
updateTerminalSize Vty
vty ClientState
st =
do (Int
w,Int
h) <- Output -> IO (Int, Int)
displayBounds (Vty -> Output
outputIface Vty
vty)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Int
clientWidth Int
w
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Int
clientHeight Int
h ClientState
st
doVtyEvent ::
Vty ->
Event ->
ClientState ->
IO (Maybe ClientState)
doVtyEvent :: Vty -> Event -> ClientState -> IO (Maybe ClientState)
doVtyEvent Vty
vty Event
vtyEvent ClientState
st =
case Event
vtyEvent of
EvKey Key
k [Modifier]
modifier ->
let cfg :: Configuration
cfg = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Configuration
clientConfig ClientState
st
keymap :: KeyMap
keymap = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration KeyMap
configKeyMap Configuration
cfg
winnames :: Text
winnames = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration Text
configWindowNames Configuration
cfg
winmods :: [Modifier]
winmods = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration [Modifier]
configJumpModifier Configuration
cfg
action :: Action
action = KeyMap -> [Modifier] -> Text -> [Modifier] -> Key -> Action
keyToAction KeyMap
keymap [Modifier]
winmods Text
winnames [Modifier]
modifier Key
k
in Vty -> Action -> ClientState -> IO (Maybe ClientState)
doAction Vty
vty Action
action ClientState
st
EvResize{} -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vty -> ClientState -> IO ClientState
updateTerminalSize Vty
vty ClientState
st
EvPaste ByteString
utf8 ->
do let str :: String
str = Text -> String
Text.unpack (OnDecodeError -> ByteString -> Text
Text.decodeUtf8With OnDecodeError
Text.lenientDecode ByteString
utf8)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState EditBox
clientTextBox (String -> EditBox -> EditBox
Edit.insertPaste String
str) ClientState
st
Event
EvLostFocus ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Bool
clientUiFocused Bool
False ClientState
st)
Event
EvGainedFocus ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Bool
clientUiFocused Bool
True ClientState
st)
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ClientState
st)
doAction ::
Vty ->
Action ->
ClientState ->
IO (Maybe ClientState)
doAction :: Vty -> Action -> ClientState -> IO (Maybe ClientState)
doAction Vty
vty Action
action ClientState
st =
let continue :: ClientState -> m (Maybe ClientState)
continue !ClientState
out
| Action
action forall a. Eq a => a -> a -> Bool
== Action
ActJumpToActivity =
let upd :: Maybe Focus -> Maybe Focus
upd Maybe Focus
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
upd Maybe Focus
x = Maybe Focus
x
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState (Maybe Focus)
clientActivityReturn Maybe Focus -> Maybe Focus
upd ClientState
out
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just
forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Focus)
clientActivityReturn forall a. Maybe a
Nothing ClientState
out
changeEditor :: (EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
f = forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState EditBox
clientTextBox EditBox -> EditBox
f ClientState
st)
changeContent :: (Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
f = forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
Edit.content Content -> Content
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
Edit.lastOperation LastOperation
Edit.OtherOperation
mbChangeEditor :: (EditBox -> Maybe EditBox) -> m (Maybe ClientState)
mbChangeEditor EditBox -> Maybe EditBox
f =
case forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf Lens' ClientState EditBox
clientTextBox EditBox -> Maybe EditBox
f ClientState
st of
Maybe ClientState
Nothing -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue forall a b. (a -> b) -> a -> b
$! forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Bool
clientBell Bool
True ClientState
st
Just ClientState
st' -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st'
in
case Action
action of
Action
ActHome -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.home
Action
ActEnd -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.end
Action
ActLeft -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.left
Action
ActRight -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.right
Action
ActBackWord -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.leftWord
Action
ActForwardWord -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.rightWord
Action
ActKillHome -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.killHome
Action
ActKillEnd -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.killEnd
Action
ActKillWordBack -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((Char -> Bool) -> Bool -> EditBox -> EditBox
Edit.killWordBackward Char -> Bool
isSpace Bool
True)
Action
ActKillWordForward -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((Char -> Bool) -> Bool -> EditBox -> EditBox
Edit.killWordForward Char -> Bool
isSpace Bool
True)
Action
ActYank -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.yank
Action
ActToggle -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.toggle
Action
ActDelete -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.delete
Action
ActBackspace -> forall {m :: * -> *}.
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.backspace
Action
ActBold -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^B')
Action
ActColor -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^C')
Action
ActItalic -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^]')
Action
ActStrikethrough -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^^')
Action
ActUnderline -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^_')
Action
ActClearFormat -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^O')
Action
ActReverseVideo -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^V')
Action
ActMonospace -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^Q')
Action
ActDigraph -> forall {m :: * -> *}.
Monad m =>
(EditBox -> Maybe EditBox) -> m (Maybe ClientState)
mbChangeEditor (Map Digraph Text -> EditBox -> Maybe EditBox
Edit.insertDigraph (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Map Digraph Text)
configDigraphs) ClientState
st))
Action
ActInsertEnter -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^J')
ActJump Char
i -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Char -> ClientState -> ClientState
jumpFocus Char
i ClientState
st)
Action
ActJumpToActivity -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
jumpToActivity ClientState
st)
Action
ActJumpPrevious -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
returnFocus ClientState
st)
Action
ActRetreatFocus -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
retreatFocus ClientState
st)
Action
ActAdvanceFocus -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
advanceFocus ClientState
st)
Action
ActAdvanceNetwork -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
advanceNetworkFocus ClientState
st)
Action
ActReset -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusMessages ClientState
st)
Action
ActOlderLine -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor forall a b. (a -> b) -> a -> b
$ \EditBox
ed -> forall a. a -> Maybe a -> a
fromMaybe EditBox
ed forall a b. (a -> b) -> a -> b
$ EditBox -> Maybe EditBox
Edit.earlier EditBox
ed
Action
ActNewerLine -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor forall a b. (a -> b) -> a -> b
$ \EditBox
ed -> forall a. a -> Maybe a -> a
fromMaybe EditBox
ed forall a b. (a -> b) -> a -> b
$ EditBox -> Maybe EditBox
Edit.later EditBox
ed
Action
ActScrollUp -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient ( ClientState -> Int
scrollAmount ClientState
st) ClientState
st)
Action
ActScrollDown -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient (-ClientState -> Int
scrollAmount ClientState
st) ClientState
st)
Action
ActScrollUpSmall -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient ( Int
3) ClientState
st)
Action
ActScrollDownSmall -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient (-Int
3) ClientState
st)
Action
ActTabCompleteBack -> Bool -> CommandResult -> IO (Maybe ClientState)
doCommandResult Bool
False forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> ClientState -> IO CommandResult
tabCompletion Bool
True ClientState
st
Action
ActTabComplete -> Bool -> CommandResult -> IO (Maybe ClientState)
doCommandResult Bool
False forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> ClientState -> IO CommandResult
tabCompletion Bool
False ClientState
st
ActInsert Char
c -> forall {m :: * -> *}.
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
c)
Action
ActEnter -> if forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientEditLock ClientState
st
then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientBell ClientState
st) (Vty -> IO ()
beep Vty
vty) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st
else Bool -> CommandResult -> IO (Maybe ClientState)
doCommandResult Bool
True forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientState -> IO CommandResult
executeInput ClientState
st
Action
ActRefresh -> Vty -> IO ()
refresh Vty
vty forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st
ActCommand Text
cmd -> do CommandResult
resp <- Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand forall a. Maybe a
Nothing (Text -> String
Text.unpack Text
cmd) ClientState
st
case CommandResult
resp of
CommandSuccess ClientState
st1 -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st1
CommandFailure ClientState
st1 -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st1
CommandQuit ClientState
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Action
ActIgnored -> forall {m :: * -> *}.
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st
doCommandResult ::
Bool ->
CommandResult ->
IO (Maybe ClientState)
doCommandResult :: Bool -> CommandResult -> IO (Maybe ClientState)
doCommandResult Bool
clearOnSuccess CommandResult
res =
let continue :: a -> m (Maybe a)
continue !a
st = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
st) in
case CommandResult
res of
CommandQuit ClientState
st -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ClientState -> IO ()
clientShutdown ClientState
st
CommandSuccess ClientState
st -> forall {m :: * -> *} {a}. Monad m => a -> m (Maybe a)
continue (if Bool
clearOnSuccess then ClientState -> ClientState
consumeInput ClientState
st else ClientState
st)
CommandFailure ClientState
st -> forall {m :: * -> *} {a}. Monad m => a -> m (Maybe a)
continue (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Bool
clientBell Bool
True ClientState
st)
clientShutdown :: ClientState -> IO ()
clientShutdown :: ClientState -> IO ()
clientShutdown ClientState
st = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ClientState -> IO ClientState
clientStopExtensions ClientState
st
executeInput ::
ClientState ->
IO CommandResult
executeInput :: ClientState -> IO CommandResult
executeInput ClientState
st = String -> ClientState -> IO CommandResult
execute (ClientState -> String
clientFirstLine ClientState
st) ClientState
st
doTimerEvent ::
Text ->
TimedAction ->
ClientState ->
IO ClientState
doTimerEvent :: Text -> TimedAction -> ClientState -> IO ClientState
doTimerEvent Text
networkId TimedAction
action =
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf
(forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
networkId)
(TimedAction -> NetworkState -> IO NetworkState
applyTimedAction TimedAction
action)