{-# Language TemplateHaskell, BangPatterns, OverloadedStrings #-}
{-|
Module      : Client.State
Description : Primary client state type and update operations
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the core logic of the IRC client. The client
state tracks everything about the client.

-}
module Client.State
  (
  -- * Client state type
    ClientState(..)

  -- * Lenses
  , clientWindows
  , clientTextBox
  , clientTextBoxOffset
  , clientConnections
  , clientThreadJoins
  , clientWidth
  , clientHeight
  , clientEvents
  , clientFocus
  , clientPrevFocus
  , clientExtraFocus
  , clientConfig
  , clientScroll
  , clientDetailView
  , clientActivityBar
  , clientShowPing
  , clientSubfocus
  , clientIgnores
  , clientIgnoreMask
  , clientConnection
  , clientNotifications
  , clientBell
  , clientUiFocused
  , clientExtensions
  , clientRegex
  , clientLogQueue
  , clientActivityReturn
  , clientErrorMsg
  , clientLayout
  , clientEditMode
  , clientEditLock
  , clientRtsStats
  , clientConfigPath
  , clientStsPolicy
  , clientHighlights

  -- * Client operations
  , withClientState
  , clientIsFiltered
  , clientFilter
  , clientFilterChannels
  , clientNetworkPalette
  , buildMatcher
  , clientToggleHideMeta
  , channelUserList

  , consumeInput
  , currentCompletionList
  , identIgnored
  , clientFirstLine
  , clientLine
  , abortNetwork
  , addConnection
  , removeNetwork
  , clientTick
  , applyMessageToClientState
  , clientHighlightsFocus
  , clientWindowNames
  , clientPalette
  , clientAutoconnects
  , clientActiveCommand
  , clientNextWindowName
  , clientWindowHint

  , clientExtraFocuses
  , currentNickCompletionMode

  -- * Add messages to buffers
  , recordChannelMessage
  , recordNetworkMessage
  , recordError
  , recordIrcMessage
  , recordSuccess

  -- * Focus manipulation
  , changeFocus
  , changeSubfocus
  , returnFocus
  , advanceFocus
  , advanceNetworkFocus
  , retreatFocus
  , jumpToActivity
  , jumpFocus
  , setExtraFocus

  -- * Scrolling
  , scrollClient

  -- * Extensions
  , ExtensionState
  , esActive
  , esMVar
  , esStablePtr
  ) where

import           Client.CApi
import           Client.Commands.WordCompletion
import           Client.Configuration
import           Client.Configuration.ServerSettings
import           Client.Configuration.Sts
import           Client.Image.Message
import           Client.Image.PackedImage (imageText)
import           Client.Image.Palette
import           Client.Log
import           Client.Mask
import           Client.Message
import           Client.Network.Async
import           Client.State.Channel
import qualified Client.State.EditBox as Edit
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window
import           ContextFilter
import           Control.Applicative
import           Control.Concurrent.MVar
import           Control.Concurrent.STM
import           Control.Exception
import           Control.Lens
import           Control.Monad
import           Data.Foldable
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import           Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import           Data.List
import           Data.Maybe
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import           Data.Time
import           Foreign.StablePtr
import           Irc.Codes
import           Irc.Identifier
import           Irc.Message
import           Irc.RawIrcMsg
import           Irc.UserInfo
import           LensUtils
import           RtsStats (Stats)
import qualified System.Random as Random
import           Text.Regex.TDFA
import           Text.Regex.TDFA.String (compile)

-- | All state information for the IRC client
data ClientState = ClientState
  { ClientState -> Map Focus Window
_clientWindows           :: !(Map Focus Window) -- ^ client message buffers
  , ClientState -> Focus
_clientPrevFocus         :: !Focus              -- ^ previously focused buffer
  , ClientState -> Maybe Focus
_clientActivityReturn    :: !(Maybe Focus)      -- ^ focus prior to jumping to activity
  , ClientState -> Focus
_clientFocus             :: !Focus              -- ^ currently focused buffer
  , ClientState -> Subfocus
_clientSubfocus          :: !Subfocus           -- ^ current view mode
  , ClientState -> [(Focus, Subfocus)]
_clientExtraFocus        :: ![(Focus, Subfocus)]-- ^ extra messages windows to view

  , ClientState -> HashMap Text NetworkState
_clientConnections       :: !(HashMap Text NetworkState) -- ^ state of active connections
  , ClientState -> TQueue NetworkEvent
_clientEvents            :: !(TQueue NetworkEvent)    -- ^ incoming network event queue
  , ClientState -> TQueue (Int, ThreadEntry)
_clientThreadJoins       :: TQueue (Int, ThreadEntry) -- ^ Finished threads ready to report

  , ClientState -> Configuration
_clientConfig            :: !Configuration            -- ^ client configuration
  , ClientState -> String
_clientConfigPath        :: !FilePath                 -- ^ client configuration file path

  , ClientState -> EditBox
_clientTextBox           :: !Edit.EditBox             -- ^ primary text box
  , ClientState -> Int
_clientTextBoxOffset     :: !Int                      -- ^ size to crop from left of text box
  , ClientState -> Int
_clientWidth             :: !Int                      -- ^ current terminal width
  , ClientState -> Int
_clientHeight            :: !Int                      -- ^ current terminal height

  , ClientState -> Int
_clientScroll            :: !Int                      -- ^ buffer scroll lines
  , ClientState -> Bool
_clientDetailView        :: !Bool                     -- ^ use detailed rendering mode
  , ClientState -> Bool
_clientActivityBar       :: !Bool                     -- ^ visible activity bar
  , ClientState -> Bool
_clientShowPing          :: !Bool                     -- ^ visible ping time
  , ClientState -> Maybe Matcher
_clientRegex             :: Maybe Matcher             -- ^ optional persistent filter
  , ClientState -> LayoutMode
_clientLayout            :: LayoutMode                -- ^ layout mode for split screen
  , ClientState -> EditMode
_clientEditMode          :: EditMode                  -- ^ editor rendering mode
  , ClientState -> Bool
_clientEditLock          :: Bool                      -- ^ editor locked and won't send

  , ClientState -> [(Text, Text)]
_clientNotifications     :: [(LText.Text, LText.Text)] -- ^ notifications to send next draw
  , ClientState -> Bool
_clientBell              :: !Bool                     -- ^ terminal bell on next redraw
  , ClientState -> Bool
_clientUiFocused         :: !Bool                     -- ^ whether the UI is focused; used by notifications

  , ClientState -> HashSet Identifier
_clientIgnores           :: !(HashSet Identifier)     -- ^ ignored masks
  , ClientState -> Mask
_clientIgnoreMask        :: Mask                      -- ^ precomputed ignore regular expression (lazy)

  , ClientState -> ExtensionState
_clientExtensions        :: !ExtensionState           -- ^ state of loaded extensions
  , ClientState -> [LogLine]
_clientLogQueue          :: ![LogLine]                -- ^ log lines ready to write
  , ClientState -> Maybe Text
_clientErrorMsg          :: Maybe Text                -- ^ transient error box text
  , ClientState -> Maybe Stats
_clientRtsStats          :: Maybe Stats               -- ^ most recent GHC RTS stats

  , ClientState -> HashMap Text StsPolicy
_clientStsPolicy         :: !(HashMap Text StsPolicy) -- ^ STS policy entries
  , ClientState -> HashMap Identifier Highlight
_clientHighlights        :: !(HashMap Identifier Highlight) -- ^ highlights
  }

data Matcher = Matcher
  { Matcher -> Int
matcherBefore :: !Int
  , Matcher -> Int
matcherAfter  :: !Int
  , Matcher -> Maybe Int
matcherMax    :: Maybe Int
  , Matcher -> Text -> Bool
matcherPred   :: LText.Text -> Bool
  }

-- | State of the extension API including loaded extensions and the mechanism used
-- to support reentry into the Haskell runtime from the C API.
--
-- When executing inside an extension the mvar will contain the client state
-- and the ID of the running extension.
data ExtensionState = ExtensionState
  { ExtensionState -> IntMap ActiveExtension
_esActive    :: IntMap ActiveExtension     -- ^ active extensions
  , ExtensionState -> MVar ParkState
_esMVar      :: MVar ParkState             -- ^ 'MVar' used to with 'clientPark'
  , ExtensionState -> StablePtr (MVar ParkState)
_esStablePtr :: StablePtr (MVar ParkState) -- ^ 'StablePtr' used with 'clientPark'
  }

-- | ID of active extension and stored client state
type ParkState = (Int,ClientState)

makeLenses ''ClientState
makeLenses ''ExtensionState

-- | 'Traversal' for finding the 'NetworkState' associated with a given network
-- if that connection is currently active.
clientConnection ::
  Applicative f =>
  Text {- ^ network -} ->
  LensLike' f ClientState NetworkState
clientConnection :: forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network = 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

-- | The full top-most line that would be executed
clientFirstLine :: ClientState -> String
clientFirstLine :: ClientState -> String
clientFirstLine = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> (String, Content)
Edit.shift 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 EditBox
clientTextBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' EditBox Content
Edit.content)

-- | The line under the cursor in the edit box.
clientLine :: ClientState -> (Int, String) {- ^ line number, line content -}
clientLine :: ClientState -> (Int, String)
clientLine = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState EditBox
clientTextBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasLine c => Lens' c Line
Edit.line) (\(Edit.Line Int
n String
t) -> (Int
n, String
t))

