{-# 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
  , clientHelp

  , 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.Help
import           Client.State.Network
import           Client.State.Window
import           Client.State.Target (MessageTarget(..))
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 hiding (MessageTarget(..))
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
  , ClientState -> HelpState
_clientHelp              :: !HelpState                -- ^ cached help text
  }

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 = (HashMap Text NetworkState -> f (HashMap Text NetworkState))
-> ClientState -> f ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState -> f (HashMap Text NetworkState))
 -> ClientState -> f ClientState)
-> ((NetworkState -> f NetworkState)
    -> HashMap Text NetworkState -> f (HashMap Text NetworkState))
-> (NetworkState -> f NetworkState)
-> ClientState
-> f ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Traversal'
     (HashMap Text NetworkState) (IxValue (HashMap Text NetworkState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text NetworkState)
network

-- | The full top-most line that would be executed
clientFirstLine :: ClientState -> String
clientFirstLine :: ClientState -> String
clientFirstLine = (String, Content) -> String
forall a b. (a, b) -> a
fst ((String, Content) -> String)
-> (ClientState -> (String, Content)) -> ClientState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> (String, Content)
Edit.shift (Content -> (String, Content))
-> (ClientState -> Content) -> ClientState -> (String, Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Content ClientState Content -> ClientState -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((EditBox -> Const Content EditBox)
-> ClientState -> Const Content ClientState
Lens' ClientState EditBox
clientTextBox ((EditBox -> Const Content EditBox)
 -> ClientState -> Const Content ClientState)
-> ((Content -> Const Content Content)
    -> EditBox -> Const Content EditBox)
-> Getting Content ClientState Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Const Content Content)
-> EditBox -> Const Content EditBox
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 = LensLike' (Const (Int, String)) ClientState Line
-> (Line -> (Int, String)) -> ClientState -> (Int, String)
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((EditBox -> Const (Int, String) EditBox)
-> ClientState -> Const (Int, String) ClientState
Lens' ClientState EditBox
clientTextBox ((EditBox -> Const (Int, String) EditBox)
 -> ClientState -> Const (Int, String) ClientState)
-> ((Line -> Const (Int, String) Line)
    -> EditBox -> Const (Int, String) EditBox)
-> LensLike' (Const (Int, String)) ClientState Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Const (Int, String) Line)
-> EditBox -> Const (Int, String) EditBox
forall c. HasLine c => Lens' c Line
Lens' EditBox 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 =

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

  do TQueue NetworkEvent
events    <- STM (TQueue NetworkEvent) -> IO (TQueue NetworkEvent)
forall a. STM a -> IO a
atomically STM (TQueue NetworkEvent)
forall a. STM (TQueue a)
newTQueue
     TQueue (Int, ThreadEntry)
threadQueue <- STM (TQueue (Int, ThreadEntry)) -> IO (TQueue (Int, ThreadEntry))
forall a. STM a -> IO a
atomically STM (TQueue (Int, ThreadEntry))
forall a. STM (TQueue a)
newTQueue
     HashMap Text StsPolicy
sts       <- IO (HashMap Text StsPolicy)
readPolicyFile
     let ignoreIds :: [Identifier]
ignoreIds = (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId (Getting [Text] Configuration [Text] -> Configuration -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] Configuration [Text]
Lens' Configuration [Text]
configIgnores Configuration
cfg)
     ClientState -> IO a
k ClientState
        { _clientWindows :: Map Focus Window
_clientWindows           = Tagged () (Identity ())
-> Tagged (Map Focus Window) (Identity (Map Focus Window))
forall a. AsEmpty a => Prism' a ()
Prism' (Map Focus Window) ()
_Empty (Tagged () (Identity ())
 -> Tagged (Map Focus Window) (Identity (Map Focus Window)))
-> () -> Map Focus Window
forall t b. AReview t b -> b -> t
# ()
        , _clientIgnores :: HashSet Identifier
_clientIgnores           = [Identifier] -> HashSet Identifier
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       = Tagged () (Identity ())
-> Tagged
     (HashMap Text NetworkState) (Identity (HashMap Text NetworkState))
forall a. AsEmpty a => Prism' a ()
Prism' (HashMap Text NetworkState) ()
_Empty (Tagged () (Identity ())
 -> Tagged
      (HashMap Text NetworkState) (Identity (HashMap Text NetworkState)))
-> () -> HashMap Text NetworkState
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    = Maybe Focus
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             = Maybe Matcher
forall a. Maybe a
Nothing
        , _clientLayout :: LayoutMode
_clientLayout            = Getting LayoutMode Configuration LayoutMode
-> Configuration -> LayoutMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LayoutMode Configuration LayoutMode
Lens' Configuration LayoutMode
configLayout Configuration
cfg
        , _clientEditMode :: EditMode
_clientEditMode          = EditMode
SingleLineEditor
        , _clientEditLock :: Bool
_clientEditLock          = Bool
False
        , _clientActivityBar :: Bool
_clientActivityBar       = Getting Bool Configuration Bool -> Configuration -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Configuration Bool
Lens' Configuration Bool
configActivityBar Configuration
cfg
        , _clientShowPing :: Bool
_clientShowPing          = Getting Bool Configuration Bool -> Configuration -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Configuration Bool
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          = Maybe Text
forall a. Maybe a
Nothing
        , _clientRtsStats :: Maybe Stats
_clientRtsStats          = Maybe Stats
forall a. Maybe a
Nothing
        , _clientStsPolicy :: HashMap Text StsPolicy
_clientStsPolicy         = HashMap Text StsPolicy
sts
        , _clientHighlights :: HashMap Identifier Highlight
_clientHighlights        = HashMap Identifier Highlight
forall k v. HashMap k v
HashMap.empty
        , _clientHelp :: HelpState
_clientHelp              = Maybe Text -> [Image'] -> HelpState
makeHelp Maybe Text
forall a. Maybe a
Nothing []
        }

withExtensionState :: (ExtensionState -> IO a) -> IO a
withExtensionState :: forall a. (ExtensionState -> IO a) -> IO a
withExtensionState ExtensionState -> IO a
k =
  do MVar ParkState
mvar <- IO (MVar ParkState)
forall a. IO (MVar a)
newEmptyMVar
     IO (StablePtr (MVar ParkState))
-> (StablePtr (MVar ParkState) -> IO ())
-> (StablePtr (MVar ParkState) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (MVar ParkState -> IO (StablePtr (MVar ParkState))
forall a. a -> IO (StablePtr a)
newStablePtr MVar ParkState
mvar) StablePtr (MVar ParkState) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr ((StablePtr (MVar ParkState) -> IO a) -> IO a)
-> (StablePtr (MVar ParkState) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \StablePtr (MVar ParkState)
stab ->
       ExtensionState -> IO a
k ExtensionState
         { _esActive :: IntMap ActiveExtension
_esActive    = IntMap ActiveExtension
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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
    Maybe NetworkState
Nothing -> ClientState -> IO ClientState
forall a. a -> IO a
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 (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
                  -- unassociate this network name from this network id
                  ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
-> (HashMap Text NetworkState -> HashMap Text NetworkState)
-> ClientState
-> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections (Index (HashMap Text NetworkState)
-> HashMap Text NetworkState -> HashMap Text NetworkState
forall m. At m => Index m -> m -> m
sans Text
Index (HashMap Text NetworkState)
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'
  (ClientState -> ClientState) -> ClientState -> ClientState
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 ClientState
-> Getting (Endo NetworkState) ClientState NetworkState
-> NetworkState
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Getting (Endo NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
    possibleStatusModes :: String
possibleStatusModes     = Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String NetworkState String
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 Getting Bool NetworkState Bool -> NetworkState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const Bool ServerSettings)
-> NetworkState -> Const Bool NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const Bool ServerSettings)
 -> NetworkState -> Const Bool NetworkState)
-> ((Bool -> Const Bool Bool)
    -> ServerSettings -> Const Bool ServerSettings)
-> Getting Bool NetworkState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ServerSettings -> Const Bool ServerSettings
Lens' ServerSettings Bool
ssShowAccounts) NetworkState
cs
      then HashMap Identifier UserAndHost
-> Maybe (HashMap Identifier UserAndHost)
forall a. a -> Maybe a
Just (Getting
  (HashMap Identifier UserAndHost)
  NetworkState
  (HashMap Identifier UserAndHost)
-> NetworkState -> HashMap Identifier UserAndHost
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier UserAndHost)
  NetworkState
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers NetworkState
cs)
      else Maybe (HashMap Identifier UserAndHost)
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 Getting (Maybe String) ClientState (Maybe String)
-> ClientState -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> LensLike' (Const (Maybe String)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection (Getting Text ClientMessage Text -> ClientMessage -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ClientMessage Text
Lens' ClientMessage Text
msgNetwork ClientMessage
msg) LensLike' (Const (Maybe String)) ClientState NetworkState
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> NetworkState -> Const (Maybe String) NetworkState)
-> Getting (Maybe String) ClientState (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const (Maybe String) ServerSettings)
-> NetworkState -> Const (Maybe String) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (Maybe String) ServerSettings)
 -> NetworkState -> Const (Maybe String) NetworkState)
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> ServerSettings -> Const (Maybe String) ServerSettings)
-> (Maybe String -> Const (Maybe String) (Maybe String))
-> NetworkState
-> Const (Maybe String) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Const (Maybe String) (Maybe String))
-> ServerSettings -> Const (Maybe String) ServerSettings
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  -> ASetter ClientState ClientState [LogLine] [LogLine]
-> ([LogLine] -> [LogLine]) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState [LogLine] [LogLine]
Lens' ClientState [LogLine]
clientLogQueue (LogLine -> [LogLine] -> [LogLine]
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 (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = Getting Text ClientMessage Text -> ClientMessage -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ClientMessage Text
Lens' ClientMessage Text
msgNetwork ClientMessage
msg
      me :: Maybe Identifier
me      = Getting (First Identifier) ClientState Identifier
-> ClientState -> Maybe Identifier
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text
-> LensLike' (Const (First Identifier)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike' (Const (First Identifier)) ClientState NetworkState
-> ((Identifier -> Const (First Identifier) Identifier)
    -> NetworkState -> Const (First Identifier) NetworkState)
-> Getting (First Identifier) ClientState Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Const (First Identifier) Identifier)
-> NetworkState -> Const (First Identifier) NetworkState
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  = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
x Maybe Identifier -> Maybe Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Identifier
me
      checkTxt :: Text -> WindowLineImportance
checkTxt Text
txt
        | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
x -> Highlight -> Maybe Highlight
forall a. a -> Maybe a
Just Highlight
HighlightMe Maybe Highlight -> Maybe Highlight -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier -> HashMap Identifier Highlight -> Maybe Highlight
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 Getting MessageBody ClientMessage MessageBody
-> ClientMessage -> MessageBody
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MessageBody ClientMessage MessageBody
Lens' ClientMessage MessageBody
msgBody ClientMessage
msg of
    NormalBody{} -> WindowLineImportance
WLImportant
    ErrorBody{}  -> WindowLineImportance
WLImportant
    IrcBody IrcMsg
irc
      | IrcMsg -> Bool
squelchIrcMsg IrcMsg
irc -> WindowLineImportance
WLBoring
      | Maybe Identifier -> Bool
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
        Invite Source
_ Identifier
tgt Identifier
_    | Identifier -> Bool
isMe Identifier
tgt    -> 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
    Invite Source
who Identifier
_ Identifier
_       -> Source -> Maybe Identifier
checkUser Source
who
    IrcMsg
_                    -> Maybe Identifier
forall a. Maybe a
Nothing
  where
    checkUser :: Source -> Maybe Identifier
checkUser !Source
who
      | UserInfo -> ClientState -> Bool
identIgnored (Source -> UserInfo
srcUser Source
who) ClientState
st = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
who))
      | Bool
