Copyright | (c) Eric Mertens, 2016 |
---|---|
License | ISC |
Maintainer | emertens@gmail.com |
Safe Haskell | None |
Language | Haskell2010 |
This module provides the core logic of the IRC client. The client state tracks everything about the client.
- data ClientState = ClientState {
- _clientWindows :: !(Map Focus Window)
- _clientPrevFocus :: !Focus
- _clientFocus :: !Focus
- _clientSubfocus :: !Subfocus
- _clientExtraFocus :: ![Focus]
- _clientConnections :: !(IntMap NetworkState)
- _clientNextConnectionId :: !Int
- _clientConnectionContext :: !ConnectionContext
- _clientEvents :: !(TQueue NetworkEvent)
- _clientNetworkMap :: !(HashMap Text NetworkId)
- _clientConfig :: !Configuration
- _clientVty :: !Vty
- _clientTextBox :: !EditBox
- _clientWidth :: !Int
- _clientHeight :: !Int
- _clientScroll :: !Int
- _clientDetailView :: !Bool
- _clientActivityBar :: !Bool
- _clientShowMetadata :: !Bool
- _clientRegex :: Maybe Regex
- _clientBell :: !Bool
- _clientIgnores :: !(HashSet Identifier)
- _clientExtensions :: !ExtensionState
- clientWindows :: Lens' ClientState (Map Focus Window)
- clientTextBox :: Lens' ClientState EditBox
- clientConnections :: Lens' ClientState (IntMap NetworkState)
- clientWidth :: Lens' ClientState Int
- clientHeight :: Lens' ClientState Int
- clientEvents :: Lens' ClientState (TQueue NetworkEvent)
- clientVty :: Lens' ClientState Vty
- clientFocus :: Lens' ClientState Focus
- clientExtraFocus :: Lens' ClientState [Focus]
- clientConnectionContext :: Lens' ClientState ConnectionContext
- clientConfig :: Lens' ClientState Configuration
- clientScroll :: Lens' ClientState Int
- clientDetailView :: Lens' ClientState Bool
- clientActivityBar :: Lens' ClientState Bool
- clientShowMetadata :: Lens' ClientState Bool
- clientSubfocus :: Lens' ClientState Subfocus
- clientNextConnectionId :: Lens' ClientState Int
- clientNetworkMap :: Lens' ClientState (HashMap Text NetworkId)
- clientIgnores :: Lens' ClientState (HashSet Identifier)
- clientConnection :: Applicative f => Text -> LensLike' f ClientState NetworkState
- clientBell :: Lens' ClientState Bool
- clientExtensions :: Lens' ClientState ExtensionState
- clientRegex :: Lens' ClientState (Maybe Regex)
- withClientState :: Configuration -> (ClientState -> IO a) -> IO a
- clientStartExtensions :: ClientState -> IO ClientState
- clientShutdown :: ClientState -> IO ()
- clientPark :: ClientState -> (Ptr () -> IO a) -> IO (ClientState, a)
- clientMatcher :: ClientState -> Text -> Bool
- clientActiveRegex :: ClientState -> Maybe Regex
- consumeInput :: ClientState -> ClientState
- currentCompletionList :: ClientState -> [Identifier]
- ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier
- clientFirstLine :: ClientState -> String
- clientLine :: ClientState -> (Int, String)
- abortNetwork :: Text -> ClientState -> IO ClientState
- addConnection :: Int -> Maybe UTCTime -> Text -> ClientState -> IO ClientState
- removeNetwork :: NetworkId -> ClientState -> (NetworkState, ClientState)
- clientTick :: ClientState -> ClientState
- applyMessageToClientState :: ZonedTime -> IrcMsg -> NetworkId -> NetworkState -> ClientState -> ([RawIrcMsg], ClientState)
- clientHighlights :: NetworkState -> ClientState -> HashSet Identifier
- clientWindowNames :: ClientState -> [Char]
- clientPalette :: ClientState -> Palette
- clientAutoconnects :: ClientState -> [Text]
- clientActiveCommand :: ClientState -> Maybe (String, String)
- clientExtraFocuses :: ClientState -> [Focus]
- currentNickCompletionMode :: ClientState -> WordCompletionMode
- recordChannelMessage :: Text -> Identifier -> ClientMessage -> ClientState -> ClientState
- recordNetworkMessage :: ClientMessage -> ClientState -> ClientState
- recordIrcMessage :: Text -> MessageTarget -> ClientMessage -> ClientState -> ClientState
- changeFocus :: Focus -> ClientState -> ClientState
- changeSubfocus :: Subfocus -> ClientState -> ClientState
- returnFocus :: ClientState -> ClientState
- advanceFocus :: ClientState -> ClientState
- retreatFocus :: ClientState -> ClientState
- jumpToActivity :: ClientState -> ClientState
- jumpFocus :: Int -> ClientState -> ClientState
- scrollClient :: Int -> ClientState -> ClientState
- data ExtensionState
- esActive :: Lens' ExtensionState [ActiveExtension]
- urlPattern :: Regex
Client state type
data ClientState Source #
All state information for the IRC client
ClientState | |
|
Lenses
:: Applicative f | |
=> Text | network |
-> LensLike' f ClientState NetworkState |
Traversal
for finding the NetworkState
associated with a given network
if that connection is currently active.
clientRegex :: Lens' ClientState (Maybe Regex) Source #
Client operations
withClientState :: Configuration -> (ClientState -> IO a) -> IO a Source #
Construct an initial ClientState
using default values.
clientStartExtensions :: ClientState -> IO ClientState Source #
Start extensions after ensuring existing ones are stopped
clientShutdown :: ClientState -> IO () Source #
clientPark :: ClientState -> (Ptr () -> IO a) -> IO (ClientState, a) Source #
clientMatcher :: ClientState -> Text -> Bool Source #
clientActiveRegex :: ClientState -> Maybe Regex Source #
Construct a text matching predicate used to filter the message window.
consumeInput :: ClientState -> ClientState Source #
Add the textbox input to the edit history and clear the textbox.
currentCompletionList :: ClientState -> [Identifier] Source #
Returns the current network's channels and current channel's users.
ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier Source #
Predicate for messages that should be ignored based on the configurable ignore list
clientFirstLine :: ClientState -> String Source #
The full top-most line that would be executed
:: ClientState | |
-> (Int, String) | line number, line content |
The line under the cursor in the edit box.
:: Text | network |
-> ClientState | |
-> IO ClientState |
Forcefully terminate the connection currently associated with a given network name.
:: Int | attempts |
-> Maybe UTCTime | optional disconnect time |
-> Text | network name |
-> ClientState | |
-> IO ClientState |
Start a new connection. The delay is used for reconnections.
removeNetwork :: NetworkId -> ClientState -> (NetworkState, ClientState) Source #
Remove a network connection and unlink it from the network map. This operation assumes that the networkconnection exists and should only be applied once per connection.
clientTick :: ClientState -> ClientState Source #
Function applied to the client state every redraw.
applyMessageToClientState Source #
:: ZonedTime | timestamp |
-> IrcMsg | message recieved |
-> NetworkId | message network |
-> NetworkState | network connection state |
-> ClientState | client state |
-> ([RawIrcMsg], ClientState) | response , updated state |
:: NetworkState | network state |
-> ClientState | client state |
-> HashSet Identifier | extra highlight identifiers |
Compute the set of extra identifiers that should be highlighted given a particular network state.
clientWindowNames :: ClientState -> [Char] Source #
Produce the list of window names configured for the client.
clientPalette :: ClientState -> Palette Source #
Produce the list of window names configured for the client.
clientAutoconnects :: ClientState -> [Text] Source #
Returns the list of network names that requested autoconnection.
:: ClientState | client state |
-> Maybe (String, String) | command name and argument string |
Compute the command and arguments currently in the textbox.
clientExtraFocuses :: ClientState -> [Focus] Source #
List of extra focuses to display as split windows
currentNickCompletionMode :: ClientState -> WordCompletionMode Source #
Returns the WordCompletionMode
associated with the current network.
Add messages to buffers
:: Text | network |
-> Identifier | channel |
-> ClientMessage | |
-> ClientState | |
-> ClientState |
Add a message to the window associated with a given channel
recordNetworkMessage :: ClientMessage -> ClientState -> ClientState Source #
Record a message on a network window
:: Text | network |
-> MessageTarget | |
-> ClientMessage | |
-> ClientState | |
-> ClientState |
Record a message in the windows corresponding to the given target
Focus manipulation
:: Focus | new focus |
-> ClientState | client state |
-> ClientState |
Change the window focus to the given value, reset the subfocus to message view, reset the scroll, remember the previous focus if it changed.
:: Subfocus | new subfocus |
-> ClientState | client state |
-> ClientState |
Change the subfocus to the given value, preserve the focus, reset the scroll.
returnFocus :: ClientState -> ClientState Source #
Return to previously focused window.
advanceFocus :: ClientState -> ClientState Source #
Step focus to the next window when on message view. Otherwise switch to message view.
retreatFocus :: ClientState -> ClientState Source #
Step focus to the previous window when on message view. Otherwise switch to message view.
jumpToActivity :: ClientState -> ClientState Source #
Jump the focus of the client to a buffer that has unread activity. Some events like errors or chat messages mentioning keywords are considered important and will be jumped to first.
:: Int | zero-based window index |
-> ClientState | |
-> ClientState |
Jump the focus directly to a window based on its zero-based index.
Scrolling
scrollClient :: Int -> ClientState -> ClientState Source #
Scroll the current buffer to show newer messages
Extensions
data ExtensionState Source #
URL view
urlPattern :: Regex Source #