-- | Construct an initial 'ClientState' using default values.
withClientState :: FilePath -> Configuration -> (ClientState -> IO a) -> IO a
withClientState :: forall a. String -> Configuration -> (ClientState -> IO a) -> IO a
withClientState String
cfgPath Configuration
cfg ClientState -> IO a
k =

  forall a. (ExtensionState -> IO a) -> IO a
withExtensionState forall a b. (a -> b) -> a -> b
$ \ExtensionState
exts ->

  do TQueue NetworkEvent
events    <- forall a. STM a -> IO a
atomically forall a. STM (TQueue a)
newTQueue
     TQueue (Int, ThreadEntry)
threadQueue <- forall a. STM a -> IO a
atomically forall a. STM (TQueue a)
newTQueue
     HashMap Text StsPolicy
sts       <- IO (HashMap Text StsPolicy)
readPolicyFile
     let ignoreIds :: [Identifier]
ignoreIds = forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration [Text]
configIgnores Configuration
cfg)
     ClientState -> IO a
k ClientState
        { _clientWindows :: Map Focus Window
_clientWindows           = forall a. AsEmpty a => Prism' a ()
_Empty forall t b. AReview t b -> b -> t
# ()
        , _clientIgnores :: HashSet Identifier
_clientIgnores           = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [Identifier]
ignoreIds
        , _clientIgnoreMask :: Mask
_clientIgnoreMask        = [Identifier] -> Mask
buildMask [Identifier]
ignoreIds
        , _clientConnections :: HashMap Text NetworkState
_clientConnections       = forall a. AsEmpty a => Prism' a ()
_Empty forall t b. AReview t b -> b -> t
# ()
        , _clientThreadJoins :: TQueue (Int, ThreadEntry)
_clientThreadJoins       = TQueue (Int, ThreadEntry)
threadQueue
        , _clientTextBox :: EditBox
_clientTextBox           = EditBox
Edit.defaultEditBox
        , _clientTextBoxOffset :: Int
_clientTextBoxOffset     = Int
0
        , _clientWidth :: Int
_clientWidth             = Int
80
        , _clientHeight :: Int
_clientHeight            = Int
25
        , _clientEvents :: TQueue NetworkEvent
_clientEvents            = TQueue NetworkEvent
events
        , _clientPrevFocus :: Focus
_clientPrevFocus         = Focus
Unfocused
        , _clientActivityReturn :: Maybe Focus
_clientActivityReturn    = forall a. Maybe a
Nothing
        , _clientFocus :: Focus
_clientFocus             = Focus
Unfocused
        , _clientSubfocus :: Subfocus
_clientSubfocus          = Subfocus
FocusMessages
        , _clientExtraFocus :: [(Focus, Subfocus)]
_clientExtraFocus        = []
        , _clientConfig :: Configuration
_clientConfig            = Configuration
cfg
        , _clientConfigPath :: String
_clientConfigPath        = String
cfgPath
        , _clientScroll :: Int
_clientScroll            = Int
0
        , _clientDetailView :: Bool
_clientDetailView        = Bool
False
        , _clientRegex :: Maybe Matcher
_clientRegex             = forall a. Maybe a
Nothing
        , _clientLayout :: LayoutMode
_clientLayout            = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration LayoutMode
configLayout Configuration
cfg
        , _clientEditMode :: EditMode
_clientEditMode          = EditMode
SingleLineEditor
        , _clientEditLock :: Bool
_clientEditLock          = Bool
False
        , _clientActivityBar :: Bool
_clientActivityBar       = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration Bool
configActivityBar Configuration
cfg
        , _clientShowPing :: Bool
_clientShowPing          = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Configuration Bool
configShowPing Configuration
cfg
        , _clientNotifications :: [(Text, Text)]
_clientNotifications     = []
        , _clientBell :: Bool
_clientBell              = Bool
False
        , _clientUiFocused :: Bool
_clientUiFocused         = Bool
True
        , _clientExtensions :: ExtensionState
_clientExtensions        = ExtensionState
exts
        , _clientLogQueue :: [LogLine]
_clientLogQueue          = []
        , _clientErrorMsg :: Maybe Text
_clientErrorMsg          = forall a. Maybe a
Nothing
        , _clientRtsStats :: Maybe Stats
_clientRtsStats          = forall a. Maybe a
Nothing
        , _clientStsPolicy :: HashMap Text StsPolicy
_clientStsPolicy         = HashMap Text StsPolicy
sts
        , _clientHighlights :: HashMap Identifier Highlight
_clientHighlights        = forall k v. HashMap k v
HashMap.empty
        }

withExtensionState :: (ExtensionState -> IO a) -> IO a
withExtensionState :: forall a. (ExtensionState -> IO a) -> IO a
withExtensionState ExtensionState -> IO a
k =
  do MVar ParkState
mvar <- forall a. IO (MVar a)
newEmptyMVar
     forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. a -> IO (StablePtr a)
newStablePtr MVar ParkState
mvar) forall a. StablePtr a -> IO ()
freeStablePtr forall a b. (a -> b) -> a -> b
$ \StablePtr (MVar ParkState)
stab ->
       ExtensionState -> IO a
k ExtensionState
         { _esActive :: IntMap ActiveExtension
_esActive    = forall a. IntMap a
IntMap.empty
         , _esMVar :: MVar ParkState
_esMVar      = MVar ParkState
mvar
         , _esStablePtr :: StablePtr (MVar ParkState)
_esStablePtr = StablePtr (MVar ParkState)
stab
         }

-- | Forcefully terminate the connection currently associated
-- with a given network name.
abortNetwork ::
  Text {- ^ network -} ->
  ClientState -> IO ClientState
abortNetwork :: Text -> ClientState -> IO ClientState
abortNetwork Text
network ClientState
st =
  case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
    Maybe NetworkState
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st
    Just NetworkState
cs -> do -- cancel the network thread
                  TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
ForcedDisconnect (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
                  -- unassociate this network name from this network id
                  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 -> (a -> b) -> s -> t
over Lens' ClientState (HashMap Text NetworkState)
clientConnections (forall m. At m => Index m -> m -> m
sans Text
network) ClientState
st

recordSuccess :: ZonedTime -> ClientState -> Text -> ClientState
recordSuccess :: ZonedTime -> ClientState -> Text -> ClientState
recordSuccess ZonedTime
now ClientState
ste Text
m =
  ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
    { _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
    , _msgBody :: MessageBody
_msgBody    = Text -> MessageBody
NormalBody Text
m
    , _msgNetwork :: Text
_msgNetwork = Text
""
    } ClientState
ste


-- | Add a message to the window associated with a given channel
recordChannelMessage ::
  Text       {- ^ network -} ->
  Identifier {- ^ channel -} ->
  ClientMessage ->
  ClientState ->
  ClientState
recordChannelMessage :: Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage = Bool
-> Text
-> Identifier
-> ClientMessage
-> ClientState
-> ClientState
recordChannelMessage' Bool
True

recordChannelMessage' ::
  Bool       {- ^ create  -} ->
  Text       {- ^ network -} ->
  Identifier {- ^ channel -} ->
  ClientMessage ->
  ClientState ->
  ClientState
recordChannelMessage' :: Bool
-> Text
-> Identifier
-> ClientMessage
-> ClientState
-> ClientState
recordChannelMessage' Bool
create Text
network Identifier
channel ClientMessage
msg ClientState
st
  = ClientMessage -> String -> Identifier -> ClientState -> ClientState
recordLogLine ClientMessage
msg String
statusModes Identifier
channel'
  forall a b. (a -> b) -> a -> b
$ Bool -> Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine' Bool
create Focus
focus WindowLine
wl ClientState
st
  where
    focus :: Focus
focus      = Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
channel'
    wl :: WindowLine
wl         = MessageRendererParams
-> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine MessageRendererParams
rendParams WindowLineImportance
importance ClientMessage
msg

    rendParams :: MessageRendererParams
rendParams = MessageRendererParams
      { rendStatusMsg :: String
rendStatusMsg   = String
statusModes
      , rendUserSigils :: String
rendUserSigils  = Text -> Identifier -> ClientMessage -> ClientState -> String
computeMsgLineSigils Text
network Identifier
channel' ClientMessage
msg ClientState
st
      , rendHighlights :: HashMap Identifier Highlight
rendHighlights  = HashMap Identifier Highlight
highlights
      , rendPalette :: Palette
rendPalette     = ClientState -> Palette
clientPalette ClientState
st
      , rendAccounts :: Maybe (HashMap Identifier UserAndHost)
rendAccounts    = Maybe (HashMap Identifier UserAndHost)
accounts
      , rendNetPalette :: NetworkPalette
rendNetPalette  = ClientState -> NetworkPalette
clientNetworkPalette ClientState
st
      , rendChanTypes :: String
rendChanTypes   = String
"#&!+" -- TODO: Don't hardcode this, use CHANTYPES ISUPPORT.
      }

    -- on failure returns mempty/""
    cs :: NetworkState
cs = ClientState
st forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
    possibleStatusModes :: String
possibleStatusModes     = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState String
csStatusMsg NetworkState
cs
    (String
statusModes, Identifier
channel') = String -> Identifier -> (String, Identifier)
splitStatusMsgModes String
possibleStatusModes Identifier
channel
    importance :: WindowLineImportance
importance              = ClientMessage -> ClientState -> WindowLineImportance
msgImportance ClientMessage
msg ClientState
st
    highlights :: HashMap Identifier Highlight
highlights              = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
channel) ClientState
st

    accounts :: Maybe (HashMap Identifier UserAndHost)
accounts =
      if 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 Bool
ssShowAccounts) NetworkState
cs
      then forall a. a -> Maybe a