otherwise = Maybe Identifier
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 (Getting Mask ClientState Mask -> ClientState -> Mask
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Mask ClientState Mask
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 (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$
  case MessageTarget
target of
    MessageTarget
TargetDrop         -> ClientState
st
    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 (IrcMsg -> Maybe Source) -> Maybe IrcMsg -> Maybe Source
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (First IrcMsg) ClientMessage IrcMsg
-> ClientMessage -> Maybe IrcMsg
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((MessageBody -> Const (First IrcMsg) MessageBody)
-> ClientMessage -> Const (First IrcMsg) ClientMessage
Lens' ClientMessage MessageBody
msgBody ((MessageBody -> Const (First IrcMsg) MessageBody)
 -> ClientMessage -> Const (First IrcMsg) ClientMessage)
-> ((IrcMsg -> Const (First IrcMsg) IrcMsg)
    -> MessageBody -> Const (First IrcMsg) MessageBody)
-> Getting (First IrcMsg) ClientMessage IrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IrcMsg -> Const (First IrcMsg) IrcMsg)
-> MessageBody -> Const (First IrcMsg) MessageBody
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 =
    Getting String ClientState String -> ClientState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting String ClientState String -> ClientState -> String)
-> Getting String ClientState String -> ClientState -> String
forall a b. (a -> b) -> a -> b
$ Text -> LensLike' (Const String) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
         LensLike' (Const String) ClientState NetworkState
-> Getting String NetworkState String
-> Getting String ClientState String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const String (HashMap Identifier ChannelState))
-> NetworkState -> Const String NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const String (HashMap Identifier ChannelState))
 -> NetworkState -> Const String NetworkState)
-> ((String -> Const String String)
    -> HashMap Identifier ChannelState
    -> Const String (HashMap Identifier ChannelState))
-> Getting String NetworkState String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel
         ((ChannelState -> Const String ChannelState)
 -> HashMap Identifier ChannelState
 -> Const String (HashMap Identifier ChannelState))
-> ((String -> Const String String)
    -> ChannelState -> Const String ChannelState)
-> (String -> Const String String)
-> HashMap Identifier ChannelState
-> Const String (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const String (HashMap Identifier String))
-> ChannelState -> Const String ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers  ((HashMap Identifier String
  -> Const String (HashMap Identifier String))
 -> ChannelState -> Const String ChannelState)
-> ((String -> Const String String)
    -> HashMap Identifier String
    -> Const String (HashMap Identifier String))
-> (String -> Const String String)
-> ChannelState
-> Const String ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier String)
-> Traversal'
     (HashMap Identifier String) (IxValue (HashMap Identifier String))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier String)
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
  | Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Focus
destination = ClientState
st
  | Bool
otherwise =

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

  case Getting MessageBody ClientMessage MessageBody
-> ClientMessage -> MessageBody
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MessageBody ClientMessage MessageBody
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
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
                            (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine Focus
focus WindowLine
wl ClientState
st
  where
    network :: Text
network    = Getting Text ClientMessage Text -> ClientMessage -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ClientMessage Text
Lens' ClientMessage Text
msgNetwork ClientMessage
msg
    focus :: Focus
focus      | Text -> Bool
Text.null Text
network = Focus
Unfocused
               | Bool
otherwise         = Text -> Focus
NetworkFocus (Getting Text ClientMessage Text -> ClientMessage -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ClientMessage Text
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 = (ClientState -> Identifier -> ClientState)
-> ClientState -> [Identifier] -> ClientState
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = (Map Focus Window -> f (Map Focus Window))
-> ClientState -> f ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> f (Map Focus Window))
 -> ClientState -> f ClientState)
-> ((Window -> f Window)
    -> Map Focus Window -> f (Map Focus Window))
-> (Window -> f Window)
-> ClientState
-> f ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
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 = LensLike ((,) StrictUnit) ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> ClientState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict (Identifier
-> LensLike ((,) StrictUnit) ClientState ClientState Window Window
forall {f :: * -> *}.
Applicative f =>
Identifier -> (Window -> f Window) -> ClientState -> f ClientState
windowsLens Identifier
chan) ((Window, Bool) -> Window
forall a b. (a, b) -> a
fst ((Window, Bool) -> Window)
-> (Window -> (Window, Bool)) -> Window -> Window
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
          Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: case Getting
  (First (HashMap Identifier ChannelState))
  ClientState
  (HashMap Identifier ChannelState)
-> ClientState -> Maybe (HashMap Identifier ChannelState)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text
-> LensLike'
     (Const (First (HashMap Identifier ChannelState)))
     ClientState
     NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike'
  (Const (First (HashMap Identifier ChannelState)))
  ClientState
  NetworkState
-> ((HashMap Identifier ChannelState
     -> Const
          (First (HashMap Identifier ChannelState))
          (HashMap Identifier ChannelState))
    -> NetworkState
    -> Const (First (HashMap Identifier ChannelState)) NetworkState)
-> Getting
     (First (HashMap Identifier ChannelState))
     ClientState
     (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const
      (First (HashMap Identifier ChannelState))
      (HashMap Identifier ChannelState))
-> NetworkState
-> Const (First (HashMap Identifier ChannelState)) NetworkState
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) <- HashMap Identifier ChannelState -> [(Identifier, ChannelState)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Identifier ChannelState
m
                               , Identifier -> HashMap Identifier String -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Identifier
user (Getting
  (HashMap Identifier String)
  ChannelState
  (HashMap Identifier String)
-> ChannelState -> HashMap Identifier String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier String)
  ChannelState
  (HashMap Identifier String)
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 (WindowHint -> Maybe Char) -> Maybe WindowHint -> Maybe Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hint, Char
n Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
usedNames = Char
n
  | Char
c:String
_ <- String
availableNames String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
\\ String
usedNames    = Char
c
  | Bool
otherwise                             = Char
'\0'
  where
    usedNames :: String
usedNames = Getting (Endo String) ClientState Char -> ClientState -> String
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Map Focus Window -> Const (Endo String) (Map Focus Window))
-> ClientState -> Const (Endo String) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (Endo String) (Map Focus Window))
 -> ClientState -> Const (Endo String) ClientState)
