{-# Language BangPatterns, OverloadedStrings, NondecreasingIndentation #-}
module Client.EventLoop
( eventLoop
, updateTerminalSize
, ClientEvent(..)
) where
import Client.CApi (ThreadEntry, popTimer)
import Client.Commands
import Client.Configuration (configJumpModifier, configKeyMap, configWindowNames, configDigraphs)
import Client.Configuration.ServerSettings
import Client.EventLoop.Actions
import Client.EventLoop.Errors (exceptionToLines)
import Client.EventLoop.Network (clientResponse)
import Client.Hook
import Client.Image
import Client.Image.Layout (scrollAmount)
import Client.Image.StatusLine (clientTitle)
import Client.Log
import Client.Message
import Client.Network.Async
import Client.State
import qualified Client.State.EditBox as Edit
import Client.State.Extensions
import Client.State.Focus
import Client.State.Network
import Control.Concurrent.STM
import Control.Exception
import Control.Lens
import Control.Monad
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Data.Foldable
import Data.Traversable
import Data.List
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe
import Data.Ord
import Data.Text (Text)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import Data.Time
import GHC.IO.Exception (IOErrorType(..), ioe_type)
import Graphics.Vty
import Graphics.Vty.Input.Events
import Irc.Message
import Irc.Codes
import Irc.RawIrcMsg
import LensUtils
import Hookup (ConnectionFailure(..))
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
STM ClientEvent -> IO ClientEvent
forall a. STM a -> IO a
atomically ([STM ClientEvent] -> STM ClientEvent
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 (InternalEvent -> ClientEvent)
-> STM InternalEvent -> STM ClientEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TChan InternalEvent -> STM InternalEvent
forall a. TChan a -> STM a
readTChan (Input -> TChan InternalEvent
_eventChannel (Vty -> Input
inputIface Vty
vty))
networkEvents :: STM ClientEvent
networkEvents =
do [[(Text, NetworkEvent)]]
xs <- [(Text, NetworkState)]
-> ((Text, NetworkState) -> STM [(Text, NetworkEvent)])
-> STM [[(Text, NetworkEvent)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap Text NetworkState -> [(Text, NetworkState)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (Getting
(HashMap Text NetworkState) ClientState (HashMap Text NetworkState)
-> ClientState -> HashMap Text NetworkState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(HashMap Text NetworkState) ClientState (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections ClientState
st)) (((Text, NetworkState) -> STM [(Text, NetworkEvent)])
-> STM [[(Text, NetworkEvent)]])
-> ((Text, NetworkState) -> STM [(Text, NetworkEvent)])
-> STM [[(Text, NetworkEvent)]]
forall a b. (a -> b) -> a -> b
$ \(Text
network, NetworkState
conn) ->
do [NetworkEvent]
ys <- NetworkConnection -> STM [NetworkEvent]
recv (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
conn)
[(Text, NetworkEvent)] -> STM [(Text, NetworkEvent)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((NetworkEvent -> (Text, NetworkEvent))
-> [NetworkEvent] -> [(Text, NetworkEvent)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Text
network) [NetworkEvent]
ys)
case [(Text, NetworkEvent)] -> Maybe (NonEmpty (Text, NetworkEvent))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([[(Text, NetworkEvent)]] -> [(Text, NetworkEvent)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Text, NetworkEvent)]]
xs) of
Just NonEmpty (Text, NetworkEvent)
events1 -> ClientEvent -> STM ClientEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Text, NetworkEvent) -> ClientEvent
NetworkEvents NonEmpty (Text, NetworkEvent)
events1)
Maybe (NonEmpty (Text, NetworkEvent))
Nothing -> STM ClientEvent
forall a. STM a
retry
prepareTimer :: IO (STM ClientEvent)
prepareTimer =
case ClientState -> Maybe (UTCTime, ClientEvent)
earliestEvent ClientState
st of
Maybe (UTCTime, ClientEvent)
Nothing -> STM ClientEvent -> IO (STM ClientEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return STM ClientEvent
forall a. STM a
retry
Just (UTCTime
runAt,ClientEvent
event) ->
do UTCTime
now <- IO UTCTime
getCurrentTime
let microsecs :: Int
microsecs = NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime
1000000 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
runAt UTCTime
now)
TVar Bool
var <- Int -> IO (TVar Bool)
registerDelay (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
microsecs)
STM ClientEvent -> IO (STM ClientEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (STM ClientEvent -> IO (STM ClientEvent))
-> STM ClientEvent -> IO (STM ClientEvent)
forall a b. (a -> b) -> a -> b
$ do Bool
ready <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
var
Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ready STM ()
forall a. STM a
retry
ClientEvent -> STM ClientEvent
forall (m :: * -> *) a. Monad m => a -> m a
return ClientEvent
event
threadJoin :: STM ClientEvent
threadJoin =
do (Int
i,ThreadEntry
r) <- TQueue (Int, ThreadEntry) -> STM (Int, ThreadEntry)
forall a. TQueue a -> STM a
readTQueue (Getting
(TQueue (Int, ThreadEntry)) ClientState (TQueue (Int, ThreadEntry))
-> ClientState -> TQueue (Int, ThreadEntry)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(TQueue (Int, ThreadEntry)) ClientState (TQueue (Int, ThreadEntry))
Lens' ClientState (TQueue (Int, ThreadEntry))
clientThreadJoins ClientState
st)
ClientEvent -> STM ClientEvent
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 = Maybe (UTCTime, ClientEvent)
-> Maybe (UTCTime, ClientEvent) -> Maybe (UTCTime, ClientEvent)
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
time2 = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
time1, b
action1)
| Bool
otherwise = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
time2, b
action2)
earliest2 Maybe (a, b)
x Maybe (a, b)
y = Maybe (a, b) -> Maybe (a, b) -> Maybe (a, b)
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 =
Getting
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
ClientState
(UTCTime, ClientEvent)
-> ((UTCTime, ClientEvent) -> (UTCTime, ClientEvent) -> Ordering)
-> ClientState
-> Maybe (UTCTime, ClientEvent)
forall a s.
Getting (Endo (Endo (Maybe a))) s a
-> (a -> a -> Ordering) -> s -> Maybe a
minimumByOf
((HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState))
-> ClientState
-> Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState))
-> ClientState
-> Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) ClientState)
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState))
-> Getting
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
ClientState
(UTCTime, ClientEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Indexed
Text
NetworkState
(Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) NetworkState)
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState)
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded (Indexed
Text
NetworkState
(Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) NetworkState)
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState))
-> (((UTCTime, TimedAction)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction))
-> NetworkState
-> Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) NetworkState)
-> Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction))
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState)
forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. (NetworkState -> Maybe (UTCTime, TimedAction))
-> Fold NetworkState (UTCTime, TimedAction)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding NetworkState -> Maybe (UTCTime, TimedAction)
nextTimedAction) (Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction))
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState))
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction)))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> HashMap Text NetworkState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(HashMap Text NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, (UTCTime, TimedAction))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Text, (UTCTime, TimedAction)))
-> Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction))
forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex (((Text, (UTCTime, TimedAction))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Text, (UTCTime, TimedAction)))
-> Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction)))
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> (Text, (UTCTime, TimedAction))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Text, (UTCTime, TimedAction)))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> Indexed
Text
(UTCTime, TimedAction)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimedAction))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, (UTCTime, TimedAction)) -> (UTCTime, ClientEvent))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> (Text, (UTCTime, TimedAction))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Text, (UTCTime, TimedAction))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text, (UTCTime, TimedAction)) -> (UTCTime, ClientEvent)
forall a. (Text, (a, TimedAction)) -> (a, ClientEvent)
mkEventN)
(((UTCTime, ClientEvent) -> UTCTime)
-> (UTCTime, ClientEvent) -> (UTCTime, ClientEvent) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UTCTime, ClientEvent) -> UTCTime
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 =
Getting
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
ClientState
(UTCTime, ClientEvent)
-> ((UTCTime, ClientEvent) -> (UTCTime, ClientEvent) -> Ordering)
-> ClientState
-> Maybe (UTCTime, ClientEvent)
forall a s.
Getting (Endo (Endo (Maybe a))) s a
-> (a -> a -> Ordering) -> s -> Maybe a
minimumByOf
((ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState)
-> ClientState
-> Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) ClientState
Lens' ClientState ExtensionState
clientExtensions ((ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState)
-> ClientState
-> Const (Endo (Endo (Maybe (UTCTime, ClientEvent)))) ClientState)
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState)
-> Getting
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
ClientState
(UTCTime, ClientEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension))
-> ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState
Lens' ExtensionState (IntMap ActiveExtension)
esActive ((IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension))
-> ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState)
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> ExtensionState
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ExtensionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Indexed
Int
ActiveExtension
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ActiveExtension)
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension)
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded (Indexed
Int
ActiveExtension
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ActiveExtension)
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension))
-> (((UTCTime, TimerId, FunPtr TimerCallback, Ptr (),
ActiveExtension)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent)))) ActiveExtension)
-> Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension)
forall i (p :: * -> * -> *) s t r a b.
Indexable i p =>
(Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r
<. (ActiveExtension
-> Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> Fold
ActiveExtension
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ActiveExtension
-> Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
popTimer) (Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension))
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> IntMap ActiveExtension
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(IntMap ActiveExtension)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)))
-> Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex (((Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)))
-> Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)))
-> (((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> (Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> Indexed
Int
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
(Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> (UTCTime, ClientEvent))
-> ((UTCTime, ClientEvent)
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(UTCTime, ClientEvent))
-> (Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> Const
(Endo (Endo (Maybe (UTCTime, ClientEvent))))
(Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Int,
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension))
-> (UTCTime, ClientEvent)
forall a b c d e. (Int, (a, b, c, d, e)) -> (a, ClientEvent)
mkEventE)
(((UTCTime, ClientEvent) -> UTCTime)
-> (UTCTime, ClientEvent) -> (UTCTime, ClientEvent) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UTCTime, ClientEvent) -> UTCTime
forall a b. (a, b) -> a
fst)
ClientState
st
eventLoop :: Vty -> ClientState -> IO ()
eventLoop :: Vty -> ClientState -> IO ()
eventLoop Vty
vty ClientState
st =
do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientBell ClientState
st) (Vty -> IO ()
beep Vty
vty)
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 (ClientState -> IO ()) -> IO ClientState -> IO ()
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 (ClientState -> IO ()) -> IO ClientState -> IO ()
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 (ClientState -> IO ()) -> IO ClientState -> IO ()
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) ->
(ClientState -> IO ()) -> Maybe ClientState -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Vty -> ClientState -> IO ()
eventLoop Vty
vty) (Maybe ClientState -> IO ()) -> IO (Maybe ClientState) -> IO ()
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
ResumeAfterSignal ->
Vty -> ClientState -> IO ()
eventLoop Vty
vty (ClientState -> IO ()) -> IO ClientState -> IO ()
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 (ClientState -> IO ()) -> IO ClientState -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ClientState -> (Text, NetworkEvent) -> IO ClientState)
-> ClientState -> NonEmpty (Text, NetworkEvent) -> IO ClientState
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 (Output -> IO ()) -> (Vty -> Output) -> Vty -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vty -> Output
outputIface
processLogEntries :: ClientState -> IO ()
processLogEntries :: ClientState -> IO ()
processLogEntries =
(LogLine -> IO ()) -> [LogLine] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ LogLine -> IO ()
writeLogLine ([LogLine] -> IO ())
-> (ClientState -> [LogLine]) -> ClientState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LogLine] -> [LogLine]
forall a. [a] -> [a]
reverse ([LogLine] -> [LogLine])
-> (ClientState -> [LogLine]) -> ClientState -> [LogLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [LogLine] ClientState [LogLine] -> ClientState -> [LogLine]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [LogLine] ClientState [LogLine]
Lens' ClientState [LogLine]
clientLogQueue
doNetworkOpen ::
Text ->
ZonedTime ->
ClientState ->
IO ClientState
doNetworkOpen :: Text -> ZonedTime -> ClientState -> IO ClientState
doNetworkOpen Text
networkId ZonedTime
time ClientState
st =
case Getting (Maybe NetworkState) ClientState (Maybe NetworkState)
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> ClientState -> Const (Maybe NetworkState) ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> ClientState -> Const (Maybe NetworkState) ClientState)
-> ((Maybe NetworkState
-> Const (Maybe NetworkState) (Maybe NetworkState))
-> HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> Getting (Maybe NetworkState) ClientState (Maybe NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Lens'
(HashMap Text NetworkState)
(Maybe (IxValue (HashMap Text NetworkState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text NetworkState)
networkId) ClientState
st of
Maybe NetworkState
Nothing -> String -> IO ClientState
forall a. HasCallStack => String -> a
error String
"doNetworkOpen: Network missing"
Just NetworkState
cs ->
do let msg :: ClientMessage
msg = ClientMessage :: Text -> MessageBody -> ZonedTime -> ClientMessage
ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
time
, _msgNetwork :: Text
_msgNetwork = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
, _msgBody :: MessageBody
_msgBody = Text -> MessageBody
NormalBody Text
"connection opened"
}
let cs' :: NetworkState
cs' = NetworkState
cs NetworkState -> (NetworkState -> NetworkState) -> NetworkState
forall a b. a -> (a -> b) -> b
& (Maybe UTCTime -> Identity (Maybe UTCTime))
-> NetworkState -> Identity NetworkState
Lens' NetworkState (Maybe UTCTime)
csLastReceived ((Maybe UTCTime -> Identity (Maybe UTCTime))
-> NetworkState -> Identity NetworkState)
-> Maybe UTCTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$! ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
time)
ClientState -> IO ClientState
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg
(ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState NetworkState NetworkState
-> NetworkState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
setStrict ((HashMap Text NetworkState -> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState)
-> ((NetworkState -> Identity NetworkState)
-> HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ASetter ClientState ClientState NetworkState NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Traversal'
(HashMap Text NetworkState) (IxValue (HashMap Text NetworkState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text NetworkState)
networkId) NetworkState
cs' ClientState
st
doNetworkTLS ::
Text ->
[Text] ->
ClientState ->
IO ClientState
doNetworkTLS :: Text -> [Text] -> ClientState -> IO ClientState
doNetworkTLS Text
network [Text]
cert ClientState
st =
ClientState -> IO ClientState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState NetworkState NetworkState
-> (NetworkState -> NetworkState) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((HashMap Text NetworkState -> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState)
-> ((NetworkState -> Identity NetworkState)
-> HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ASetter ClientState ClientState NetworkState NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Traversal'
(HashMap Text NetworkState) (IxValue (HashMap Text NetworkState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text NetworkState)
network) NetworkState -> NetworkState
upd ClientState
st
where
upd :: NetworkState -> NetworkState
upd = ASetter NetworkState NetworkState [Text] [Text]
-> [Text] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState [Text] [Text]
Lens' NetworkState [Text]
csCertificate [Text]
cert
(NetworkState -> NetworkState)
-> (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
NetworkState NetworkState ConnectRestriction ConnectRestriction
-> ConnectRestriction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PingStatus -> Identity PingStatus)
-> NetworkState -> Identity NetworkState
Lens' NetworkState PingStatus
csPingStatus ((PingStatus -> Identity PingStatus)
-> NetworkState -> Identity NetworkState)
-> ((ConnectRestriction -> Identity ConnectRestriction)
-> PingStatus -> Identity PingStatus)
-> ASetter
NetworkState NetworkState ConnectRestriction ConnectRestriction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> PingStatus -> Identity PingStatus
Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting (((Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> PingStatus -> Identity PingStatus)
-> ((ConnectRestriction -> Identity ConnectRestriction)
-> (Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> (ConnectRestriction -> Identity ConnectRestriction)
-> PingStatus
-> Identity PingStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectRestriction -> Identity ConnectRestriction)
-> (Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction)
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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
ClientMessage
{ _msgTime :: ZonedTime
_msgTime = ZonedTime
time
, _msgNetwork :: Text
_msgNetwork = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
, _msgBody :: MessageBody
_msgBody = Text -> MessageBody
NormalBody Text
"connection closed"
}
ClientState -> IO ClientState
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 = (ClientState -> String -> ClientState)
-> ClientState -> NonEmpty String -> ClientState
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 (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) (String -> Text
Text.pack String
msg) ClientState
acc) ClientState
st1
(NonEmpty String -> ClientState) -> NonEmpty String -> ClientState
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 Maybe Int
forall a. Maybe a
Nothing (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) ClientState
st
| Bool
otherwise = ClientState -> IO ClientState
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st
where
computeRetryInfo :: IO (Int, Maybe UTCTime)
computeRetryInfo =
case Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
PingConnecting Int
n Maybe UTCTime
tm ConnectRestriction
_ -> (Int, Maybe UTCTime) -> IO (Int, Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Maybe UTCTime
tm)
PingStatus
_ | Just UTCTime
tm <- Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
-> NetworkState -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csLastReceived NetworkState
cs -> (Int, Maybe UTCTime) -> IO (Int, Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tm)
| Bool
otherwise -> do UTCTime
now <- IO UTCTime
getCurrentTime
(Int, Maybe UTCTime) -> IO (Int, Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now)
reconnectAttempts :: Int
reconnectAttempts = Getting Int NetworkState Int -> NetworkState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const Int ServerSettings)
-> NetworkState -> Const Int NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const Int ServerSettings)
-> NetworkState -> Const Int NetworkState)
-> ((Int -> Const Int Int)
-> ServerSettings -> Const Int ServerSettings)
-> Getting Int NetworkState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> ServerSettings -> Const Int ServerSettings
Lens' ServerSettings Int
ssReconnectAttempts) NetworkState
cs
shouldReconnect :: Bool
shouldReconnect =
case Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
PingConnecting Int
n Maybe UTCTime
_ ConnectRestriction
_ | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
reconnectAttempts -> Bool
False
PingStatus
_ | Just ConnectionFailure{} <- SomeException -> Maybe ConnectionFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just HostnameResolutionFailure{} <- SomeException -> Maybe ConnectionFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just TerminationReason
PingTimeout <- SomeException -> Maybe TerminationReason
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just IOErrorType
ResourceVanished <- IOException -> IOErrorType
ioe_type (IOException -> IOErrorType)
-> Maybe IOException -> Maybe IOErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex -> Bool
True
| Just IOErrorType
NoSuchThing <- IOException -> IOErrorType
ioe_type (IOException -> IOErrorType)
-> Maybe IOException -> Maybe IOErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe IOException
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 Getting (Maybe NetworkState) ClientState (Maybe NetworkState)
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> ClientState -> Const (Maybe NetworkState) ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> ClientState -> Const (Maybe NetworkState) ClientState)
-> ((Maybe NetworkState
-> Const (Maybe NetworkState) (Maybe NetworkState))
-> HashMap Text NetworkState
-> Const (Maybe NetworkState) (HashMap Text NetworkState))
-> Getting (Maybe NetworkState) ClientState (Maybe NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Lens'
(HashMap Text NetworkState)
(Maybe (IxValue (HashMap Text NetworkState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text NetworkState)
networkId) ClientState
st of
Maybe NetworkState
Nothing -> String -> IO ClientState
forall a. HasCallStack => String -> a
error String
"doNetworkLine: Network missing"
Just NetworkState
cs ->
let network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
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 <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs ->
ClientState
st ClientState -> IO () -> IO ClientState
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
StartTLSFailed (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
Just RawIrcMsg
raw
| PingConnecting Int
_ Maybe UTCTime
_ ConnectRestriction
StartTLSRestriction <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
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: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
line)
ClientState -> IO ClientState
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
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 ClientState -> IO ClientState
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st1 else do
let time' :: ZonedTime
time' = ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime ZonedTime
time (Getting [TagEntry] RawIrcMsg [TagEntry] -> RawIrcMsg -> [TagEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TagEntry] RawIrcMsg [TagEntry]
forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags RawIrcMsg
raw)
(IrcMsg -> Maybe IrcMsg
stateHook, IrcMsg -> Maybe IrcMsg
viewHook)
= ASetter
([MessageHook], [MessageHook])
(IrcMsg -> Maybe IrcMsg, IrcMsg -> Maybe IrcMsg)
[MessageHook]
(IrcMsg -> Maybe IrcMsg)
-> ([MessageHook] -> IrcMsg -> Maybe IrcMsg)
-> ([MessageHook], [MessageHook])
-> (IrcMsg -> Maybe IrcMsg, IrcMsg -> Maybe IrcMsg)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
([MessageHook], [MessageHook])
(IrcMsg -> Maybe IrcMsg, IrcMsg -> Maybe IrcMsg)
[MessageHook]
(IrcMsg -> Maybe IrcMsg)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both [MessageHook] -> IrcMsg -> Maybe IrcMsg
applyMessageHooks
(([MessageHook], [MessageHook])
-> (IrcMsg -> Maybe IrcMsg, IrcMsg -> Maybe IrcMsg))
-> ([MessageHook], [MessageHook])
-> (IrcMsg -> Maybe IrcMsg, IrcMsg -> Maybe IrcMsg)
forall a b. (a -> b) -> a -> b
$ (MessageHook -> Bool)
-> [MessageHook] -> ([MessageHook], [MessageHook])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Getting Bool MessageHook Bool -> MessageHook -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool MessageHook Bool
Lens' MessageHook Bool
messageHookStateful)
([MessageHook] -> ([MessageHook], [MessageHook]))
-> [MessageHook] -> ([MessageHook], [MessageHook])
forall a b. (a -> b) -> a -> b
$ Getting [MessageHook] NetworkState [MessageHook]
-> NetworkState -> [MessageHook]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [MessageHook] NetworkState [MessageHook]
Lens' NetworkState [MessageHook]
csMessageHooks NetworkState
cs
case IrcMsg -> Maybe IrcMsg
stateHook (RawIrcMsg -> IrcMsg
cookIrcMsg RawIrcMsg
raw) of
Maybe IrcMsg
Nothing -> ClientState -> IO ClientState
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 = Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs
target :: MessageTarget
target = Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
myNick IrcMsg
irc
msg :: ClientMessage
msg = ClientMessage :: Text -> MessageBody -> ZonedTime -> ClientMessage
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
(RawIrcMsg -> IO ()) -> [RawIrcMsg] -> IO ()
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 = Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs
target :: MessageTarget
target = Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
myNick IrcMsg
irc
msg :: ClientMessage
msg = ClientMessage :: Text -> MessageBody -> ZonedTime -> ClientMessage
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{} -> ClientState -> IO ClientState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientState
st1
Reply Text
_ ReplyCode
RPL_STARTTLS [Text]
_ ->
do NetworkConnection -> IO ()
upgrade (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
ClientState -> IO ClientState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASetter
ClientState ClientState ConnectRestriction ConnectRestriction
-> ConnectRestriction -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ( (HashMap Text NetworkState -> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ClientState -> Identity ClientState)
-> ((ConnectRestriction -> Identity ConnectRestriction)
-> HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ASetter
ClientState ClientState ConnectRestriction ConnectRestriction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Traversal'
(HashMap Text NetworkState) (IxValue (HashMap Text NetworkState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text NetworkState)
network ((NetworkState -> Identity NetworkState)
-> HashMap Text NetworkState
-> Identity (HashMap Text NetworkState))
-> ASetter
NetworkState NetworkState ConnectRestriction ConnectRestriction
-> (ConnectRestriction -> Identity ConnectRestriction)
-> HashMap Text NetworkState
-> Identity (HashMap Text NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PingStatus -> Identity PingStatus)
-> NetworkState -> Identity NetworkState
Lens' NetworkState PingStatus
csPingStatus
((PingStatus -> Identity PingStatus)
-> NetworkState -> Identity NetworkState)
-> ((ConnectRestriction -> Identity ConnectRestriction)
-> PingStatus -> Identity PingStatus)
-> ASetter
NetworkState NetworkState ConnectRestriction ConnectRestriction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> PingStatus -> Identity PingStatus
Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting (((Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> PingStatus -> Identity PingStatus)
-> ((ConnectRestriction -> Identity ConnectRestriction)
-> (Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction))
-> (ConnectRestriction -> Identity ConnectRestriction)
-> PingStatus
-> Identity PingStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectRestriction -> Identity ConnectRestriction)
-> (Int, Maybe UTCTime, ConnectRestriction)
-> Identity (Int, Maybe UTCTime, ConnectRestriction)
forall s t a b. Field3 s t a b => Lens s t a b
_3)
ConnectRestriction
WaitTLSRestriction ClientState
st1)
IrcMsg
_ -> ClientState
st1 ClientState -> IO () -> IO ClientState
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
StartTLSFailed (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
computeEffectiveTime :: ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime :: ZonedTime -> [TagEntry] -> ZonedTime
computeEffectiveTime ZonedTime
time [TagEntry]
tags = ZonedTime -> Maybe ZonedTime -> ZonedTime
forall a. a -> Maybe a -> a
fromMaybe ZonedTime
time Maybe ZonedTime
zncTime
where
isTimeTag :: TagEntry -> Bool
isTimeTag (TagEntry Text
key Text
_) = Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"time"
zncTime :: Maybe ZonedTime
zncTime =
do TagEntry Text
_ Text
txt <- (TagEntry -> Bool) -> [TagEntry] -> Maybe TagEntry
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)
ZonedTime -> Maybe ZonedTime
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 = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
(String -> String -> Maybe UTCTime)
-> String -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%T%Q%Z")
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)
ClientState -> IO ClientState
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState Int Int
-> Int -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Int Int
Lens' ClientState Int
clientWidth Int
w
(ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState Int Int
-> Int -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Int Int
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 = Getting Configuration ClientState Configuration
-> ClientState -> Configuration
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Configuration ClientState Configuration
Lens' ClientState Configuration
clientConfig ClientState
st
keymap :: KeyMap
keymap = Getting KeyMap Configuration KeyMap -> Configuration -> KeyMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting KeyMap Configuration KeyMap
Lens' Configuration KeyMap
configKeyMap Configuration
cfg
winnames :: Text
winnames = Getting Text Configuration Text -> Configuration -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Configuration Text
Lens' Configuration Text
configWindowNames Configuration
cfg
winmods :: [Modifier]
winmods = Getting [Modifier] Configuration [Modifier]
-> Configuration -> [Modifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Modifier] Configuration [Modifier]
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{} -> ClientState -> Maybe ClientState
forall a. a -> Maybe a
Just (ClientState -> Maybe ClientState)
-> IO ClientState -> IO (Maybe ClientState)
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)
Maybe ClientState -> IO (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ClientState -> IO (Maybe ClientState))
-> Maybe ClientState -> IO (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$! ClientState -> Maybe ClientState
forall a. a -> Maybe a
Just (ClientState -> Maybe ClientState)
-> ClientState -> Maybe ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState EditBox EditBox
-> (EditBox -> EditBox) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState EditBox EditBox
Lens' ClientState EditBox
clientTextBox (String -> EditBox -> EditBox
Edit.insertPaste String
str) ClientState
st
Event
_ -> Maybe ClientState -> IO (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> Maybe ClientState
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 Action -> Action -> Bool
forall a. Eq a => a -> a -> Bool
== Action
ActJumpToActivity =
let upd :: Maybe Focus -> Maybe Focus
upd Maybe Focus
Nothing = Focus -> Maybe Focus
forall a. a -> Maybe a
Just (Focus -> Maybe Focus) -> Focus -> Maybe Focus
forall a b. (a -> b) -> a -> b
$! Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st
upd Maybe Focus
x = Maybe Focus
x
in Maybe ClientState -> m (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ClientState -> m (Maybe ClientState))
-> Maybe ClientState -> m (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$! ClientState -> Maybe ClientState
forall a. a -> Maybe a
Just (ClientState -> Maybe ClientState)
-> ClientState -> Maybe ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState (Maybe Focus) (Maybe Focus)
-> (Maybe Focus -> Maybe Focus) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState (Maybe Focus) (Maybe Focus)
Lens' ClientState (Maybe Focus)
clientActivityReturn Maybe Focus -> Maybe Focus
upd ClientState
out
| Bool
otherwise = Maybe ClientState -> m (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ClientState -> m (Maybe ClientState))
-> Maybe ClientState -> m (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$! ClientState -> Maybe ClientState
forall a. a -> Maybe a
Just
(ClientState -> Maybe ClientState)
-> ClientState -> Maybe ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState (Maybe Focus) (Maybe Focus)
-> Maybe Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Focus) (Maybe Focus)
Lens' ClientState (Maybe Focus)
clientActivityReturn Maybe Focus
forall a. Maybe a
Nothing ClientState
out
changeEditor :: (EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
f = ClientState -> m (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ASetter ClientState ClientState EditBox EditBox
-> (EditBox -> EditBox) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState EditBox EditBox
Lens' ClientState EditBox
clientTextBox EditBox -> EditBox
f ClientState
st)
changeContent :: (Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
f = (EditBox -> EditBox) -> m (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor
((EditBox -> EditBox) -> m (Maybe ClientState))
-> (EditBox -> EditBox) -> m (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
Edit.content Content -> Content
f
(EditBox -> EditBox) -> (EditBox -> EditBox) -> EditBox -> EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
Edit.lastOperation LastOperation
Edit.OtherOperation
mbChangeEditor :: (EditBox -> Maybe EditBox) -> m (Maybe ClientState)
mbChangeEditor EditBox -> Maybe EditBox
f =
case LensLike Maybe ClientState ClientState EditBox EditBox
-> LensLike Maybe ClientState ClientState EditBox EditBox
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike Maybe ClientState ClientState EditBox EditBox
Lens' ClientState EditBox
clientTextBox EditBox -> Maybe EditBox
f ClientState
st of
Maybe ClientState
Nothing -> ClientState -> m (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> m (Maybe ClientState))
-> ClientState -> m (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState Bool Bool
-> Bool -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Bool Bool
Lens' ClientState Bool
clientBell Bool
True ClientState
st
Just ClientState
st' -> ClientState -> m (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st'
in
case Action
action of
Action
ActHome -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.home
Action
ActEnd -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.end
Action
ActLeft -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.left
Action
ActRight -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.right
Action
ActBackWord -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.leftWord
Action
ActForwardWord -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.rightWord
Action
ActKillHome -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.killHome
Action
ActKillEnd -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.killEnd
Action
ActKillWordBack -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((Char -> Bool) -> Bool -> EditBox -> EditBox
Edit.killWordBackward Char -> Bool
isSpace Bool
True)
Action
ActKillWordForward -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((Char -> Bool) -> Bool -> EditBox -> EditBox
Edit.killWordForward Char -> Bool
isSpace Bool
True)
Action
ActYank -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor EditBox -> EditBox
Edit.yank
Action
ActToggle -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.toggle
Action
ActDelete -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.delete
Action
ActBackspace -> (Content -> Content) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(Content -> Content) -> m (Maybe ClientState)
changeContent Content -> Content
Edit.backspace
Action
ActBold -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^B')
Action
ActColor -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^C')
Action
ActItalic -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^]')
Action
ActStrikethrough -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^^')
Action
ActUnderline -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^_')
Action
ActClearFormat -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^O')
Action
ActReverseVideo -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^V')
Action
ActMonospace -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^Q')
Action
ActDigraph -> (EditBox -> Maybe EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> Maybe EditBox) -> m (Maybe ClientState)
mbChangeEditor (Map Digraph Text -> EditBox -> Maybe EditBox
Edit.insertDigraph (Getting (Map Digraph Text) ClientState (Map Digraph Text)
-> ClientState -> Map Digraph Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const (Map Digraph Text) Configuration)
-> ClientState -> Const (Map Digraph Text) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Map Digraph Text) Configuration)
-> ClientState -> Const (Map Digraph Text) ClientState)
-> ((Map Digraph Text
-> Const (Map Digraph Text) (Map Digraph Text))
-> Configuration -> Const (Map Digraph Text) Configuration)
-> Getting (Map Digraph Text) ClientState (Map Digraph Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Digraph Text -> Const (Map Digraph Text) (Map Digraph Text))
-> Configuration -> Const (Map Digraph Text) Configuration
Lens' Configuration (Map Digraph Text)
configDigraphs) ClientState
st))
Action
ActInsertEnter -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
'\^J')
ActJump Char
i -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Char -> ClientState -> ClientState
jumpFocus Char
i ClientState
st)
Action
ActJumpToActivity -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
jumpToActivity ClientState
st)
Action
ActJumpPrevious -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
returnFocus ClientState
st)
Action
ActRetreatFocus -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
retreatFocus ClientState
st)
Action
ActAdvanceFocus -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
advanceFocus ClientState
st)
Action
ActAdvanceNetwork -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (ClientState -> ClientState
advanceNetworkFocus ClientState
st)
Action
ActReset -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusMessages ClientState
st)
Action
ActOlderLine -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((EditBox -> EditBox) -> IO (Maybe ClientState))
-> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$ \EditBox
ed -> EditBox -> Maybe EditBox -> EditBox
forall a. a -> Maybe a -> a
fromMaybe EditBox
ed (Maybe EditBox -> EditBox) -> Maybe EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ EditBox -> Maybe EditBox
Edit.earlier EditBox
ed
Action
ActNewerLine -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor ((EditBox -> EditBox) -> IO (Maybe ClientState))
-> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall a b. (a -> b) -> a -> b
$ \EditBox
ed -> EditBox -> Maybe EditBox -> EditBox
forall a. a -> Maybe a -> a
fromMaybe EditBox
ed (Maybe EditBox -> EditBox) -> Maybe EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ EditBox -> Maybe EditBox
Edit.later EditBox
ed
Action
ActScrollUp -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient ( ClientState -> Int
scrollAmount ClientState
st) ClientState
st)
Action
ActScrollDown -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient (-ClientState -> Int
scrollAmount ClientState
st) ClientState
st)
Action
ActScrollUpSmall -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue (Int -> ClientState -> ClientState
scrollClient ( Int
3) ClientState
st)
Action
ActScrollDownSmall -> ClientState -> IO (Maybe ClientState)
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 (CommandResult -> IO (Maybe ClientState))
-> IO CommandResult -> IO (Maybe ClientState)
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 (CommandResult -> IO (Maybe ClientState))
-> IO CommandResult -> IO (Maybe ClientState)
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 -> (EditBox -> EditBox) -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
(EditBox -> EditBox) -> m (Maybe ClientState)
changeEditor (Char -> EditBox -> EditBox
Edit.insert Char
c)
Action
ActEnter -> if Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientEditLock ClientState
st
then Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientBell ClientState
st) (Vty -> IO ()
beep Vty
vty) IO () -> IO (Maybe ClientState) -> IO (Maybe ClientState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st
else Bool -> CommandResult -> IO (Maybe ClientState)
doCommandResult Bool
True (CommandResult -> IO (Maybe ClientState))
-> IO CommandResult -> IO (Maybe ClientState)
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 IO () -> IO (Maybe ClientState) -> IO (Maybe ClientState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st
ActCommand Text
cmd -> do CommandResult
resp <- Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand Maybe Text
forall a. Maybe a
Nothing (Text -> String
Text.unpack Text
cmd) ClientState
st
case CommandResult
resp of
CommandSuccess ClientState
st1 -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st1
CommandFailure ClientState
st1 -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *).
Monad m =>
ClientState -> m (Maybe ClientState)
continue ClientState
st1
CommandQuit ClientState
_ -> Maybe ClientState -> IO (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ClientState
forall a. Maybe a
Nothing
Action
ActIgnored -> ClientState -> IO (Maybe ClientState)
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 = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
st) in
case CommandResult
res of
CommandQuit ClientState
st -> Maybe ClientState
forall a. Maybe a
Nothing Maybe ClientState -> IO () -> IO (Maybe ClientState)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ClientState -> IO ()
clientShutdown ClientState
st
CommandSuccess ClientState
st -> ClientState -> IO (Maybe ClientState)
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 -> ClientState -> IO (Maybe ClientState)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
continue (ASetter ClientState ClientState Bool Bool
-> Bool -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Bool Bool
Lens' ClientState Bool
clientBell Bool
True ClientState
st)
clientShutdown :: ClientState -> IO ()
clientShutdown :: ClientState -> IO ()
clientShutdown ClientState
st = () () -> IO ClientState -> IO ()
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 =
LensLike IO ClientState ClientState NetworkState NetworkState
-> LensLike IO ClientState ClientState NetworkState NetworkState
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf
(Text
-> LensLike IO ClientState ClientState NetworkState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
networkId)
(TimedAction -> NetworkState -> IO NetworkState
applyTimedAction TimedAction
action)