Just (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers NetworkState
cs)
      else forall a. Maybe a
Nothing


recordLogLine ::
  ClientMessage {- ^ message      -} ->
  [Char]        {- ^ status modes -} ->
  Identifier    {- ^ target       -} ->
  ClientState   {- ^ client state -} ->
  ClientState
recordLogLine :: ClientMessage -> String -> Identifier -> ClientState -> ClientState
recordLogLine ClientMessage
msg String
statusModes Identifier
target ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage Text
msgNetwork ClientMessage
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState ServerSettings
csSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ServerSettings (Maybe String)
ssLogDir) ClientState
st of
    Maybe String
Nothing -> ClientState
st
    Just String
dir ->
      case ClientMessage -> String -> String -> Identifier -> Maybe LogLine
renderLogLine ClientMessage
msg String
dir String
statusModes Identifier
target of
        Maybe LogLine
Nothing  -> ClientState
st
        Just LogLine
ll  -> forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState [LogLine]
clientLogQueue (forall s a. Cons s s a a => a -> s -> s
cons LogLine
ll) ClientState
st


-- | Extract the status mode sigils from a message target.
splitStatusMsgModes ::
  [Char]               {- ^ possible modes              -} ->
  Identifier           {- ^ target                      -} ->
  ([Char], Identifier) {- ^ actual modes, actual target -}
splitStatusMsgModes :: String -> Identifier -> (String, Identifier)
splitStatusMsgModes String
possible Identifier
ident = (Text -> String
Text.unpack Text
modes, Text -> Identifier
mkId Text
ident')
  where
    (Text
modes, Text
ident') = (Char -> Bool) -> Text -> (Text, Text)
Text.span (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
possible) (Identifier -> Text
idText Identifier
ident)


-- | Compute the importance of a message to be used when computing
-- change notifications in the client.
msgImportance :: ClientMessage -> ClientState -> WindowLineImportance
msgImportance :: ClientMessage -> ClientState -> WindowLineImportance
msgImportance ClientMessage
msg ClientState
st =
  let network :: Text
network = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage Text
msgNetwork ClientMessage
msg
      me :: Maybe Identifier
me      = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState Identifier
csNick) ClientState
st
      highlights :: HashMap Identifier Highlight
highlights = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st
      isMe :: Identifier -> Bool
isMe Identifier
x  = forall a. a -> Maybe a
Just Identifier
x forall a. Eq a => a -> a -> Bool
== Maybe Identifier
me
      checkTxt :: Text -> WindowLineImportance
checkTxt Text
txt
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
x -> forall a. a -> Maybe a
Just Highlight
HighlightMe forall a. Eq a => a -> a -> Bool
== forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Identifier
mkId Text
x) HashMap Identifier Highlight
highlights)
              (Text -> [Text]
nickSplit Text
txt) = WindowLineImportance
WLImportant
        | Bool
otherwise           = WindowLineImportance
WLNormal
  in
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage MessageBody
msgBody ClientMessage
msg of
    NormalBody{} -> WindowLineImportance
WLImportant
    ErrorBody{}  -> WindowLineImportance
WLImportant
    IrcBody IrcMsg
irc
      | IrcMsg -> Bool
squelchIrcMsg IrcMsg
irc -> WindowLineImportance
WLBoring
      | forall a. Maybe a -> Bool
isJust (IrcMsg -> ClientState -> Maybe Identifier
ircIgnorable IrcMsg
irc ClientState
st) -> WindowLineImportance
WLBoring
      | Bool
otherwise ->
      case IrcMsg
irc of
        Privmsg Source
_ Identifier
tgt Text
txt
          | Identifier -> Bool
isMe Identifier
tgt  -> WindowLineImportance
WLImportant
          | Bool
otherwise -> Text -> WindowLineImportance
checkTxt Text
txt
        Notice Source
_ Identifier
tgt Text
txt
          | Identifier -> Bool
isMe Identifier
tgt  -> WindowLineImportance
WLImportant
          | Bool
otherwise -> Text -> WindowLineImportance
checkTxt Text
txt
        Ctcp Source
_ Identifier
tgt Text
"ACTION" Text
txt
          | Identifier -> Bool
isMe Identifier
tgt  -> WindowLineImportance
WLImportant
          | Bool
otherwise -> Text -> WindowLineImportance
checkTxt Text
txt
        Ctcp{} -> WindowLineImportance
WLNormal
        Wallops{} -> WindowLineImportance
WLImportant
        Part Source
who Identifier
_ Maybe Text
_ | Identifier -> Bool
isMe (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
who)) -> WindowLineImportance
WLImportant
                     | Bool
otherwise -> WindowLineImportance
WLBoring
        Kick Source
_ Identifier
_ Identifier
kicked Text
_ | Identifier -> Bool
isMe Identifier
kicked -> WindowLineImportance
WLImportant
                          | Bool
otherwise   -> WindowLineImportance
WLNormal
        Error{} -> WindowLineImportance
WLImportant

        -- away notices
        Reply Text
_ ReplyCode
RPL_AWAY [Text]
_     -> WindowLineImportance
WLBoring

        -- list output
        Reply Text
_ ReplyCode
RPL_LISTSTART [Text]
_ -> WindowLineImportance
WLBoring
        Reply Text
_ ReplyCode
RPL_LIST      [Text]
_ -> WindowLineImportance
WLBoring
        Reply Text
_ ReplyCode
RPL_LISTEND   [Text]
_ -> WindowLineImportance
WLBoring

        -- channel information
        Reply Text
_ ReplyCode
RPL_TOPIC [Text]
_    -> WindowLineImportance
WLBoring
        Reply Text
_ ReplyCode
RPL_INVITING [Text]
_ -> WindowLineImportance
WLBoring

        -- remaining replies go to network window
        Reply Text
_ ReplyCode
cmd [Text]
_ ->
          case ReplyCodeInfo -> ReplyType
replyCodeType (ReplyCode -> ReplyCodeInfo
replyCodeInfo ReplyCode
cmd) of
            ReplyType
ErrorReply -> WindowLineImportance
WLImportant
            ReplyType
_          -> WindowLineImportance
WLNormal
        IrcMsg
_              -> WindowLineImportance
WLBoring


-- | Predicate for messages that should be ignored based on the
-- configurable ignore list
ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier
ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier
ircIgnorable IrcMsg
msg !ClientState
st =
  case IrcMsg
msg of
    Privmsg Source
who Identifier
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    Notice  Source
who Identifier
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    -- privmsg ctcp commands are already metadata
    Ctcp Source
who Identifier
_ Text
"ACTION" Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    -- notice ctcp responses are not already metadata
    CtcpNotice Source
who Identifier
_ Text
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    IrcMsg
_                    -> forall a. Maybe a
Nothing
  where
    checkUser :: Source -> Maybe Identifier
checkUser !Source
who
      | UserInfo -> ClientState -> Bool
identIgnored (Source -> UserInfo
srcUser Source
who) ClientState
st = forall a. a -> Maybe a
Just (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
who))
      | Bool
otherwise = forall a. Maybe a
Nothing



-- | Predicate for nicknames to determine if messages should be ignored.
identIgnored ::
  UserInfo    {- ^ target user  -} ->
  ClientState {- ^ client state -} ->
  Bool        {- ^ is ignored   -}
identIgnored :: UserInfo -> ClientState -> Bool
identIgnored UserInfo
who ClientState
st = Mask -> UserInfo -> Bool
matchMask (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Mask
clientIgnoreMask ClientState
st) UserInfo
who


-- | Record a message in the windows corresponding to the given target
recordIrcMessage ::
  Text {- ^ network -} ->
  MessageTarget ->
  ClientMessage ->
  ClientState -> ClientState
recordIrcMessage :: Text
-> MessageTarget -> ClientMessage -> ClientState -> ClientState
recordIrcMessage Text
network MessageTarget
target ClientMessage
msg ClientState
st =
  Focus -> ClientMessage -> ClientState -> ClientState
updateTransientError (Text -> Focus
NetworkFocus Text
network) ClientMessage
msg forall a b. (a -> b) -> a -> b
$
  case MessageTarget
target of
    MessageTarget
TargetNetwork      -> ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg ClientState
st
    TargetExisting Identifier
win -> Bool
-> Text
-> Identifier
-> ClientMessage
-> ClientState
-> ClientState
recordChannelMessage' Bool
False Text
network Identifier
win  ClientMessage
msg ClientState
st
    TargetWindow Identifier
chan  -> Bool
-> Text
-> Identifier
-> ClientMessage
-> ClientState
-> ClientState
recordChannelMessage' Bool
True  Text
network Identifier
chan ClientMessage
msg ClientState
st
    TargetUser Identifier
user    -> Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordUserMessage Text
network Identifier
user ClientMessage
msg ClientState
st

-- | Compute the sigils of the user who sent a message.
computeMsgLineSigils ::
  Text       {- ^ network -} ->
  Identifier {- ^ channel -} ->
  ClientMessage ->
  ClientState ->
  [Char] {- ^ sigils -}
computeMsgLineSigils :: Text -> Identifier -> ClientMessage -> ClientState -> String
computeMsgLineSigils Text
network Identifier
channel ClientMessage
msg ClientState
st =
  case IrcMsg -> Maybe Source