-> ((Char -> Const (Endo String) Char)
    -> Map Focus Window -> Const (Endo String) (Map Focus Window))
-> Getting (Endo String) ClientState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Const (Endo String) Window)
-> Map Focus Window -> Const (Endo String) (Map Focus Window)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Map Focus Window) Window
folded ((Window -> Const (Endo String) Window)
 -> Map Focus Window -> Const (Endo String) (Map Focus Window))
-> ((Char -> Const (Endo String) Char)
    -> Window -> Const (Endo String) Window)
-> (Char -> Const (Endo String) Char)
-> Map Focus Window
-> Const (Endo String) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> Const (Endo String) (Maybe Char))
-> Window -> Const (Endo String) Window
Lens' Window (Maybe Char)
winName ((Maybe Char -> Const (Endo String) (Maybe Char))
 -> Window -> Const (Endo String) Window)
-> ((Char -> Const (Endo String) Char)
    -> Maybe Char -> Const (Endo String) (Maybe Char))
-> (Char -> Const (Endo String) Char)
-> Window
-> Const (Endo String) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const (Endo String) Char)
-> Maybe Char -> Const (Endo String) (Maybe Char)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ClientState
st

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

    reservedNames :: String
    reservedNames :: String
reservedNames =
      Getting (Endo String) ClientState Char -> ClientState -> String
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((HashMap Text NetworkState
 -> Const (Endo String) (HashMap Text NetworkState))
-> ClientState -> Const (Endo String) ClientState
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
  -> Const (Endo String) (HashMap Text NetworkState))
 -> ClientState -> Const (Endo String) ClientState)
-> ((Char -> Const (Endo String) Char)
    -> HashMap Text NetworkState
    -> Const (Endo String) (HashMap Text NetworkState))
-> Getting (Endo String) ClientState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NetworkState -> Const (Endo String) NetworkState)
-> HashMap Text NetworkState
-> Const (Endo String) (HashMap Text NetworkState)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (HashMap Text NetworkState) NetworkState
folded ((NetworkState -> Const (Endo String) NetworkState)
 -> HashMap Text NetworkState
 -> Const (Endo String) (HashMap Text NetworkState))
-> ((Char -> Const (Endo String) Char)
    -> NetworkState -> Const (Endo String) NetworkState)
-> (Char -> Const (Endo String) Char)
-> HashMap Text NetworkState
-> Const (Endo String) (HashMap Text NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const (Endo String) ServerSettings)
-> NetworkState -> Const (Endo String) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (Endo String) ServerSettings)
 -> NetworkState -> Const (Endo String) NetworkState)
-> ((Char -> Const (Endo String) Char)
    -> ServerSettings -> Const (Endo String) ServerSettings)
-> (Char -> Const (Endo String) Char)
-> NetworkState
-> Const (Endo String) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Focus WindowHint
 -> Const (Endo String) (Map Focus WindowHint))
-> ServerSettings -> Const (Endo String) ServerSettings
Lens' ServerSettings (Map Focus WindowHint)
ssWindowHints ((Map Focus WindowHint
  -> Const (Endo String) (Map Focus WindowHint))
 -> ServerSettings -> Const (Endo String) ServerSettings)
-> ((Char -> Const (Endo String) Char)
    -> Map Focus WindowHint
    -> Const (Endo String) (Map Focus WindowHint))
-> (Char -> Const (Endo String) Char)
-> ServerSettings
-> Const (Endo String) ServerSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowHint -> Const (Endo String) WindowHint)
-> Map Focus WindowHint
-> Const (Endo String) (Map Focus WindowHint)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Map Focus WindowHint) WindowHint
folded ((WindowHint -> Const (Endo String) WindowHint)
 -> Map Focus WindowHint
 -> Const (Endo String) (Map Focus WindowHint))
-> ((Char -> Const (Endo String) Char)
    -> WindowHint -> Const (Endo String) WindowHint)
-> (Char -> Const (Endo String) Char)
-> Map Focus WindowHint
-> Const (Endo String) (Map Focus WindowHint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowHint -> Maybe Char)
-> Optic' (->) (Const (Endo String)) WindowHint (Maybe Char)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to WindowHint -> Maybe Char
windowHintName  Optic' (->) (Const (Endo String)) WindowHint (Maybe Char)
-> ((Char -> Const (Endo String) Char)
    -> Maybe Char -> Const (Endo String) (Maybe Char))
-> (Char -> Const (Endo String) Char)
-> WindowHint
-> Const (Endo String) WindowHint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const (Endo String) Char)
-> Maybe Char -> Const (Endo String) (Maybe Char)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Maybe Char) Char
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
    Getting (First WindowHint) ClientState WindowHint
-> ClientState -> Maybe WindowHint
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text
-> LensLike' (Const (First WindowHint)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net LensLike' (Const (First WindowHint)) ClientState NetworkState
-> ((WindowHint -> Const (First WindowHint) WindowHint)
    -> NetworkState -> Const (First WindowHint) NetworkState)
-> Getting (First WindowHint) ClientState WindowHint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const (First WindowHint) ServerSettings)
-> NetworkState -> Const (First WindowHint) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (First WindowHint) ServerSettings)
 -> NetworkState -> Const (First WindowHint) NetworkState)
-> ((WindowHint -> Const (First WindowHint) WindowHint)
    -> ServerSettings -> Const (First WindowHint) ServerSettings)
-> (WindowHint -> Const (First WindowHint) WindowHint)
-> NetworkState
-> Const (First WindowHint) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Focus WindowHint
 -> Const (First WindowHint) (Map Focus WindowHint))
-> ServerSettings -> Const (First WindowHint) ServerSettings
Lens' ServerSettings (Map Focus WindowHint)
ssWindowHints ((Map Focus WindowHint
  -> Const (First WindowHint) (Map Focus WindowHint))
 -> ServerSettings -> Const (First WindowHint) ServerSettings)
-> ((WindowHint -> Const (First WindowHint) WindowHint)
    -> Map Focus WindowHint
    -> Const (First WindowHint) (Map Focus WindowHint))
-> (WindowHint -> Const (First WindowHint) WindowHint)
-> ServerSettings
-> Const (First WindowHint) ServerSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus WindowHint)
-> Traversal'
     (Map Focus WindowHint) (IxValue (Map Focus WindowHint))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus WindowHint)
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 = ActivityFilter -> Maybe ActivityFilter -> ActivityFilter
forall a. a -> Maybe a -> a
fromMaybe ActivityFilter
AFLoud (WindowHint -> Maybe ActivityFilter
windowHintActivity (WindowHint -> Maybe ActivityFilter)
-> Maybe WindowHint -> Maybe ActivityFilter
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe WindowHint
hints)

    freshWindow :: Window
freshWindow = Window
emptyWindow
      { _winName'    = clientNextWindowName hints st
      , _winHideMeta = fromMaybe (view (clientConfig . configHideMeta) st) (windowHintHideMeta =<< hints)
      , _winHidden   = fromMaybe False (windowHintHidden =<< hints)
      , _winActivityFilter   = winActivity
      }

    add :: Bool -> Maybe Window -> Maybe (Window, Bool)
add Bool
True  Maybe Window
w = (Window, Bool) -> Maybe (Window, Bool)
forall a. a -> Maybe a
Just ((Window, Bool) -> Maybe (Window, Bool))
-> (Window, Bool) -> Maybe (Window, Bool)
forall a b. (a -> b) -> a -> b
$! WindowLine -> Window -> (Window, Bool)
addToWindow WindowLine
wl (Window -> Maybe Window -> Window
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 (Window -> (Window, Bool)) -> Maybe Window -> Maybe (Window, Bool)
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 (Maybe Window -> Maybe (Window, Bool))
-> Maybe Window -> Maybe (Window, Bool)
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Window) ClientState (Maybe Window)
-> ClientState -> Maybe Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map Focus Window -> Const (Maybe Window) (Map Focus Window))
-> ClientState -> Const (Maybe Window) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (Maybe Window) (Map Focus Window))
 -> ClientState -> Const (Maybe Window) ClientState)
-> ((Maybe Window -> Const (Maybe Window) (Maybe Window))
    -> Map Focus Window -> Const (Maybe Window) (Map Focus Window))
-> Getting (Maybe Window) ClientState (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Lens' (Map Focus Window) (Maybe (IxValue (Map Focus Window)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Focus Window)
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 (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState (Maybe Window) (Maybe Window)
-> Maybe Window -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Map Focus Window -> Identity (Map Focus Window))
-> ClientState -> Identity ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Identity (Map Focus Window))
 -> ClientState -> Identity ClientState)