msgActor forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' ClientMessage MessageBody
msgBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' MessageBody IrcMsg
_IrcBody) ClientMessage
msg of
    Just Source
user -> Text -> Identifier -> Identifier -> ClientState -> String
computeUserSigils Text
network Identifier
channel (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user)) ClientState
st
    Maybe Source
Nothing   -> []

-- | Compute sigils for a user on a channel
computeUserSigils ::
  Text       {- ^ network -} ->
  Identifier {- ^ channel -} ->
  Identifier {- ^ user    -} ->
  ClientState ->
  [Char] {- ^ sigils -}
computeUserSigils :: Text -> Identifier -> Identifier -> ClientState -> String
computeUserSigils Text
network Identifier
channel Identifier
user =
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
user


-- | Detect /error/ messages and add the message text to the transient
-- error display. The transient message will not be generated if the
-- user is focused on the window where the message is going to be
-- rendered, anyway.
updateTransientError :: Focus -> ClientMessage -> ClientState -> ClientState
updateTransientError :: Focus -> ClientMessage -> ClientState -> ClientState
updateTransientError Focus
destination ClientMessage
msg ClientState
st
  | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st forall a. Eq a => a -> a -> Bool
== Focus
destination = ClientState
st
  | Bool
otherwise =

  let err :: Text -> ClientState
err Text
e = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Text)
clientErrorMsg (forall a. a -> Maybe a
Just Text
e) ClientState
st in

  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage MessageBody
msgBody ClientMessage
msg of
    ErrorBody Text
txt       -> Text -> ClientState
err Text
txt
    IrcBody (Error Text
txt) -> Text -> ClientState
err Text
txt
    IrcBody (Reply Text
_ ReplyCode
code [Text]
args)
      | let info :: ReplyCodeInfo
info = ReplyCode -> ReplyCodeInfo
replyCodeInfo ReplyCode
code
      , ReplyType
ErrorReply <- ReplyCodeInfo -> ReplyType
replyCodeType ReplyCodeInfo
info ->
          Text -> ClientState
err (Text -> [Text] -> Text
Text.intercalate Text
" " (ReplyCodeInfo -> Text
replyCodeText ReplyCodeInfo
info forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
1 [Text]
args))
    MessageBody
_ -> ClientState
st


-- | Record a message on a network window
recordNetworkMessage :: ClientMessage -> ClientState -> ClientState
recordNetworkMessage :: ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg ClientState
st = Focus -> ClientMessage -> ClientState -> ClientState
updateTransientError Focus
focus ClientMessage
msg
                            forall a b. (a -> b) -> a -> b
$ Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine Focus
focus WindowLine
wl ClientState
st
  where
    network :: Text
network    = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage Text
msgNetwork ClientMessage
msg
    focus :: Focus
focus      | Text -> Bool
Text.null Text
network = Focus
Unfocused
               | Bool
otherwise         = Text -> Focus
NetworkFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage Text
msgNetwork ClientMessage
msg)
    importance :: WindowLineImportance
importance = ClientMessage -> ClientState -> WindowLineImportance
msgImportance ClientMessage
msg ClientState
st
    wl :: WindowLine
wl         = Text
-> ClientState
-> WindowLineImportance
-> ClientMessage
-> WindowLine
toWindowLine' Text
network ClientState
st WindowLineImportance
importance ClientMessage
msg

-- | Record a message on every window where a user is present.
recordUserMessage ::
  Text       {- ^ network -} ->
  Identifier {- ^ user -} ->
  ClientMessage ->
  ClientState ->
  ClientState
recordUserMessage :: Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordUserMessage Text
network Identifier
user ClientMessage
msg ClientState
st = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ClientState -> Identifier -> ClientState
foldFn ClientState
st [Identifier]
chans
  where
    -- FIXME: We discard the the boolean from addToWindow here,
    -- which means notifications for important cross-channel activity never happen.
    -- This currently affects nothing AFAIK, but who knows what the future holds?
    windowsLens :: Identifier -> (Window -> f Window) -> ClientState -> f ClientState
windowsLens Identifier
chan = Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
chan)
    foldFn :: ClientState -> Identifier -> ClientState
foldFn ClientState
st' Identifier
chan = forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (forall {f :: * -> *}.
Applicative f =>
Identifier -> (Window -> f Window) -> ClientState -> f ClientState
windowsLens Identifier
chan) (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowLine -> Window -> (Window, Bool)
addToWindow WindowLine
wl) ClientState
st'
    wl :: WindowLine
wl    = Text
-> ClientState
-> WindowLineImportance
-> ClientMessage
-> WindowLine
toWindowLine' Text
network ClientState
st WindowLineImportance
WLBoring ClientMessage
msg
    chans :: [Identifier]
chans = Identifier
user
          forall a. a -> [a] -> [a]
: case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels) ClientState
st of
              Maybe (HashMap Identifier ChannelState)
Nothing -> []
              Just HashMap Identifier ChannelState
m  -> [Identifier
chan | (Identifier
chan, ChannelState
cs) <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Identifier ChannelState
m
                               , forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Identifier
user (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState (HashMap Identifier String)
chanUsers ChannelState
cs) ]

recordError ::
  ZonedTime       {- ^ now             -} ->
  Text            {- ^ network         -} ->
  Text            {- ^ error message   -} ->
  ClientState     {- ^ client state    -} ->
  ClientState
recordError :: ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
net Text
msg =
  ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
    { _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
    , _msgNetwork :: Text
_msgNetwork = Text
net
    , _msgBody :: MessageBody
_msgBody    = Text -> MessageBody
ErrorBody Text
msg
    }

clientNextWindowName :: Maybe WindowHint -> ClientState -> Char
clientNextWindowName :: Maybe WindowHint -> ClientState -> Char
clientNextWindowName Maybe WindowHint
hint ClientState
st
  | Just Char
n <- WindowHint -> Maybe Char
windowHintName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hint, Char
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
usedNames = Char
n
  | Char
c:String
_ <- String
availableNames forall a. Eq a => [a] -> [a] -> [a]
\\ String
usedNames    = Char
c
  | Bool
otherwise                             = Char
'\0'
  where
    usedNames :: String
usedNames = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window (Maybe Char)
winName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ClientState
st

    availableNames :: String
    availableNames :: String
availableNames = ClientState -> String
clientWindowNames ClientState
st forall a. Eq a => [a] -> [a] -> [a]
\\ String
reservedNames

    reservedNames :: String
    reservedNames :: String
reservedNames =
      forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' ClientState (HashMap Text NetworkState)
clientConnections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState ServerSettings
csSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ServerSettings (Map Focus WindowHint)
ssWindowHints forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded 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 WindowHint -> Maybe Char
windowHintName  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) ClientState
st

clientWindowHint :: Focus -> ClientState -> Maybe WindowHint
clientWindowHint :: Focus -> ClientState -> Maybe WindowHint
clientWindowHint Focus
focus ClientState
st =
 do Text
net <- Focus -> Maybe Text
focusNetwork Focus
focus
    let hintFocus :: Focus
hintFocus =
          case Focus
focus of
            Focus
Unfocused -> Focus
Unfocused
            NetworkFocus {} -> Text -> Focus
NetworkFocus Text
""
            ChannelFocus Text
_ Identifier
x -> Text -> Identifier -> Focus
ChannelFocus Text
"" Identifier
x
    forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState ServerSettings
csSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ServerSettings (Map Focus WindowHint)
ssWindowHints forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
hintFocus) ClientState
st

-- | Record window line at the given focus creating the window if necessary
recordWindowLine ::
  Focus ->
  WindowLine ->
  ClientState ->
  ClientState
recordWindowLine :: Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine = Bool -> Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine' Bool
True

recordWindowLine' ::
  Bool ->
  Focus ->
  WindowLine ->
  ClientState ->
  ClientState
recordWindowLine' :: Bool -> Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine' Bool
create Focus
focus WindowLine
wl ClientState
st = ClientState
st1
  where
    hints :: Maybe WindowHint
hints = Focus -> ClientState -> Maybe WindowHint
clientWindowHint Focus
focus ClientState
st
    winActivity :: ActivityFilter
winActivity = forall a. a -> Maybe a -> a
fromMaybe ActivityFilter
AFLoud (WindowHint -> Maybe ActivityFilter
windowHintActivity forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hints)

    freshWindow :: Window
freshWindow = Window
emptyWindow
      { _winName' :: Char
_winName'    = Maybe WindowHint -> ClientState -> Char
clientNextWindowName Maybe WindowHint
hints ClientState
st
      , _winHideMeta :: Bool
_winHideMeta = forall a. a -> Maybe a -> a
fromMaybe (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 Bool
configHideMeta) ClientState
st) (WindowHint -> Maybe Bool
windowHintHideMeta forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hints)
      , _winHidden :: Bool
_winHidden   = forall a. a -> Maybe a -> a
fromMaybe Bool
False (WindowHint -> Maybe Bool
windowHintHidden forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hints)
      , _winActivityFilter :: ActivityFilter
_winActivityFilter   = ActivityFilter
winActivity
      }

    add :: Bool -> Maybe Window -> Maybe (Window, Bool)
add Bool
True  Maybe Window
w = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! WindowLine -> Window -> (Window, Bool)
addToWindow WindowLine
wl (forall a. a -> Maybe a -> a
fromMaybe Window
freshWindow Maybe Window
w)
    add Bool