-> ((Maybe Window -> Identity (Maybe Window))
    -> Map Focus Window -> Identity (Map Focus Window))
-> ASetter ClientState ClientState (Maybe Window) (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Lens' (Map Focus Window) (Maybe (IxValue (Map Focus Window)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Focus Window)
Focus
focus) (Window -> Maybe Window
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 Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st Bool -> Bool -> Bool
&& Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientUiFocused ClientState
st = ClientState
st
  | Bool
otherwise = ClientState -> ClientState
addBell (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState [(Text, Text)] [(Text, Text)]
-> ([(Text, Text)] -> [(Text, Text)]) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState [(Text, Text)] [(Text, Text)]
Lens' ClientState [(Text, Text)]
clientNotifications ((Text, Text) -> [(Text, Text)] -> [(Text, Text)]
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 (Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientBell ClientState
st')
      , Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const Bool Configuration)
-> ClientState -> Const Bool ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const Bool Configuration)
 -> ClientState -> Const Bool ClientState)
-> Getting Bool Configuration Bool -> Getting Bool ClientState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool Configuration Bool
Lens' Configuration Bool
configBellOnMention) ClientState
st' = ASetter ClientState ClientState Bool Bool
-> Bool -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Bool Bool
Lens' ClientState Bool
clientBell Bool
True ClientState
st'
      | Bool
otherwise = ClientState
st'
    bodyText :: Text
bodyText = Image' -> Text
imageText (Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
Lens' WindowLine Image'
wlPrefix WindowLine
wl) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Image' -> Text
imageText (Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
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 (Getting MessageBody ClientMessage MessageBody
-> ClientMessage -> MessageBody
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MessageBody ClientMessage MessageBody
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  = LensLike' (Const PackedTime) ClientMessage ZonedTime
-> (ZonedTime -> PackedTime) -> ClientMessage -> PackedTime
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const PackedTime) ClientMessage ZonedTime
Lens' ClientMessage ZonedTime
msgTime ZonedTime -> PackedTime
packZonedTime ClientMessage
msg
  }
  where
    (Image'
prefix, Image'
image, Image'
full) = ZonedTime
-> MessageRendererParams -> MessageBody -> (Image', Image', Image')
msgImage (Getting ZonedTime ClientMessage ZonedTime
-> ClientMessage -> ZonedTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ZonedTime ClientMessage ZonedTime
Lens' ClientMessage ZonedTime
msgTime ClientMessage
msg) MessageRendererParams
params (Getting MessageBody ClientMessage MessageBody
-> ClientMessage -> MessageBody
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MessageBody ClientMessage MessageBody
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     = view (clientConfig . configPalette) st
    , rendHighlights  = clientHighlightsFocus (NetworkFocus network) st
    }


-- | Function applied to the client state every redraw.
clientTick :: ClientState -> ClientState
clientTick :: ClientState -> ClientState
clientTick ClientState
st = (if Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientUiFocused ClientState
st then ClientState -> ClientState
markSeen else ClientState -> ClientState
forall a. a -> a
id)
           (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState Bool Bool
-> Bool -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Bool Bool
Lens' ClientState Bool
clientBell Bool
False
           (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState [(Text, Text)] [(Text, Text)]
-> [(Text, Text)] -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState [(Text, Text)] [(Text, Text)]
Lens' ClientState [(Text, Text)]
clientNotifications []
           (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState [LogLine] [LogLine]
-> [LogLine] -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState [LogLine] [LogLine]
Lens' ClientState [LogLine]
clientLogQueue []
           (ClientState -> ClientState) -> ClientState -> ClientState
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 = (ClientState -> Focus -> ClientState)
-> ClientState -> [Focus] -> ClientState
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = LensLike ((,) StrictUnit) ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> ClientState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((Map Focus Window -> (StrictUnit, Map Focus Window))
-> ClientState -> (StrictUnit, ClientState)
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> (StrictUnit, Map Focus Window))
 -> ClientState -> (StrictUnit, ClientState))
-> ((Window -> (StrictUnit, Window))
    -> Map Focus Window -> (StrictUnit, Map Focus Window))
-> LensLike ((,) StrictUnit) ClientState ClientState Window Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus) Window -> Window
windowSeen ClientState
acc

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

    allFocuses :: [(Focus, Subfocus)]
allFocuses = (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st, Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
Lens' ClientState Subfocus
clientSubfocus ClientState
st)
               (Focus, Subfocus) -> [(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. a -> [a] -> [a]
: Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
-> ClientState -> [(Focus, Subfocus)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
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 = ASetter ClientState ClientState EditBox EditBox
-> (EditBox -> EditBox) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState EditBox EditBox
Lens' ClientState EditBox
clientTextBox EditBox -> EditBox
Edit.success

-- | Returns the current network's channels and current channel's users.
currentCompletionList :: ClientState -> [Identifier]
currentCompletionList :: ClientState -> [Identifier]
currentCompletionList ClientState
st =
  case Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st 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
       Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: Text -> ClientState -> [Identifier]
networkChannelList Text
network ClientState
st
      [Identifier] -> [Identifier] -> [Identifier]
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 =
  WordCompletionMode
-> Maybe WordCompletionMode -> WordCompletionMode
forall a. a -> Maybe a -> a
fromMaybe WordCompletionMode
defaultNickWordCompleteMode (Maybe WordCompletionMode -> WordCompletionMode)
-> Maybe WordCompletionMode -> WordCompletionMode
forall a b. (a -> b) -> a -> b
$
  do Text
network <- LensLike' (Const (Maybe Text)) ClientState Focus
-> (Focus -> Maybe Text) -> ClientState -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const (Maybe Text)) ClientState Focus
Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
     Getting (First WordCompletionMode) ClientState WordCompletionMode
-> ClientState -> Maybe WordCompletionMode
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text
-> LensLike'
     (Const (First WordCompletionMode)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike'
  (Const (First WordCompletionMode)) ClientState NetworkState
-> ((WordCompletionMode
     -> Const (First WordCompletionMode) WordCompletionMode)
    -> NetworkState -> Const (First WordCompletionMode) NetworkState)
-> Getting
     (First WordCompletionMode) ClientState WordCompletionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const (First WordCompletionMode) ServerSettings)
-> NetworkState -> Const (First WordCompletionMode) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings
  -> Const (First WordCompletionMode) ServerSettings)
 -> NetworkState -> Const (First WordCompletionMode) NetworkState)
-> ((WordCompletionMode
     -> Const (First WordCompletionMode) WordCompletionMode)
    -> ServerSettings
    -> Const (First WordCompletionMode) ServerSettings)
-> (WordCompletionMode
    -> Const (First WordCompletionMode) WordCompletionMode)
-> NetworkState
-> Const (First WordCompletionMode) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WordCompletionMode
 -> Const (First WordCompletionMode) WordCompletionMode)
-> ServerSettings
-> Const (First WordCompletionMode) ServerSettings
Lens' ServerSettings WordCompletionMode
ssNickCompletion) ClientState
st

networkChannelList ::
  Text         {- ^ network -} ->
  ClientState                  ->
  [Identifier] {- ^ channels -}
networkChannelList :: Text -> ClientState -> [Identifier]
networkChannelList Text
network =
  LensLike'
  (Const [Identifier]) ClientState (HashMap Identifier ChannelState)
-> (HashMap Identifier ChannelState -> [Identifier])
-> ClientState
-> [Identifier]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Text -> LensLike' (Const [Identifier]) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike' (Const [Identifier]) ClientState NetworkState
-> ((HashMap Identifier ChannelState
     -> Const [Identifier] (HashMap Identifier ChannelState))
    -> NetworkState -> Const [Identifier] NetworkState)
-> LensLike'
     (Const [Identifier]) ClientState (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> NetworkState -> Const [Identifier] NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels) HashMap Identifier ChannelState -> [Identifier]
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 =
  LensLike'
  (Const [Identifier]) ClientState (HashMap Identifier String)
-> (HashMap Identifier String -> [Identifier])
-> ClientState
-> [Identifier]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Text -> LensLike' (Const [Identifier]) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike' (Const [Identifier]) ClientState NetworkState
-> ((HashMap Identifier String
     -> Const [Identifier] (HashMap Identifier String))
    -> NetworkState -> Const [Identifier] NetworkState)
-> LensLike'
     (Const [Identifier]) ClientState (HashMap Identifier String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> NetworkState -> Const [Identifier] NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const [Identifier] (HashMap Identifier ChannelState))
 -> NetworkState -> Const [Identifier] NetworkState)
-> ((HashMap Identifier String
     -> Const [Identifier] (HashMap Identifier String))
    -> HashMap Identifier ChannelState
    -> Const [Identifier] (HashMap Identifier ChannelState))
-> (HashMap Identifier String
    -> Const [Identifier] (HashMap Identifier String))
-> NetworkState
-> Const [Identifier] NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel ((ChannelState -> Const [Identifier] ChannelState)
 -> HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> ((HashMap Identifier String
     -> Const [Identifier] (HashMap Identifier String))
    -> ChannelState -> Const [Identifier] ChannelState)
-> (HashMap Identifier String
    -> Const [Identifier] (HashMap Identifier String))
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const [Identifier] (HashMap Identifier String))
-> ChannelState -> Const [Identifier] ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers) HashMap Identifier String -> [Identifier]
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
    -- Refer to the grep command in Client.Commands.Window
    Just (String
"grep" , String
reStr) -> String -> Maybe Matcher
buildMatcher String
reStr
    Just (String
"g" , String
reStr)    -> String -> Maybe Matcher
buildMatcher String
reStr
    Maybe (String, String)
_ -> case Getting (Maybe Matcher) ClientState (Maybe Matcher)
-> ClientState -> Maybe Matcher
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Matcher) ClientState (Maybe Matcher)
Lens' ClientState (Maybe Matcher)
clientRegex ClientState
st of
           Maybe Matcher
Nothing -> Maybe Matcher
forall a. Maybe a
Nothing
           Just Matcher
r  -> Matcher -> Maybe Matcher
forall a. a -> Maybe a
Just Matcher
r

clientIsFiltered :: ClientState -> Bool
clientIsFiltered :: ClientState -> Bool
clientIsFiltered = Maybe Matcher -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Matcher -> Bool)
-> (ClientState -> Maybe Matcher) -> ClientState -> Bool
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 ->
      [a] -> [a]
forall {a}. [a] -> [a]
limit ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
      Int -> Int -> (a -> Bool) -> [a] -> [a]
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 (Text -> Bool) -> (a -> Text) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f)
        [a]
xs
     where
       limit :: [a] -> [a]
limit = ([a] -> [a]) -> (Int -> [a] -> [a]) -> Maybe Int -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id Int -> [a] -> [a]
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') =
  ((Identifier, Int, Text) -> Bool)
-> [(Identifier, Int, Text)] -> [(Identifier, Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Identifier
_, Int
users, Text
_) -> Int
users Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
max') ([(Identifier, Int, Text)] -> [(Identifier, Int, Text)])
-> ([(Identifier, Int, Text)] -> [(Identifier, Int, Text)])
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
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' Maybe Int
forall a. Maybe a
Nothing
clientFilterChannels ClientState
st (Just Int
min') Maybe Int
Nothing =
  ((Identifier, Int, Text) -> Bool)
-> [(Identifier, Int, Text)] -> [(Identifier, Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Identifier
_, Int
users, Text
_) -> Int
users Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
min') ([(Identifier, Int, Text)] -> [(Identifier, Int, Text)])
-> ([(Identifier, Int, Text)] -> [(Identifier, Int, Text)])
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
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
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
clientFilterChannels ClientState
st Maybe Int
Nothing Maybe Int
Nothing = ClientState
-> ((Identifier, Int, Text) -> Text)
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Identifier, Int, Text) -> Text
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       = Maybe Int
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 (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
reStr of
        Char
'-' : Char
'i' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argSensitive=False} String
reStr'
        Char
'-' : Char
'v' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argInvert=True} String
reStr'
        Char
'-' : Char
'F' : Char
' ' : String
reStr' -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argPlain=True} String
reStr'
        Char
'-' : Char
'A' : String
reStr' | [(Int
a,Char
' ':String
reStr'')] <- ReadS Int
forall a. Read a => ReadS a
reads String
reStr', Int
aInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argAfter=a} String
reStr''
        Char
'-' : Char
'B' : String
reStr' | [(Int
b,Char
' ':String
reStr'')] <- ReadS Int
forall a. Read a => ReadS a
reads String
reStr', Int
bInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argBefore=b} String
reStr''
        Char
'-' : Char
'C' : String
reStr' | [(Int
c,Char
' ':String
reStr'')] <- ReadS Int
forall a. Read a => ReadS a
reads String
reStr', Int
cInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argAfter=c,argBefore=c} String
reStr''
        Char
'-' : Char
'm' : String
reStr' | [(Int
m,Char
' ':String
reStr'')] <- ReadS Int
forall a. Read a => ReadS a
reads String
reStr', Int
mInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 -> MatcherArgs -> String -> Maybe Matcher
go MatcherArgs
args{argMax=Just 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))) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toLower)
      | Bool
otherwise =
        case CompOption -> ExecOption -> String -> Either String Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt{caseSensitive=argSensitive args}
                     ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt{captureGroups=False}
                     String
reStr of
          Left{}  -> Maybe Matcher
forall a. Maybe a
Nothing
          Right Regex
r -> (Text -> Bool) -> Maybe Matcher
matcher (Regex -> String -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
matchTest Regex
r (String -> Bool) -> (Text -> String) -> Text -> Bool
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 = Matcher -> Maybe Matcher
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 (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
f))
          | Bool
otherwise      = Matcher -> Maybe Matcher
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 (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (ClientState -> String
clientFirstLine ClientState
st)) of
    (Char
'/':String
cmd,Char
_:String
args) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
cmd,String
args)
    (String, String)
_                -> Maybe (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 ((HashMap Text NetworkState
 -> (Maybe NetworkState, HashMap Text NetworkState))
-> ClientState -> (Maybe NetworkState, ClientState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections ((HashMap Text NetworkState
  -> (Maybe NetworkState, HashMap Text NetworkState))
 -> ClientState -> (Maybe NetworkState, ClientState))
-> ((Maybe NetworkState
     -> (Maybe NetworkState, Maybe NetworkState))
    -> HashMap Text NetworkState
    -> (Maybe NetworkState, HashMap Text NetworkState))
-> (Maybe NetworkState -> (Maybe NetworkState, Maybe NetworkState))
-> ClientState
-> (Maybe NetworkState, ClientState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Lens'
     (HashMap Text NetworkState)
     (Maybe (IxValue (HashMap Text NetworkState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text NetworkState)
network ((Maybe NetworkState -> (Maybe NetworkState, Maybe NetworkState))
 -> ClientState -> (Maybe NetworkState, ClientState))
-> Maybe NetworkState
-> ClientState
-> (Maybe NetworkState, ClientState)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ Maybe NetworkState
forall a. Maybe a
Nothing) ClientState
st of
    (Maybe NetworkState
Nothing, ClientState
_  ) -> String -> (NetworkState, 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 = (Getting ServerSettings ClientState ServerSettings
-> ClientState -> ServerSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const ServerSettings Configuration)
-> ClientState -> Const ServerSettings ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const ServerSettings Configuration)
 -> ClientState -> Const ServerSettings ClientState)
-> ((ServerSettings -> Const ServerSettings ServerSettings)
    -> Configuration -> Const ServerSettings Configuration)
-> Getting ServerSettings ClientState ServerSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const ServerSettings ServerSettings)
-> Configuration -> Const ServerSettings Configuration
Lens' Configuration ServerSettings
configDefaults) ClientState
st)
                     { _ssName = Just network
                     , _ssHostName = Text.unpack network
                     }

     Either SecretException ServerSettings
eSettings0 <-
       IO ServerSettings -> IO (Either SecretException ServerSettings)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ServerSettings -> IO (Either SecretException ServerSettings))
-> IO ServerSettings -> IO (Either SecretException ServerSettings)
forall a b. (a -> b) -> a -> b
$
       ServerSettings -> IO ServerSettings
loadSecrets (ServerSettings -> IO ServerSettings)
-> ServerSettings -> IO ServerSettings
forall a b. (a -> b) -> a -> b
$
       ServerSettings -> Maybe ServerSettings -> ServerSettings
forall a. a -> Maybe a -> a
fromMaybe ServerSettings
defSettings (Maybe ServerSettings -> ServerSettings)
-> Maybe ServerSettings -> ServerSettings
forall a b. (a -> b) -> a -> b
$
       Getting (First ServerSettings) ClientState ServerSettings
-> ClientState -> Maybe ServerSettings
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Configuration -> Const (First ServerSettings) Configuration)
-> ClientState -> Const (First ServerSettings) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (First ServerSettings) Configuration)
 -> ClientState -> Const (First ServerSettings) ClientState)
-> ((ServerSettings -> Const (First ServerSettings) ServerSettings)
    -> Configuration -> Const (First ServerSettings) Configuration)
-> Getting (First ServerSettings) ClientState ServerSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text ServerSettings
 -> Const (First ServerSettings) (HashMap Text ServerSettings))