False Maybe Window
w = WindowLine -> Window -> (Window, Bool)
addToWindow WindowLine
wl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Window
w

    addedMaybe :: Maybe (Window, Bool)
addedMaybe = Bool -> Maybe Window -> Maybe (Window, Bool)
add Bool
create forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Focus
focus) ClientState
st
    st1 :: ClientState
st1 = case Maybe (Window, Bool)
addedMaybe of
      Just (Window
w', Bool
notify) -> Bool -> Focus -> WindowLine -> ClientState -> ClientState
addNotify Bool
notify Focus
focus WindowLine
wl forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Focus
focus) (forall a. a -> Maybe a
Just Window
w') ClientState
st
      Maybe (Window, Bool)
Nothing -> ClientState
st

addNotify :: Bool -> Focus -> WindowLine -> ClientState -> ClientState
addNotify :: Bool -> Focus -> WindowLine -> ClientState -> ClientState
addNotify Bool
False Focus
_     WindowLine
_  ClientState
st = ClientState
st
addNotify Bool
True  Focus
focus WindowLine
wl ClientState
st
  | Focus
focus forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st Bool -> Bool -> Bool
&& forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientUiFocused ClientState
st = ClientState
st
  | Bool
otherwise = ClientState -> ClientState
addBell forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState [(Text, Text)]
clientNotifications (forall s a. Cons s s a a => a -> s -> s
cons (Focus -> Text
focusText Focus
focus, Text
bodyText)) ClientState
st
  where
    addBell :: ClientState -> ClientState
addBell ClientState
st'
      | Bool -> Bool
not (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientBell ClientState
st')
      , 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 Bool
configBellOnMention) ClientState
st' = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Bool
clientBell Bool
True ClientState
st'
      | Bool
otherwise = ClientState
st'
    bodyText :: Text
bodyText = Image' -> Text
imageText (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine Image'
wlPrefix WindowLine
wl) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Image' -> Text
imageText (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine Image'
wlImage WindowLine
wl)
    focusText :: Focus -> Text
focusText Focus
Unfocused = Text
"Application Notice"
    focusText (NetworkFocus Text
net) = [Text] -> Text
LText.fromChunks [Text
"Notice from ", Text
net]
    focusText (ChannelFocus Text
net Identifier
chan) = [Text] -> Text
LText.fromChunks [Text
"Activity on ", Text
net, Text
":", Identifier -> Text
idText Identifier
chan]

toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine :: MessageRendererParams
-> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine MessageRendererParams
params WindowLineImportance
importance ClientMessage
msg = WindowLine
  { _wlSummary :: IrcSummary
_wlSummary    = MessageBody -> IrcSummary
msgSummary (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage MessageBody
msgBody ClientMessage
msg)
  , _wlPrefix :: Image'
_wlPrefix     = Image'
prefix
  , _wlImage :: Image'
_wlImage      = Image'
image
  , _wlFullImage :: Image'
_wlFullImage  = Image'
full
  , _wlImportance :: WindowLineImportance
_wlImportance = WindowLineImportance
importance
  , _wlTimestamp :: PackedTime
_wlTimestamp  = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientMessage ZonedTime
msgTime ZonedTime -> PackedTime
packZonedTime ClientMessage
msg
  }
  where
    (Image'
prefix, Image'
image, Image'
full) = ZonedTime
-> MessageRendererParams -> MessageBody -> (Image', Image', Image')
msgImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage ZonedTime
msgTime ClientMessage
msg) MessageRendererParams
params (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientMessage MessageBody
msgBody ClientMessage
msg)

-- | 'toWindowLine' but with mostly defaulted parameters.
toWindowLine' :: Text -> ClientState -> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine' :: Text
-> ClientState
-> WindowLineImportance
-> ClientMessage
-> WindowLine
toWindowLine' Text
network ClientState
st =
  MessageRendererParams
-> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine MessageRendererParams
defaultRenderParams
    { rendPalette :: Palette
rendPalette     = 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 Palette
configPalette) ClientState
st
    , rendHighlights :: HashMap Identifier Highlight
rendHighlights  = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st
    }


-- | Function applied to the client state every redraw.
clientTick :: ClientState -> ClientState
clientTick :: ClientState -> ClientState
clientTick ClientState
st = (if forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientUiFocused ClientState
st then ClientState -> ClientState
markSeen else forall a. a -> a
id)
           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' ClientState Bool
clientBell Bool
False
           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' ClientState [(Text, Text)]
clientNotifications []
           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' ClientState [LogLine]
clientLogQueue []
           forall a b. (a -> b) -> a -> b
$ ClientState
st


-- | Mark the messages on the current window (and any splits) as seen.
markSeen :: ClientState -> ClientState
markSeen :: ClientState -> ClientState
markSeen ClientState
st = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ClientState -> Focus -> ClientState
aux ClientState
st [Focus]
messageFocuses
  where
    aux :: ClientState -> Focus -> ClientState
aux ClientState
acc Focus
focus = forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus) Window -> Window
windowSeen ClientState
acc

    messageFocuses :: [Focus]
messageFocuses = [Focus
focus | (Focus
focus, Subfocus
FocusMessages) <- [(Focus, Subfocus)]
allFocuses]

    allFocuses :: [(Focus, Subfocus)]
allFocuses = (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st)
               forall a. a -> [a] -> [a]
: forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st

-- | Add the textbox input to the edit history and clear the textbox.
consumeInput :: ClientState -> ClientState
consumeInput :: ClientState -> ClientState
consumeInput = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState EditBox
clientTextBox EditBox -> EditBox
Edit.success

-- | Returns the current network's channels and current channel's users.
currentCompletionList :: ClientState -> [Identifier]
currentCompletionList :: ClientState -> [Identifier]
currentCompletionList ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
    NetworkFocus Text
network      -> Text -> ClientState -> [Identifier]
networkChannelList Text
network ClientState
st
    ChannelFocus Text
network Identifier
chan ->
         Identifier
chan -- might be a disconnected channel or a private chat
       forall a. a -> [a] -> [a]
: Text -> ClientState -> [Identifier]
networkChannelList Text
network ClientState
st
      forall a. [a] -> [a] -> [a]
++ Text -> Identifier -> ClientState -> [Identifier]
channelUserList Text
network Identifier
chan ClientState
st
    Focus
_                         -> []

-- | Returns the 'WordCompletionMode' associated with the current network.
currentNickCompletionMode :: ClientState -> WordCompletionMode
currentNickCompletionMode :: ClientState -> WordCompletionMode
currentNickCompletionMode ClientState
st =
  forall a. a -> Maybe a -> a
fromMaybe WordCompletionMode
defaultNickWordCompleteMode forall a b. (a -> b) -> a -> b
$
  do Text
network <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
     forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState ServerSettings
csSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ServerSettings WordCompletionMode
ssNickCompletion) ClientState
st

networkChannelList ::
  Text         {- ^ network -} ->
  ClientState                  ->
  [Identifier] {- ^ channels -}
networkChannelList :: Text -> ClientState -> [Identifier]
networkChannelList Text
network =
  forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels) forall k v. HashMap k v -> [k]
HashMap.keys

channelUserList ::
  Text         {- ^ network -} ->
  Identifier   {- ^ channel -} ->
  ClientState                  ->
  [Identifier] {- ^ nicks   -}
channelUserList :: Text -> Identifier -> ClientState -> [Identifier]
channelUserList Text
network Identifier
channel =
  forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers) forall k v. HashMap k v -> [k]
HashMap.keys

-- | Returns the current filtering predicate if one is active.
clientMatcher ::
  ClientState   {- ^ client state       -} ->
  Maybe Matcher {- ^ optional predicate -}
clientMatcher :: ClientState -> Maybe Matcher
clientMatcher ClientState
st =
  case ClientState -> Maybe (String, String)
clientActiveCommand ClientState
st of
    Just (String
"grep" , String
reStr) -> String -> Maybe Matcher
buildMatcher String
reStr
    Maybe (String, String)
_ -> case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Maybe Matcher)
clientRegex ClientState
st of
           Maybe Matcher
Nothing -> forall a. Maybe a
Nothing
           Just Matcher
r  -> forall a. a -> Maybe a
Just Matcher
r

clientIsFiltered :: ClientState -> Bool
clientIsFiltered :: ClientState -> Bool
clientIsFiltered = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> Maybe Matcher
clientMatcher

clientFilter :: ClientState -> (a -> LText.Text) -> [a] -> [a]
clientFilter :: forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st a -> Text
f [a]
xs =
  case ClientState -> Maybe Matcher
clientMatcher ClientState
st of
    Maybe Matcher
Nothing -> [a]
xs
    Just Matcher
m ->
      forall {a}. [a] -> [a]
limit forall a b. (a -> b) -> a -> b
$
      forall a. Int -> Int -> (a -> Bool) -> [a] -> [a]
filterContext
        (Matcher -> Int
matcherAfter Matcher
m) -- client messages are stored in descending order
        (Matcher -> Int
matcherBefore Matcher
m)
        (Matcher -> Text -> Bool
matcherPred Matcher
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f)
        [a]
xs
     where
       limit :: [a] -> [a]
limit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Int -> [a] -> [a]
take (Matcher -> Maybe Int
matcherMax Matcher
m)

clientFilterChannels ::
  ClientState ->
  Maybe Int ->
  Maybe Int ->
  [(Identifier, Int, Text)] ->
  [(Identifier, Int, Text)]