-> Configuration -> Const (First ServerSettings) Configuration
Lens' Configuration (HashMap Text ServerSettings)
configServers ((HashMap Text ServerSettings
  -> Const (First ServerSettings) (HashMap Text ServerSettings))
 -> Configuration -> Const (First ServerSettings) Configuration)
-> ((ServerSettings -> Const (First ServerSettings) ServerSettings)
    -> HashMap Text ServerSettings
    -> Const (First ServerSettings) (HashMap Text ServerSettings))
-> (ServerSettings -> Const (First ServerSettings) ServerSettings)
-> Configuration
-> Const (First ServerSettings) Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text ServerSettings)
-> Traversal'
     (HashMap Text ServerSettings)
     (IxValue (HashMap Text ServerSettings))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text ServerSettings)
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" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\x02: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
            ClientState -> IO ClientState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientState -> IO ClientState) -> ClientState -> IO ClientState
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
attempts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            NetworkConnection
c <- Int -> ServerSettings -> IO NetworkConnection
createConnection Int
delay ServerSettings
settings1
            StdGen
seed <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.newStdGen
            let restrict :: ConnectRestriction
restrict = case Getting TlsMode ServerSettings TlsMode -> ServerSettings -> TlsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TlsMode ServerSettings TlsMode
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
            (RawIrcMsg -> IO ()) -> [RawIrcMsg] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) (NetworkState -> [RawIrcMsg]
initialMessages NetworkState
cs)
            ClientState -> IO ClientState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASetter
  ClientState ClientState (Maybe NetworkState) (Maybe NetworkState)
-> Maybe NetworkState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
-> ((Maybe NetworkState -> Identity (Maybe NetworkState))
    -> HashMap Text NetworkState
    -> Identity (HashMap Text NetworkState))
-> ASetter
     ClientState ClientState (Maybe NetworkState) (Maybe NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Lens'
     (HashMap Text NetworkState)
     (Maybe (IxValue (HashMap Text NetworkState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text NetworkState)
network) (NetworkState -> Maybe NetworkState
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 <- Getting TlsMode ServerSettings TlsMode -> ServerSettings -> TlsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TlsMode ServerSettings TlsMode
Lens' ServerSettings TlsMode
ssTls ServerSettings
settings
           , let host :: Text
host = String -> Text
Text.pack (Getting String ServerSettings String -> ServerSettings -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String ServerSettings String
Lens' ServerSettings String
ssHostName ServerSettings
settings)
           , Just StsPolicy
policy <- Getting (Maybe StsPolicy) ClientState (Maybe StsPolicy)
-> ClientState -> Maybe StsPolicy
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Text StsPolicy
 -> Const (Maybe StsPolicy) (HashMap Text StsPolicy))
-> ClientState -> Const (Maybe StsPolicy) ClientState
Lens' ClientState (HashMap Text StsPolicy)
clientStsPolicy ((HashMap Text StsPolicy
  -> Const (Maybe StsPolicy) (HashMap Text StsPolicy))
 -> ClientState -> Const (Maybe StsPolicy) ClientState)
-> ((Maybe StsPolicy -> Const (Maybe StsPolicy) (Maybe StsPolicy))
    -> HashMap Text StsPolicy
    -> Const (Maybe StsPolicy) (HashMap Text StsPolicy))
-> Getting (Maybe StsPolicy) ClientState (Maybe StsPolicy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text StsPolicy)
-> Lens'
     (HashMap Text StsPolicy) (Maybe (IxValue (HashMap Text StsPolicy)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text StsPolicy)
host) ClientState
st
           , UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< Getting UTCTime StsPolicy UTCTime -> StsPolicy -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime StsPolicy UTCTime
Lens' StsPolicy UTCTime
stsExpiration StsPolicy
policy
           = Int -> Maybe Int
forall a. a -> Maybe a
Just (Getting Int StsPolicy Int -> StsPolicy -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int StsPolicy Int
Lens' StsPolicy Int
stsPort StsPolicy
policy)
           | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
     ServerSettings -> IO ServerSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerSettings -> IO ServerSettings)
-> ServerSettings -> IO ServerSettings
forall a b. (a -> b) -> a -> b
$ case Maybe Int
stsUpgrade' of
              Just Int
port -> ASetter
  ServerSettings ServerSettings (Maybe PortNumber) (Maybe PortNumber)
-> Maybe PortNumber -> ServerSettings -> ServerSettings
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ServerSettings ServerSettings (Maybe PortNumber) (Maybe PortNumber)
Lens' ServerSettings (Maybe PortNumber)
ssPort (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port))
                         (ServerSettings -> ServerSettings)
-> ServerSettings -> ServerSettings
forall a b. (a -> b) -> a -> b
$ ASetter ServerSettings ServerSettings TlsMode TlsMode
-> TlsMode -> ServerSettings -> ServerSettings
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ServerSettings ServerSettings TlsMode TlsMode
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' NetworkState
-> ([RawIrcMsg], ClientState) -> ([RawIrcMsg], ClientState)
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
        (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IrcMsg -> ClientState -> ClientState
applyHelpIfAwaiting Text
network IrcMsg
irc
        (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState NetworkState NetworkState
-> NetworkState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections ASetter
  ClientState
  ClientState
  (HashMap Text NetworkState)
  (HashMap Text NetworkState)
-> ((NetworkState -> Identity NetworkState)
    -> HashMap Text NetworkState
    -> Identity (HashMap Text NetworkState))
-> ASetter ClientState ClientState NetworkState NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text NetworkState)
-> Traversal'
     (HashMap Text NetworkState) (IxValue (HashMap Text NetworkState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text NetworkState)
network) NetworkState
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) = ASetter ClientState ClientState Focus Focus
-> (Focus -> Focus) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState Focus Focus
Lens' ClientState Focus
clientFocus Focus -> Focus
moveFocus
                        (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ((Map Focus Window -> Identity (Map Focus Window))
 -> ClientState -> Identity ClientState)
-> (Map Focus Window -> Map Focus Window)
-> ClientState
-> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Map Focus Window -> Identity (Map Focus Window))
-> ClientState -> Identity ClientState
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 = Getting Any ClientState Window -> ClientState -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Map Focus Window -> Const Any (Map Focus Window))
-> ClientState -> Const Any ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const Any (Map Focus Window))
 -> ClientState -> Const Any ClientState)
-> ((Window -> Const Any Window)
    -> Map Focus Window -> Const Any (Map Focus Window))
-> Getting Any ClientState Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
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') = (Index (Map Focus Window)
-> Lens' (Map Focus Window) (Maybe (IxValue (Map Focus Window)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Identifier -> Focus
mkFocus Identifier
old') ((Maybe Window -> (Maybe Window, Maybe Window))
 -> Map Focus Window -> (Maybe Window, Map Focus Window))
-> Maybe Window
-> Map Focus Window
-> (Maybe Window, Map Focus Window)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ Maybe Window
forall a. Maybe a
Nothing) Map Focus Window
wins
      in ((Maybe Window -> Identity (Maybe Window))
 -> Map Focus Window -> Identity (Map Focus Window))
-> Maybe Window -> Map Focus Window -> Map Focus Window
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index (Map Focus Window)
-> Lens' (Map Focus Window) (Maybe (IxValue (Map Focus Window)))
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 Focus -> Focus -> Bool
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

applyHelpIfAwaiting :: Text {- ^ network -} -> IrcMsg -> ClientState -> ClientState
applyHelpIfAwaiting :: Text -> IrcMsg -> ClientState -> ClientState
applyHelpIfAwaiting Text
network IrcMsg
irc ClientState
st
  | HelpState -> Maybe Text
awaitingHelp (ClientState -> HelpState
_clientHelp ClientState
st) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
network = ASetter ClientState ClientState HelpState HelpState
-> (HelpState -> HelpState) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState HelpState HelpState
Lens' ClientState HelpState
clientHelp (Palette -> IrcMsg -> HelpState -> HelpState
applyHelpReply (ClientState -> Palette
clientPalette ClientState
st) IrcMsg
irc) ClientState
st
  | Bool
otherwise = ClientState
st

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