clientFilterChannels :: ClientState
-> Maybe Int
-> Maybe Int
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
clientFilterChannels ClientState
st Maybe Int
min' (Just Int
max') =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\(Identifier
_, Int
users, Text
_) -> Int
users forall a. Ord a => a -> a -> Bool
< Int
max') forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState
-> Maybe Int
-> Maybe Int
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
clientFilterChannels ClientState
st Maybe Int
min' forall a. Maybe a
Nothing
clientFilterChannels ClientState
st (Just Int
min') Maybe Int
Nothing =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\(Identifier
_, Int
users, Text
_) -> Int
users forall a. Ord a => a -> a -> Bool
> Int
min') forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState
-> Maybe Int
-> Maybe Int
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
clientFilterChannels ClientState
st forall a. Maybe a
Nothing forall a. Maybe a
Nothing
clientFilterChannels ClientState
st Maybe Int
Nothing Maybe Int
Nothing = forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st forall {b}. (Identifier, b, Text) -> Text
filterOn
  where filterOn :: (Identifier, b, Text) -> Text
filterOn (Identifier
chan, b
_, Text
topic) = [Text] -> Text
LText.fromChunks [Identifier -> Text
idText Identifier
chan, Text
" ", Text
topic]

data MatcherArgs = MatcherArgs
  { MatcherArgs -> Int
argAfter     :: !Int
  , MatcherArgs -> Int
argBefore    :: !Int
  , MatcherArgs -> Bool
argInvert    :: !Bool
  , MatcherArgs -> Bool
argSensitive :: !Bool
  , MatcherArgs -> Maybe Int
argMax       :: Maybe Int
  , MatcherArgs -> Bool
argPlain     :: !Bool
  }

defaultMatcherArgs :: MatcherArgs
defaultMatcherArgs :: MatcherArgs
defaultMatcherArgs = MatcherArgs
  { argAfter :: Int
argAfter     = Int
0
  , argBefore :: Int
argBefore    = Int
0
  , argInvert :: Bool
argInvert    = Bool
False
  , argSensitive :: Bool
argSensitive = Bool
True
  , argMax :: Maybe Int
argMax       = forall a. Maybe a
Nothing
  , argPlain :: Bool
argPlain     = Bool
False
  }

buildMatcher :: String -> Maybe Matcher
buildMatcher :: String -> Maybe Matcher
buildMatcher = MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
defaultMatcherArgs
  where
    go :: MatcherArgs -> String -> Maybe Matcher
go !MatcherArgs
args String
reStr =
      case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
reStr of
        Char
'-' : Char
'i' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argSensitive :: Bool
argSensitive=Bool
False} String
reStr'
        Char
'-' : Char
'v' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argInvert :: Bool
argInvert=Bool
True} String
reStr'
        Char
'-' : Char
'F' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argPlain :: Bool
argPlain=Bool
True} String
reStr'
        Char
'-' : Char
'A' : String
reStr' | [(Int
a,Char
' ':String
reStr'')] <- forall a. Read a => ReadS a
reads String
reStr', Int
aforall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argAfter :: Int
argAfter=Int
a} String
reStr''
        Char
'-' : Char
'B' : String
reStr' | [(Int
b,Char
' ':String
reStr'')] <- forall a. Read a => ReadS a
reads String
reStr', Int
bforall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argBefore :: Int
argBefore=Int
b} String
reStr''
        Char
'-' : Char
'C' : String
reStr' | [(Int
c,Char
' ':String
reStr'')] <- forall a. Read a => ReadS a
reads String
reStr', Int
cforall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argAfter :: Int
argAfter=Int
c,argBefore :: Int
argBefore=Int
c} String
reStr''
        Char
'-' : Char
'm' : String
reStr' | [(Int
m,Char
' ':String
reStr'')] <- forall a. Read a => ReadS a
reads String
reStr', Int
mforall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argMax :: Maybe Int
argMax=forall a. a -> Maybe a
Just Int
m} String
reStr''
        Char
'-' : Char
'-' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
finish MatcherArgs
args String
reStr'
        String
_ -> MatcherArgs -> String -> Maybe Matcher
finish MatcherArgs
args String
reStr

    finish :: MatcherArgs -> String -> Maybe Matcher
finish MatcherArgs
args String
reStr
      | MatcherArgs -> Bool
argPlain MatcherArgs
args =
          if MatcherArgs -> Bool
argSensitive MatcherArgs
args
          then (Text -> Bool) -> Maybe Matcher
matcher (Text -> Text -> Bool
LText.isInfixOf (Text -> Text
LText.fromStrict (String -> Text
Text.pack String
reStr)))
          else (Text -> Bool) -> Maybe Matcher
matcher (Text -> Text -> Bool
LText.isInfixOf (Text -> Text
LText.fromStrict (Text -> Text
Text.toLower (String -> Text
Text.pack String
reStr))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toLower)
      | Bool
otherwise =
        case CompOption -> ExecOption -> String -> Either String Regex
compile forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt{caseSensitive :: Bool
caseSensitive=MatcherArgs -> Bool
argSensitive MatcherArgs
args}
                     forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt{captureGroups :: Bool
captureGroups=Bool
False}
                     String
reStr of
          Left{}  -> forall a. Maybe a
Nothing
          Right Regex
r -> (Text -> Bool) -> Maybe Matcher
matcher (forall regex source.
RegexLike regex source =>
regex -> source -> Bool
matchTest Regex
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LText.unpack)
      where
        matcher :: (Text -> Bool) -> Maybe Matcher
matcher Text -> Bool
f
          | MatcherArgs -> Bool
argInvert MatcherArgs
args = forall a. a -> Maybe a
Just (Int -> Int -> Maybe Int -> (Text -> Bool) -> Matcher
Matcher (MatcherArgs -> Int
argBefore MatcherArgs
args) (MatcherArgs -> Int
argAfter MatcherArgs
args) (MatcherArgs -> Maybe Int
argMax MatcherArgs
args) (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
f))
          | Bool
otherwise      = forall a. a -> Maybe a
Just (Int -> Int -> Maybe Int -> (Text -> Bool) -> Matcher
Matcher (MatcherArgs -> Int
argBefore MatcherArgs
args) (MatcherArgs -> Int
argAfter MatcherArgs
args) (MatcherArgs -> Maybe Int
argMax MatcherArgs
args) Text -> Bool
f)

-- | Compute the command and arguments currently in the textbox.
clientActiveCommand ::
  ClientState           {- ^ client state                     -} ->
  Maybe (String,String) {- ^ command name and argument string -}
clientActiveCommand :: ClientState -> Maybe (String, String)
clientActiveCommand ClientState
st =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
' ') (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'forall a. Eq a => a -> a -> Bool
==) (ClientState -> String
clientFirstLine ClientState
st)) of
    (Char
'/':String
cmd,Char
_:String
args) -> forall a. a -> Maybe a
Just (String
cmd,String
args)
    (String, String)
_                -> forall a. Maybe a
Nothing


-- | Remove a network connection and unlink it from the network map.
-- This operation assumes that the network connection exists and should
-- only be applied once per connection.
removeNetwork :: Text -> ClientState -> (NetworkState, ClientState)
removeNetwork :: Text -> ClientState -> (NetworkState, ClientState)
removeNetwork Text
network ClientState
st =
  case (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
network forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ forall a. Maybe a
Nothing) ClientState
st of
    (Maybe NetworkState
Nothing, ClientState
_  ) -> forall a. HasCallStack => String -> a
error String
"removeNetwork: network not found"
    (Just NetworkState
cs, ClientState
st1) -> (NetworkState
cs, ClientState
st1)

-- | Start a new connection. The delay is used for reconnections.
addConnection ::
  Int           {- ^ attempts                 -} ->
  Maybe UTCTime {- ^ optional disconnect time -} ->
  Maybe Int     {- ^ STS upgrade port         -} ->
  Text          {- ^ network name             -} ->
  ClientState ->
  IO ClientState
addConnection :: Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
attempts Maybe UTCTime
lastTime Maybe Int
stsUpgrade Text
network ClientState
st =
  do let defSettings :: ServerSettings
defSettings = (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 ServerSettings
configDefaults) ClientState
st)
                     { _ssName :: Maybe Text
_ssName = forall a. a -> Maybe a
Just Text
network
                     , _ssHostName :: String
_ssHostName = Text -> String
Text.unpack Text
network
                     }

     Either SecretException ServerSettings
eSettings0 <-
       forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$
       ServerSettings -> IO ServerSettings
loadSecrets forall a b. (a -> b) -> a -> b
$
       forall a. a -> Maybe a -> a
fromMaybe ServerSettings
defSettings forall a b. (a -> b) -> a -> b
$
       forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (HashMap Text ServerSettings)
configServers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
network) ClientState
st

     case Either SecretException ServerSettings
eSettings0 of
       Left (SecretException String
label String
err) ->
         do ZonedTime
now <- IO ZonedTime
getZonedTime
            let txt :: String
txt = String
"Failed loading secret \x02" forall a. Semigroup a => a -> a -> a
<> String
label forall a. Semigroup a => a -> a -> a
<> String
"\x02: " forall a. Semigroup a => a -> a -> a
<> String
err
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
network (String -> Text
Text.pack String
txt) ClientState
st

       Right ServerSettings
settings0 ->
         do ServerSettings
settings1 <- Maybe Int -> ServerSettings -> ClientState -> IO ServerSettings
applyStsPolicy Maybe Int
stsUpgrade ServerSettings
settings0 ClientState
st
            -- don't bother delaying on the first reconnect
            let delay :: Int
delay = Int
15 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max Int
0 (Int
attempts forall a. Num a => a -> a -> a
- Int
1)
            NetworkConnection
c <- Int -> ServerSettings -> IO NetworkConnection
createConnection Int
delay ServerSettings
settings1
            StdGen
seed <- forall (m :: * -> *). MonadIO m => m StdGen
Random.newStdGen
            let restrict :: ConnectRestriction
restrict = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
settings1 of
                             TlsMode
TlsStart -> ConnectRestriction
StartTLSRestriction
                             TlsMode
TlsYes   -> ConnectRestriction
WaitTLSRestriction
                             TlsMode
TlsNo    -> ConnectRestriction
NoRestriction
                cs :: NetworkState
cs = Text
-> ServerSettings
-> NetworkConnection
-> PingStatus
-> StdGen
-> NetworkState
newNetworkState Text
network ServerSettings
settings1 NetworkConnection
c
                       (Int -> Maybe UTCTime -> ConnectRestriction -> PingStatus
PingConnecting Int
attempts Maybe UTCTime
lastTime ConnectRestriction
restrict) StdGen
seed
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) (NetworkState -> [RawIrcMsg]
initialMessages 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. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
network) (forall a. a -> Maybe a
Just NetworkState
cs) ClientState
st)

applyStsPolicy :: Maybe Int -> ServerSettings -> ClientState -> IO ServerSettings
applyStsPolicy :: Maybe Int -> ServerSettings -> ClientState -> IO ServerSettings
applyStsPolicy Maybe Int
stsUpgrade ServerSettings
settings ClientState
st =
  do UTCTime
now <- IO UTCTime
getCurrentTime
     let stsUpgrade' :: Maybe Int
stsUpgrade'
           | Just{} <- Maybe Int
stsUpgrade = Maybe Int
stsUpgrade
           | TlsMode
TlsNo <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings TlsMode
ssTls ServerSettings
settings
           , let host :: Text
host = String -> Text
Text.pack (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings String
ssHostName ServerSettings
settings)
           , Just StsPolicy
policy <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState (HashMap Text StsPolicy)
clientStsPolicy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
host) ClientState
st
           , UTCTime
now forall a. Ord a => a -> a -> Bool
< forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' StsPolicy UTCTime
stsExpiration StsPolicy
policy
           = forall a. a -> Maybe a
Just (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' StsPolicy Int
stsPort StsPolicy
policy)
           | Bool
otherwise = forall a. Maybe a
Nothing
     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe Int
stsUpgrade' of
              Just Int
port -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ServerSettings (Maybe PortNumber)
ssPort (forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port))
                         forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ServerSettings TlsMode
ssTls TlsMode
TlsYes ServerSettings
settings
              Maybe Int
Nothing   -> ServerSettings
settings

applyMessageToClientState ::
  ZonedTime                  {- ^ timestamp                -} ->
  IrcMsg                     {- ^ message received         -} ->
  Text                       {- ^ network name             -} ->
  NetworkState               {- ^ network connection state -} ->
  ClientState                {- ^ client state             -} ->
  ([RawIrcMsg], ClientState) {- ^ response , updated state -}
applyMessageToClientState :: ZonedTime
-> IrcMsg
-> Text
-> NetworkState
-> ClientState
-> ([RawIrcMsg], ClientState)
applyMessageToClientState ZonedTime
time IrcMsg
irc Text
network NetworkState
cs ClientState
st =
  NetworkState
cs' seq :: forall a b. a -> b -> b
`seq` ([RawIrcMsg]
reply, ClientState
st')
  where
    Apply [RawIrcMsg]
reply NetworkState
cs' = ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage ZonedTime
time IrcMsg
irc NetworkState
cs
    st' :: ClientState
st' = Text -> IrcMsg -> ClientState -> ClientState
applyWindowRenames Text
network IrcMsg
irc
        forall a b. (a -> b) -> a -> b
$ 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) NetworkState
cs' ClientState
st

-- | When a nick change happens and there is an open query window for that nick
-- and there isn't an open query window for the new nick, rename the window.
applyWindowRenames ::
  Text {- ^ network -} ->
  IrcMsg               ->
  ClientState -> ClientState
applyWindowRenames :: Text -> IrcMsg -> ClientState -> ClientState
applyWindowRenames Text
network (Nick Source
old Identifier
new) ClientState
st
  | Identifier -> Bool
hasWindow Identifier
old'
  , Bool -> Bool
not (Identifier -> Bool
hasWindow Identifier
new) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Focus
clientFocus Focus -> Focus
moveFocus
                        forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> Map Focus Window
moveWindow ClientState
st
  | Bool
otherwise = ClientState
st
  where
    old' :: Identifier
old' = UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
old)

    mkFocus :: Identifier -> Focus
mkFocus = Text -> Identifier -> Focus
ChannelFocus Text
network

    hasWindow :: Identifier -> Bool
hasWindow Identifier
who = forall s a. Getting Any s a -> s -> Bool
has (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Identifier -> Focus
mkFocus Identifier
who)) ClientState
st

    moveWindow :: Map Focus Window -> Map Focus Window
    moveWindow :: Map Focus Window -> Map Focus Window
moveWindow Map Focus Window
wins =
      let (Maybe Window
win,Map Focus Window
wins') = (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Identifier -> Focus
mkFocus Identifier
old') forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ forall a. Maybe a
Nothing) Map Focus Window
wins
      in forall s t a b. ASetter s t a b -> b -> s -> t
set (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Identifier -> Focus
mkFocus Identifier
new)) Maybe Window
win Map Focus Window
wins'

    moveFocus :: Focus -> Focus
moveFocus Focus
x
      | Focus
x forall a. Eq a => a -> a -> Bool
== Identifier -> Focus
mkFocus Identifier
old' = Identifier -> Focus
mkFocus Identifier
new
      | Bool
otherwise         = Focus
x

applyWindowRenames Text
_ IrcMsg
_ ClientState
st = ClientState
st


------------------------------------------------------------------------
-- Scrolling
------------------------------------------------------------------------

-- | Scroll the current buffer to show newer messages
scrollClient :: Int -> ClientState -> ClientState
scrollClient :: Int -> ClientState -> ClientState
scrollClient Int
amt = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Int
clientScroll forall a b. (a -> b) -> a -> b
$ \Int
n -> forall a. Ord a => a -> a -> a
max Int
0 (Int
n forall a. Num a => a -> a -> a
+ Int
amt)


-- | List of extra focuses to display as split windows
clientExtraFocuses :: ClientState -> [(Focus, Subfocus)]
clientExtraFocuses :: ClientState -> [(Focus, Subfocus)]
clientExtraFocuses ClientState
st =
  forall a. Eq a => a -> [a] -> [a]
delete
    (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st)
    (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st)

------------------------------------------------------------------------
-- Focus Management
------------------------------------------------------------------------

-- | 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.
jumpToActivity :: ClientState -> ClientState
jumpToActivity :: ClientState -> ClientState
jumpToActivity ClientState
st =
  case forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe (Focus, Window)
highPriority Maybe (Focus, Window)
lowPriority of
    Just (Focus
focus,Window
_) -> Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
    Maybe (Focus, Window)
Nothing ->
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Maybe Focus)
clientActivityReturn ClientState
st of
        Just Focus
focus -> Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
        Maybe Focus
Nothing    -> ClientState
st
  where
    windowList :: [(Focus, Window)]
windowList   = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (Map Focus Window)
clientWindows forall k a. Map k a -> [(k, a)]
Map.toAscList ClientState
st
    highPriority :: Maybe (Focus, Window)
highPriority = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Focus, Window)
x -> WindowLineImportance
WLImportant forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention (forall a b. (a, b) -> b
snd (Focus, Window)
x)) [(Focus, Window)]
windowList
    lowPriority :: Maybe (Focus, Window)
lowPriority  = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Focus, Window)
x -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winUnread (forall a b. (a, b) -> b
snd (Focus, Window)
x) forall a. Ord a => a -> a -> Bool
> Int
0) [(Focus, Window)]
windowList

-- | Jump the focus directly to a window based on its zero-based index
-- while ignoring hidden windows.
jumpFocus ::
  Char {- ^ window name -} ->
  ClientState -> ClientState
jumpFocus :: Char -> ClientState -> ClientState
jumpFocus Char
i ClientState
st =
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a}. (a, Window) -> Bool
p (forall k a. Map k a -> [(k, a)]
Map.assocs (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st)) of
    Maybe (Focus, Window)
Nothing        -> ClientState
st
    Just (Focus
focus,Window
_) -> Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
  where
    p :: (a, Window) -> Bool
p (a
_, Window
w) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Char)
winName Window
w forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Char
i


-- | Change the window focus to the given value, reset the subfocus
-- to message view, reset the scroll, remember the previous focus
-- if it changed.
changeFocus ::
  Focus       {- ^ new focus    -} ->
  ClientState {- ^ client state -} ->
  ClientState
changeFocus :: Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Int
clientScroll Int
0
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
activateCurrent
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
deactivatePrevious
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
updatePrevious
  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' ClientState Focus
clientFocus Focus
focus
  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' ClientState Subfocus
clientSubfocus Subfocus
FocusMessages
  forall a b. (a -> b) -> a -> b
$ ClientState
st
  where
    oldFocus :: Focus