-- | Scroll the current buffer to show newer messages
scrollClient :: Int -> ClientState -> ClientState
scrollClient :: Int -> ClientState -> ClientState
scrollClient Int
amt = ASetter ClientState ClientState Int Int
-> (Int -> Int) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ClientState ClientState Int Int
Lens' ClientState Int
clientScroll ((Int -> Int) -> ClientState -> ClientState)
-> (Int -> Int) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ \Int
n -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
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 =
  (Focus, Subfocus) -> [(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. Eq a => a -> [a] -> [a]
delete
    (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st, Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
Lens' ClientState Subfocus
clientSubfocus ClientState
st)
    (Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
-> ClientState -> [(Focus, Subfocus)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
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 (Maybe Focus, Int) -> [(Focus, Window)] -> Maybe Focus
forall {a}. (Maybe a, Int) -> [(a, Window)] -> Maybe a
locate (Maybe Focus
forall a. Maybe a
Nothing, Int
1) [(Focus, Window)]
windowList of
    Just Focus
focus -> Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
    Maybe Focus
Nothing ->
      case Getting (Maybe Focus) ClientState (Maybe Focus)
-> ClientState -> Maybe Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Focus) ClientState (Maybe Focus)
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 = LensLike' (Const [(Focus, Window)]) ClientState (Map Focus Window)
-> (Map Focus Window -> [(Focus, Window)])
-> ClientState
-> [(Focus, Window)]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [(Focus, Window)]) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> [(Focus, Window)]
forall k a. Map k a -> [(k, a)]
Map.toAscList ClientState
st
    locate :: (Maybe a, Int) -> [(a, Window)] -> Maybe a
locate (Maybe a
v, Int
_) [] = Maybe a
v
    locate vp :: (Maybe a, Int)
vp@(Maybe a
_, Int
vRank) ((a
f,Window
w):[(a, Window)]
wins)
      | Int
fRank Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = a -> Maybe a
forall a. a -> Maybe a
Just a
f -- Short circuit
      | Int
fRank Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
vRank = (Maybe a, Int) -> [(a, Window)] -> Maybe a
locate (a -> Maybe a
forall a. a -> Maybe a
Just a
f, Int
fRank) [(a, Window)]
wins
      | Bool
otherwise = (Maybe a, Int) -> [(a, Window)] -> Maybe a
locate (Maybe a, Int)
vp [(a, Window)]
wins
      where
        fRank :: Int
fRank = Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Char) Window (Maybe Char) -> Window -> Maybe Char
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Char) Window (Maybe Char)
Lens' Window (Maybe Char)
winName Window
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* WindowLineImportance -> Int
forall a. Enum a => a -> Int
fromEnum (Getting WindowLineImportance Window WindowLineImportance
-> Window -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance Window WindowLineImportance
Lens' Window WindowLineImportance
winMention Window
w)

-- | 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 ((Focus, Window) -> Bool)
-> [(Focus, Window)] -> Maybe (Focus, Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Focus, Window) -> Bool
forall {a}. (a, Window) -> Bool
p (Map Focus Window -> [(Focus, Window)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Getting (Map Focus Window) ClientState (Map Focus Window)
-> ClientState -> Map Focus Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Focus Window) ClientState (Map Focus Window)
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) = Getting (Maybe Char) Window (Maybe Char) -> Window -> Maybe Char
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Char) Window (Maybe Char)
Lens' Window (Maybe Char)
winName Window
w Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
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
  = ASetter ClientState ClientState Int Int
-> Int -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Int Int
Lens' ClientState Int
clientScroll Int
0
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
activateCurrent
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
deactivatePrevious
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> ClientState
updatePrevious
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState Focus Focus
-> Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Focus Focus
Lens' ClientState Focus
clientFocus Focus
focus
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState Subfocus Subfocus
-> Subfocus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Subfocus Subfocus
Lens' ClientState Subfocus
clientSubfocus Subfocus
FocusMessages
  (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ClientState
st
  where
    oldFocus :: Focus
oldFocus = Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st

    updatePrevious :: ClientState -> ClientState
updatePrevious
      | Focus
focus Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Focus
oldFocus = ClientState -> ClientState
forall a. a -> a
id
      | Bool
otherwise         = ASetter ClientState ClientState Focus Focus
-> Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Focus Focus
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 = ASetter ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Focus Window -> Identity (Map Focus Window))
-> ClientState -> Identity ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Identity (Map Focus Window))
 -> ClientState -> Identity ClientState)
-> ((Window -> Identity Window)
    -> Map Focus Window -> Identity (Map Focus Window))
-> ASetter ClientState ClientState Window Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
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) (Focus, Subfocus) -> [(Focus, Subfocus)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Focus
focus, Subfocus
FocusMessages) (Focus, Subfocus) -> [(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. a -> [a] -> [a]
: Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
-> ClientState -> [(Focus, Subfocus)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Focus, Subfocus)] ClientState [(Focus, Subfocus)]
Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st = ClientState -> ClientState
forall a. a -> a
id
      | Bool
otherwise = ASetter ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Focus Window -> Identity (Map Focus Window))
-> ClientState -> Identity ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Identity (Map Focus Window))
 -> ClientState -> Identity ClientState)
-> ((Window -> Identity Window)
    -> Map Focus Window -> Identity (Map Focus Window))
-> ASetter ClientState ClientState Window Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
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
  = (Window -> Window) -> [Focus] -> ClientState -> ClientState
forall {t :: * -> *}.
Foldable t =>
(Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
windowDeactivate [Focus]
newlyInactive
  (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ (Window -> Window) -> [Focus] -> ClientState -> ClientState
forall {t :: * -> *}.
Foldable t =>
(Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
windowActivate   [Focus]
newlyActive
  (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter
  ClientState ClientState [(Focus, Subfocus)] [(Focus, Subfocus)]
-> [(Focus, Subfocus)] -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ClientState ClientState [(Focus, Subfocus)] [(Focus, Subfocus)]
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 = (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st, Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
Lens' ClientState Subfocus
clientSubfocus ClientState
st)

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

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

    aux :: (Window -> Window) -> t Focus -> ClientState -> ClientState
aux Window -> Window
f t Focus
xs ClientState
st1 =
      (ClientState -> Focus -> ClientState)
-> ClientState -> t Focus -> ClientState
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ClientState
acc Focus
w -> LensLike ((,) StrictUnit) ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> ClientState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((Map Focus Window -> (StrictUnit, Map Focus Window))
-> ClientState -> (StrictUnit, ClientState)
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> (StrictUnit, Map Focus Window))
 -> ClientState -> (StrictUnit, ClientState))
-> ((Window -> (StrictUnit, Window))
    -> Map Focus Window -> (StrictUnit, Map Focus Window))
-> LensLike ((,) StrictUnit) ClientState ClientState Window Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
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
  = ASetter ClientState ClientState (Maybe Text) (Maybe Text)
-> Maybe Text -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Text) (Maybe Text)
Lens' ClientState (Maybe Text)
clientErrorMsg Maybe Text
forall a. Maybe a
Nothing
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState Int Int
-> Int -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Int Int
Lens' ClientState Int
clientScroll Int
0
  (ClientState -> ClientState)
-> (ClientState -> ClientState) -> ClientState -> ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter ClientState ClientState Subfocus Subfocus
-> Subfocus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Subfocus Subfocus
Lens' ClientState Subfocus
clientSubfocus Subfocus
focus

-- | Return to previously focused window.
returnFocus :: ClientState -> ClientState
returnFocus :: ClientState -> ClientState
returnFocus ClientState
st = Focus -> ClientState -> ClientState
changeFocus (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
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 (FocusSelector -> ClientState -> ClientState)
-> FocusSelector -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Focus Window
r Maybe Focus -> Maybe Focus -> Maybe Focus
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
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 (FocusSelector -> ClientState -> ClientState)
-> FocusSelector -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map Focus Window
l Maybe Focus -> Maybe Focus -> Maybe Focus
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
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 (FocusSelector -> ClientState -> ClientState)
-> FocusSelector -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ \Map Focus Window
l Map Focus Window
r ->
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey ((Focus -> Window -> Bool) -> Map Focus Window -> Map Focus Window
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Focus -> Window -> Bool
forall {p}. Focus -> p -> Bool
isNetwork Map Focus Window
r) Maybe Focus -> Maybe Focus -> Maybe Focus
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst ((Focus, Window) -> Focus)
-> (((Focus, Window), Map Focus Window) -> (Focus, Window))
-> ((Focus, Window), Map Focus Window)
-> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Focus, Window), Map Focus Window) -> (Focus, Window)
forall a b. (a, b) -> a
fst (((Focus, Window), Map Focus Window) -> Focus)
-> Maybe ((Focus, Window), Map Focus Window) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Focus Window -> Maybe ((Focus, Window), Map Focus Window)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey ((Focus -> Window -> Bool) -> Map Focus Window -> Map Focus Window
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Focus -> Window -> Bool
forall {p}. Focus -> p -> Bool
isNetwork Map Focus Window
l)
  where
    isNetwork :: Focus -> p -> Bool
isNetwork Focus
k p
_ = Getting Any Focus Text -> Focus -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any Focus Text
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) = Focus -> Map Focus Window -> (Map Focus Window, Map Focus Window)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st)
          (Map Focus Window -> (Map Focus Window, Map Focus Window))
-> Map Focus Window -> (Map Focus Window, Map Focus Window)
forall a b. (a -> b) -> a -> b
$ (Window -> Bool) -> Map Focus Window -> Map Focus Window
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (LensLike' (Const Bool) Window Bool
-> (Bool -> Bool) -> Window -> Bool
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Bool) Window Bool
Lens' Window Bool
winHidden Bool -> Bool
not)
          (Map Focus Window -> Map Focus Window)
-> Map Focus Window -> Map Focus Window
forall a b. (a -> b) -> a -> b
$ Getting (Map Focus Window) ClientState (Map Focus Window)
-> ClientState -> Map Focus Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Focus Window) ClientState (Map Focus Window)
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 (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
c)
    NetworkFocus Text
n   -> Text -> Maybe Identifier -> HashMap Identifier Highlight
netcase Text
n Maybe Identifier
forall a. Maybe a
Nothing
    Focus
Unfocused        -> HashMap Identifier Highlight
base
  where
    base :: HashMap Identifier Highlight
base = [(Identifier, Highlight)] -> HashMap Identifier Highlight
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Identifier
x, Highlight
HighlightMe) | Identifier
x <- Getting [Identifier] ClientState [Identifier]
-> ClientState -> [Identifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const [Identifier] Configuration)
-> ClientState -> Const [Identifier] ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const [Identifier] Configuration)
 -> ClientState -> Const [Identifier] ClientState)
-> (([Identifier] -> Const [Identifier] [Identifier])
    -> Configuration -> Const [Identifier] Configuration)
-> Getting [Identifier] ClientState [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Identifier] -> Const [Identifier] [Identifier])
-> Configuration -> Const [Identifier] Configuration
Lens' Configuration [Identifier]
configExtraHighlights) ClientState
st]
        HashMap Identifier Highlight
-> HashMap Identifier Highlight -> HashMap Identifier Highlight
forall a. Semigroup a => a -> a -> a
<> [(Identifier, Highlight)] -> HashMap Identifier Highlight
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Identifier
x, Highlight
HighlightNone) | Identifier
x <- Getting [Identifier] ClientState [Identifier]
-> ClientState -> [Identifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const [Identifier] Configuration)
-> ClientState -> Const [Identifier] ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const [Identifier] Configuration)
 -> ClientState -> Const [Identifier] ClientState)
-> (([Identifier] -> Const [Identifier] [Identifier])
    -> Configuration -> Const [Identifier] Configuration)
-> Getting [Identifier] ClientState [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Identifier] -> Const [Identifier] [Identifier])
-> Configuration -> Const [Identifier] Configuration
Lens' Configuration [Identifier]
configNeverHighlights) ClientState
st]
        HashMap Identifier Highlight
-> HashMap Identifier Highlight -> HashMap Identifier Highlight
forall a. Semigroup a => a -> a -> a
<> Getting
  (HashMap Identifier Highlight)
  ClientState
  (HashMap Identifier Highlight)
-> ClientState -> HashMap Identifier Highlight
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier Highlight)
  ClientState
  (HashMap Identifier Highlight)
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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
n) ClientState
st of
        Maybe NetworkState
Nothing -> Getting
  (HashMap Identifier Highlight)
  ClientState
  (HashMap Identifier Highlight)
-> ClientState -> HashMap Identifier Highlight
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier Highlight)
  ClientState
  (HashMap Identifier Highlight)
Lens' ClientState (HashMap Identifier Highlight)
clientHighlights ClientState
st
        Just NetworkState
cs ->
          (Highlight -> Highlight -> Highlight)
-> HashMap Identifier Highlight
-> HashMap Identifier Highlight
-> HashMap Identifier Highlight
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
            Highlight -> Highlight -> Highlight
replace
            (Identifier
-> Highlight
-> HashMap Identifier Highlight
-> HashMap Identifier Highlight
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs) Highlight
HighlightMe HashMap Identifier Highlight
base)
            ([(Identifier, Highlight)] -> HashMap Identifier Highlight
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 <- ((HashMap Identifier String
  -> Const [Identifier] (HashMap Identifier String))
 -> NetworkState -> Const [Identifier] NetworkState)
-> (HashMap Identifier String -> [Identifier])
-> NetworkState
-> [Identifier]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> NetworkState -> Const [Identifier] NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const [Identifier] (HashMap Identifier ChannelState))
 -> NetworkState -> Const [Identifier] NetworkState)
-> ((HashMap Identifier String
     -> Const [Identifier] (HashMap Identifier String))
    -> HashMap Identifier ChannelState
    -> Const [Identifier] (HashMap Identifier ChannelState))
-> (HashMap Identifier String
    -> Const [Identifier] (HashMap Identifier String))
-> NetworkState
-> Const [Identifier] NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
c ((ChannelState -> Const [Identifier] ChannelState)
 -> HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> ((HashMap Identifier String
     -> Const [Identifier] (HashMap Identifier String))
    -> ChannelState -> Const [Identifier] ChannelState)
-> (HashMap Identifier String
    -> Const [Identifier] (HashMap Identifier String))
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const [Identifier] (HashMap Identifier String))
-> ChannelState -> Const [Identifier] ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers) HashMap Identifier String -> [Identifier]
forall k v. HashMap k v -> [k]
HashMap.keys NetworkState
cs
                                , Text -> Int
Text.length (Identifier -> Text
idText Identifier
u) Int -> Int -> Bool
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 = LensLike' (Const String) ClientState Text
-> (Text -> String) -> ClientState -> String
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const String Configuration)
-> ClientState -> Const String ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const String Configuration)
 -> ClientState -> Const String ClientState)
-> ((Text -> Const String Text)
    -> Configuration -> Const String Configuration)
-> LensLike' (Const String) ClientState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const String Text)
-> Configuration -> Const String Configuration
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 = Getting Palette ClientState Palette -> ClientState -> Palette
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const Palette Configuration)
-> ClientState -> Const Palette ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const Palette Configuration)
 -> ClientState -> Const Palette ClientState)
-> ((Palette -> Const Palette Palette)
    -> Configuration -> Const Palette Configuration)
-> Getting Palette ClientState Palette
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Palette -> Const Palette Palette)
-> Configuration -> Const Palette Configuration
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) <- LensLike'
  (Const [(Text, ServerSettings)])
  ClientState
  (HashMap Text ServerSettings)
-> (HashMap Text ServerSettings -> [(Text, ServerSettings)])
-> ClientState
-> [(Text, ServerSettings)]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const [(Text, ServerSettings)] Configuration)
-> ClientState -> Const [(Text, ServerSettings)] ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const [(Text, ServerSettings)] Configuration)
 -> ClientState -> Const [(Text, ServerSettings)] ClientState)
-> ((HashMap Text ServerSettings
     -> Const [(Text, ServerSettings)] (HashMap Text ServerSettings))
    -> Configuration -> Const [(Text, ServerSettings)] Configuration)
-> LensLike'
     (Const [(Text, ServerSettings)])
     ClientState
     (HashMap Text ServerSettings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text ServerSettings
 -> Const [(Text, ServerSettings)] (HashMap Text ServerSettings))
-> Configuration -> Const [(Text, ServerSettings)] Configuration
Lens' Configuration (HashMap Text ServerSettings)
configServers) HashMap Text ServerSettings -> [(Text, ServerSettings)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList ClientState
st
            , ((Bool -> Const Bool Bool)
 -> ServerSettings -> Const Bool ServerSettings)
-> ServerSettings -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Bool -> Const Bool Bool)
-> ServerSettings -> Const Bool ServerSettings
Lens' ServerSettings Bool
ssAutoconnect ServerSettings
cfg
            ]

-- | Toggle the /hide metadata/ setting for the focused window.
clientToggleHideMeta :: ClientState -> ClientState
clientToggleHideMeta :: ClientState -> ClientState
clientToggleHideMeta ClientState
st =
  LensLike ((,) StrictUnit) ClientState ClientState Bool Bool
-> (Bool -> Bool) -> ClientState -> ClientState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((Map Focus Window -> (StrictUnit, Map Focus Window))
-> ClientState -> (StrictUnit, ClientState)
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> (StrictUnit, Map Focus Window))
 -> ClientState -> (StrictUnit, ClientState))
-> ((Bool -> (StrictUnit, Bool))
    -> Map Focus Window -> (StrictUnit, Map Focus Window))
-> LensLike ((,) StrictUnit) ClientState ClientState Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) ((Window -> (StrictUnit, Window))
 -> Map Focus Window -> (StrictUnit, Map Focus Window))
-> ((Bool -> (StrictUnit, Bool)) -> Window -> (StrictUnit, Window))
-> (Bool -> (StrictUnit, Bool))
-> Map Focus Window
-> (StrictUnit, Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> (StrictUnit, Bool)) -> Window -> (StrictUnit, Window)
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 (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) of
  Just Text
net -> Text -> Configuration -> NetworkPalette
configNetworkPalette Text
net (Getting Configuration ClientState Configuration
-> ClientState -> Configuration
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Configuration ClientState Configuration
Lens' ClientState Configuration
clientConfig ClientState
st)
  Maybe Text
Nothing  -> NetworkPalette
defaultNetworkPalette