oldFocus = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st

    updatePrevious :: ClientState -> ClientState
updatePrevious
      | Focus
focus forall a. Eq a => a -> a -> Bool
== Focus
oldFocus = forall a. a -> a
id
      | Bool
otherwise         = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Focus
clientPrevFocus Focus
oldFocus

    -- always activate the new window. If it was already active this
    -- will clear the marker.
    activateCurrent :: ClientState -> ClientState
activateCurrent = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus) Window -> Window
windowActivate

    -- Don't deactivate a window if it's going to stay active
    deactivatePrevious :: ClientState -> ClientState
deactivatePrevious
      | (Focus
oldFocus, Subfocus
FocusMessages) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Focus
focus, Subfocus
FocusMessages) forall a. a -> [a] -> [a]
: forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st = forall a. a -> a
id
      | Bool
otherwise = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
oldFocus) Window -> Window
windowDeactivate


-- | Unified logic for assigning to the extra focuses field that activates
-- and deactivates windows as needed.
setExtraFocus :: [(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus :: [(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus [(Focus, Subfocus)]
newFocuses ClientState
st
  = forall {t :: * -> *}.
Foldable t =>
(Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
windowDeactivate [Focus]
newlyInactive
  forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
Foldable t =>
(Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
windowActivate   [Focus]
newlyActive
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus [(Focus, Subfocus)]
newFocuses ClientState
st
  where
    messagePart :: [(a, Subfocus)] -> [a]
messagePart [(a, Subfocus)]
x = [a
focus | (a
focus, Subfocus
FocusMessages) <- [(a, Subfocus)]
x]

    current :: (Focus, Subfocus)
current = (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st)

    newlyActive :: [Focus]
newlyActive = forall {a}. [(a, Subfocus)] -> [a]
messagePart [(Focus, Subfocus)]
newFocuses forall a. Eq a => [a] -> [a] -> [a]
\\ forall {a}. [(a, Subfocus)] -> [a]
messagePart ((Focus, Subfocus)
current forall a. a -> [a] -> [a]
: forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st)

    newlyInactive :: [Focus]
newlyInactive = forall {a}. [(a, Subfocus)] -> [a]
messagePart (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st)
                 forall a. Eq a => [a] -> [a] -> [a]
\\ forall {a}. [(a, Subfocus)] -> [a]
messagePart ((Focus, Subfocus)
current forall a. a -> [a] -> [a]
: [(Focus, Subfocus)]
newFocuses)

    aux :: (Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
f t Focus
xs ClientState
st1 =
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ClientState
acc Focus
w -> forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
w) Window -> Window
f ClientState
acc) ClientState
st1 t Focus
xs


-- | Change the subfocus to the given value, preserve the focus, reset
-- the scroll.
changeSubfocus ::
  Subfocus    {- ^ new subfocus -} ->
  ClientState {- ^ client state -} ->
  ClientState
changeSubfocus :: Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
focus
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Text)
clientErrorMsg forall a. Maybe a
Nothing
  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' ClientState Int
clientScroll Int
0
  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' ClientState Subfocus
clientSubfocus Subfocus
focus

-- | Return to previously focused window.
returnFocus :: ClientState -> ClientState
returnFocus :: ClientState -> ClientState
returnFocus ClientState
st = Focus -> ClientState -> ClientState
changeFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientPrevFocus ClientState
st) ClientState
st

-- | Step focus to the next window when on message view. Otherwise
-- switch to message view.
advanceFocus :: ClientState -> ClientState
advanceFocus :: ClientState -> ClientState
advanceFocus = FocusSelector -> ClientState -> ClientState
stepFocus forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Focus Window
r forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Focus Window
l

-- | Step focus to the previous window when on message view. Otherwise
-- switch to message view.
retreatFocus :: ClientState -> ClientState
retreatFocus :: ClientState -> ClientState
retreatFocus = FocusSelector -> ClientState -> ClientState
stepFocus forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Focus Window
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Focus Window
r

-- | Step focus to the next window when on message view. Otherwise
-- switch to message view.
advanceNetworkFocus :: ClientState -> ClientState
advanceNetworkFocus :: ClientState -> ClientState
advanceNetworkFocus = FocusSelector -> ClientState -> ClientState
stepFocus forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey forall {p}. Focus -> p -> Bool
isNetwork Map Focus Window
r) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey forall {p}. Focus -> p -> Bool
isNetwork Map Focus Window
l)
  where
    isNetwork :: Focus -> p -> Bool
isNetwork Focus
k p
_ = forall s a. Getting Any s a -> s -> Bool
has Prism' Focus Text
_NetworkFocus Focus
k

-- | Selection function used in 'stepFocus'
type FocusSelector =
  Map Focus Window {- ^ windows before current window -} ->
  Map Focus Window {- ^ windows after current window  -} ->
  Maybe Focus      {- ^ window to focus               -}

-- | Step focus to the next window when on message view. Otherwise
-- switch to message view. Reverse the step order when argument is 'True'.
stepFocus ::
  FocusSelector {- ^ selection function -} ->
  ClientState   {- ^ client state       -} ->
  ClientState
stepFocus :: FocusSelector -> ClientState -> ClientState
stepFocus FocusSelector
selector ClientState
st =
  case FocusSelector
selector Map Focus Window
l Map Focus Window
r of
    Just Focus
k  -> Focus -> ClientState -> ClientState
changeFocus Focus
k ClientState
st
    Maybe Focus
Nothing -> ClientState
st
  where
    (Map Focus Window
l,Map Focus Window
r) = forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st)
          forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' Window Bool
winHidden Bool -> Bool
not)
          forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st

clientHighlightsFocus ::
  Focus ->
  ClientState ->
  HashMap Identifier Highlight
clientHighlightsFocus :: Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus Focus
focus ClientState
st =
  case Focus
focus of
    ChannelFocus Text
n Identifier
c -> Text -> Maybe Identifier -> HashMap Identifier Highlight
netcase Text
n (forall a. a -> Maybe a
Just Identifier
c)
    NetworkFocus Text
n   -> Text -> Maybe Identifier -> HashMap Identifier Highlight
netcase Text
n forall a. Maybe a
Nothing
    Focus
Unfocused        -> HashMap Identifier Highlight
base
  where
    base :: HashMap Identifier Highlight
base = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Identifier
x, Highlight
HighlightMe) | Identifier
x <- 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 [Identifier]
configExtraHighlights) ClientState
st]
        forall a. Semigroup a => a -> a -> a
<> forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Identifier
x, Highlight
HighlightNone) | Identifier
x <- 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 [Identifier]
configNeverHighlights) ClientState
st]
        forall a. Semigroup a => a -> a -> a
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (HashMap Identifier Highlight)
clientHighlights ClientState
st

    replace :: Highlight -> Highlight -> Highlight
replace Highlight
x Highlight
y =
      case Highlight
x of
        Highlight
HighlightError -> Highlight
y
        Highlight
_              -> Highlight
x

    netcase :: Text -> Maybe Identifier -> HashMap Identifier Highlight
netcase Text
n Maybe Identifier
mbC =
      case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
n) ClientState
st of
        Maybe NetworkState
Nothing -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (HashMap Identifier Highlight)
clientHighlights ClientState
st
        Just NetworkState
cs ->
          forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
            Highlight -> Highlight -> Highlight
replace
            (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs) Highlight
HighlightMe HashMap Identifier Highlight
base)
            (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Identifier
u, Highlight
HighlightNick)
                                | Just Identifier
c <- [Maybe Identifier
mbC]
                                , Identifier
u <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers) forall k v. HashMap k v -> [k]
HashMap.keys NetworkState
cs
                                , Text -> Int
Text.length (Identifier -> Text
idText Identifier
u) forall a. Ord a => a -> a -> Bool
> Int
1 ])

-- | Produce the list of window names configured for the client.
clientWindowNames ::
  ClientState ->
  [Char]
clientWindowNames :: ClientState -> String
clientWindowNames = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration Text
configWindowNames) Text -> String
Text.unpack

-- | Produce the list of window names configured for the client.
clientPalette :: ClientState -> Palette
clientPalette :: ClientState -> Palette
clientPalette = 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 Palette
configPalette)

-- | Returns the list of network names that requested autoconnection.
clientAutoconnects :: ClientState -> [Text]
clientAutoconnects :: ClientState -> [Text]
clientAutoconnects ClientState
st =
  [ Text
network | (Text
network, ServerSettings
cfg) <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (HashMap Text ServerSettings)
configServers) forall k v. HashMap k v -> [(k, v)]
HashMap.toList ClientState
st
            , forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ServerSettings Bool
ssAutoconnect ServerSettings
cfg
            ]

-- | Toggle the /hide metadata/ setting for the focused window.
clientToggleHideMeta :: ClientState -> ClientState
clientToggleHideMeta :: ClientState -> ClientState
clientToggleHideMeta ClientState
st =
  forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window Bool
winHideMeta) Bool -> Bool
not ClientState
st

-- | Generates the NetworkPalette for the current focus.
clientNetworkPalette :: ClientState -> NetworkPalette
clientNetworkPalette :: ClientState -> NetworkPalette
clientNetworkPalette ClientState
st = case Focus -> Maybe Text
focusNetwork (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) of
  Just Text
net -> Text -> Configuration -> NetworkPalette
configNetworkPalette Text
net (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Configuration
clientConfig ClientState
st)
  Maybe Text
Nothing  -> NetworkPalette
defaultNetworkPalette