{-# 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
  , clientBell
  , clientExtensions
  , clientRegex
  , clientLogQueue
  , clientActivityReturn
  , clientErrorMsg
  , clientLayout
  , clientEditMode
  , clientEditLock
  , clientRtsStats
  , clientConfigPath
  , clientStsPolicy
  , clientHighlights

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

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

  , 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

  -- * URL view
  , urlPattern
  , urlMatches

  ) 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.Palette
import           Client.Log
import           Client.Mask
import           Client.Message
import           Client.Network.Async
import           Client.State.Channel
import qualified Client.State.EditBox as Edit
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window
import           ContextFilter
import           Control.Applicative
import           Control.Concurrent.MVar
import           Control.Concurrent.STM
import           Control.Exception
import           Control.Lens
import           Control.Monad
import           Data.Foldable
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import           Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import           Data.List
import           Data.Maybe
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import           Data.Time
import           Foreign.StablePtr
import           Irc.Codes
import           Irc.Identifier
import           Irc.Message
import           Irc.RawIrcMsg
import           Irc.UserInfo
import           LensUtils
import           RtsStats (Stats)
import qualified System.Random as Random
import           Text.Regex.TDFA
import           Text.Regex.TDFA.String (compile)


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

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

  , ClientState -> Configuration
_clientConfig            :: !Configuration            -- ^ client configuration
  , ClientState -> FilePath
_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 -> Bool
_clientBell              :: !Bool                     -- ^ sound a bell next draw

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

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

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

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

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

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

makeLenses ''ClientState
makeLenses ''ExtensionState

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

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

-- | Construct an initial 'ClientState' using default values.
withClientState :: FilePath -> Configuration -> (ClientState -> IO a) -> IO a
withClientState :: FilePath -> Configuration -> (ClientState -> IO a) -> IO a
withClientState FilePath
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 :: Map Focus Window
-> Focus
-> Maybe Focus
-> Focus
-> Subfocus
-> [(Focus, Subfocus)]
-> HashMap Text NetworkState
-> TQueue NetworkEvent
-> TQueue (Int, ThreadEntry)
-> Configuration
-> FilePath
-> EditBox
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Bool
-> Maybe Matcher
-> LayoutMode
-> EditMode
-> Bool
-> Bool
-> HashSet Identifier
-> Mask
-> ExtensionState
-> [LogLine]
-> Maybe Text
-> Maybe Stats
-> HashMap Text StsPolicy
-> HashMap Identifier Highlight
-> ClientState
ClientState
        { _clientWindows :: Map Focus Window
_clientWindows           = Tagged () (Identity ())
-> Tagged (Map Focus Window) (Identity (Map Focus Window))
forall a. AsEmpty a => Prism' a ()
_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 ()
_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 :: FilePath
_clientConfigPath        = FilePath
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
        , _clientBell :: Bool
_clientBell              = Bool
False
        , _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
        }

withExtensionState :: (ExtensionState -> IO a) -> IO a
withExtensionState :: (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 :: IntMap ActiveExtension
-> MVar ParkState -> StablePtr (MVar ParkState) -> ExtensionState
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 (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 (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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
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 Text
network Identifier
channel ClientMessage
msg ClientState
st
  = ClientMessage
-> FilePath -> Identifier -> ClientState -> ClientState
recordLogLine ClientMessage
msg FilePath
statusModes Identifier
channel'
  (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ Focus -> WindowLine -> ClientState -> ClientState
recordWindowLine 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 :: FilePath
-> FilePath
-> HashMap Identifier Highlight
-> Palette
-> Maybe (HashMap Identifier UserAndHost)
-> MessageRendererParams
MessageRendererParams
      { rendStatusMsg :: FilePath
rendStatusMsg   = FilePath
statusModes
      , rendUserSigils :: FilePath
rendUserSigils  = Text -> Identifier -> ClientMessage -> ClientState -> FilePath
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
      }

    -- 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 :: FilePath
possibleStatusModes     = Getting FilePath NetworkState FilePath -> NetworkState -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath NetworkState FilePath
Lens' NetworkState FilePath
csStatusMsg NetworkState
cs
    (FilePath
statusModes, Identifier
channel') = FilePath -> Identifier -> (FilePath, Identifier)
splitStatusMsgModes FilePath
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
-> FilePath -> Identifier -> ClientState -> ClientState
recordLogLine ClientMessage
msg FilePath
statusModes Identifier
target ClientState
st =
  case Getting (Maybe FilePath) ClientState (Maybe FilePath)
-> ClientState -> Maybe FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> LensLike' (Const (Maybe FilePath)) 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 FilePath)) ClientState NetworkState
-> ((Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
    -> NetworkState -> Const (Maybe FilePath) NetworkState)
-> Getting (Maybe FilePath) ClientState (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerSettings -> Const (Maybe FilePath) ServerSettings)
-> NetworkState -> Const (Maybe FilePath) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (Maybe FilePath) ServerSettings)
 -> NetworkState -> Const (Maybe FilePath) NetworkState)
-> ((Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
    -> ServerSettings -> Const (Maybe FilePath) ServerSettings)
-> (Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
-> NetworkState
-> Const (Maybe FilePath) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Const (Maybe FilePath) (Maybe FilePath))
-> ServerSettings -> Const (Maybe FilePath) ServerSettings
Lens' ServerSettings (Maybe FilePath)
ssLogDir) ClientState
st of
    Maybe FilePath
Nothing -> ClientState
st
    Just FilePath
dir ->
      case ClientMessage
-> FilePath -> FilePath -> Identifier -> Maybe LogLine
renderLogLine ClientMessage
msg FilePath
dir FilePath
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 :: FilePath -> Identifier -> (FilePath, Identifier)
splitStatusMsgModes FilePath
possible Identifier
ident = (Text -> FilePath
Text.unpack Text
modes, Text -> Identifier
mkId Text
ident')
  where
    (Text
modes, Text
ident') = (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
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
        Error{} -> WindowLineImportance
WLImportant

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

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


-- | Predicate for messages that should be ignored based on the
-- configurable ignore list
ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier
ircIgnorable :: IrcMsg -> ClientState -> Maybe Identifier
ircIgnorable IrcMsg
msg !ClientState
st =
  case IrcMsg
msg of
    Privmsg Source
who Identifier
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    Notice  Source
who Identifier
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    -- privmsg ctcp commands are already metadata
    Ctcp Source
who Identifier
_ Text
"ACTION" Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    -- notice ctcp responses are not already metadata
    CtcpNotice Source
who Identifier
_ Text
_ Text
_ -> Source -> Maybe Identifier
checkUser Source
who
    IrcMsg
_                    -> 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
TargetNetwork     -> ClientMessage -> ClientState -> ClientState
recordNetworkMessage ClientMessage
msg ClientState
st
    TargetWindow Identifier
chan -> Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage Text
network Identifier
chan ClientMessage
msg ClientState
st
    TargetUser Identifier
user   ->
      (ClientState -> Identifier -> ClientState)
-> ClientState -> [Identifier] -> ClientState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\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
                             ((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 (Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
chan))
                             (WindowLine -> Window -> Window
addToWindow WindowLine
wl) ClientState
st')
           ClientState
st [Identifier]
chans
      where
        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 FilePath -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Identifier
user (Getting
  (HashMap Identifier FilePath)
  ChannelState
  (HashMap Identifier FilePath)
-> ChannelState -> HashMap Identifier FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier FilePath)
  ChannelState
  (HashMap Identifier FilePath)
Lens' ChannelState (HashMap Identifier FilePath)
chanUsers ChannelState
cs) ]

-- | Compute the sigils of the user who sent a message.
computeMsgLineSigils ::
  Text       {- ^ network -} ->
  Identifier {- ^ channel -} ->
  ClientMessage ->
  ClientState ->
  [Char] {- ^ sigils -}
computeMsgLineSigils :: Text -> Identifier -> ClientMessage -> ClientState -> FilePath
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 -> FilePath
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 -> FilePath
computeUserSigils Text
network Identifier
channel Identifier
user =
    Getting FilePath ClientState FilePath -> ClientState -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting FilePath ClientState FilePath -> ClientState -> FilePath)
-> Getting FilePath ClientState FilePath -> ClientState -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> LensLike' (Const FilePath) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
         LensLike' (Const FilePath) ClientState NetworkState
-> Getting FilePath NetworkState FilePath
-> Getting FilePath ClientState FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const FilePath (HashMap Identifier ChannelState))
-> NetworkState -> Const FilePath NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const FilePath (HashMap Identifier ChannelState))
 -> NetworkState -> Const FilePath NetworkState)
-> ((FilePath -> Const FilePath FilePath)
    -> HashMap Identifier ChannelState
    -> Const FilePath (HashMap Identifier ChannelState))
-> Getting FilePath NetworkState FilePath
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 FilePath ChannelState)
 -> HashMap Identifier ChannelState
 -> Const FilePath (HashMap Identifier ChannelState))
-> ((FilePath -> Const FilePath FilePath)
    -> ChannelState -> Const FilePath ChannelState)
-> (FilePath -> Const FilePath FilePath)
-> HashMap Identifier ChannelState
-> Const FilePath (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier FilePath
 -> Const FilePath (HashMap Identifier FilePath))
-> ChannelState -> Const FilePath ChannelState
Lens' ChannelState (HashMap Identifier FilePath)
chanUsers  ((HashMap Identifier FilePath
  -> Const FilePath (HashMap Identifier FilePath))
 -> ChannelState -> Const FilePath ChannelState)
-> ((FilePath -> Const FilePath FilePath)
    -> HashMap Identifier FilePath
    -> Const FilePath (HashMap Identifier FilePath))
-> (FilePath -> Const FilePath FilePath)
-> ChannelState
-> Const FilePath ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier FilePath)
-> Traversal'
     (HashMap Identifier FilePath)
     (IxValue (HashMap Identifier FilePath))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier FilePath)
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

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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
ClientMessage
    { _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
    , _msgNetwork :: Text
_msgNetwork = Text
net
    , _msgBody :: MessageBody
_msgBody    = Text -> MessageBody
ErrorBody Text
msg
    }

clientNextWindowName :: ClientState -> Char
clientNextWindowName :: ClientState -> Char
clientNextWindowName ClientState
st =
  case ClientState -> FilePath
clientWindowNames ClientState
st FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
\\ FilePath
usedNames of
    []  -> Char
'\0'
    Char
c:FilePath
_ -> Char
c
  where
    usedNames :: FilePath
usedNames = Getting (Endo FilePath) ClientState Char -> ClientState -> FilePath
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Map Focus Window -> Const (Endo FilePath) (Map Focus Window))
-> ClientState -> Const (Endo FilePath) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (Endo FilePath) (Map Focus Window))
 -> ClientState -> Const (Endo FilePath) ClientState)
-> ((Char -> Const (Endo FilePath) Char)
    -> Map Focus Window -> Const (Endo FilePath) (Map Focus Window))
-> Getting (Endo FilePath) ClientState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Const (Endo FilePath) Window)
-> Map Focus Window -> Const (Endo FilePath) (Map Focus Window)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((Window -> Const (Endo FilePath) Window)
 -> Map Focus Window -> Const (Endo FilePath) (Map Focus Window))
-> ((Char -> Const (Endo FilePath) Char)
    -> Window -> Const (Endo FilePath) Window)
-> (Char -> Const (Endo FilePath) Char)
-> Map Focus Window
-> Const (Endo FilePath) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> Const (Endo FilePath) (Maybe Char))
-> Window -> Const (Endo FilePath) Window
Lens' Window (Maybe Char)
winName ((Maybe Char -> Const (Endo FilePath) (Maybe Char))
 -> Window -> Const (Endo FilePath) Window)
-> ((Char -> Const (Endo FilePath) Char)
    -> Maybe Char -> Const (Endo FilePath) (Maybe Char))
-> (Char -> Const (Endo FilePath) Char)
-> Window
-> Const (Endo FilePath) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const (Endo FilePath) Char)
-> Maybe Char -> Const (Endo FilePath) (Maybe Char)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) 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 Focus
focus WindowLine
wl ClientState
st = ClientState
st2
  where
    freshWindow :: Window
freshWindow = Window
emptyWindow
      { _winName' :: Char
_winName' = ClientState -> Char
clientNextWindowName ClientState
st
      , _winHideMeta :: Bool
_winHideMeta = 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
configHideMeta) ClientState
st
      }

    st1 :: ClientState
st1 = ASetter ClientState ClientState (Maybe Window) (Maybe Window)
-> (Maybe Window -> Maybe 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)
-> ((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)
               (\Maybe Window
w -> Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$! WindowLine -> Window -> Window
addToWindow WindowLine
wl (Window -> Maybe Window -> Window
forall a. a -> Maybe a -> a
fromMaybe Window
freshWindow Maybe Window
w))
               ClientState
st

    st2 :: ClientState
st2
      | 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
      , Getting WindowLineImportance WindowLine WindowLineImportance
-> WindowLine -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance WindowLine WindowLineImportance
Lens' WindowLine WindowLineImportance
wlImportance WindowLine
wl WindowLineImportance -> WindowLineImportance -> Bool
forall a. Eq a => a -> a -> Bool
== WindowLineImportance
WLImportant
      , Bool -> Bool
not (ClientState -> Bool
hasMention 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
st1

      | Bool
otherwise = ClientState
st1

    hasMention :: ClientState -> Bool
hasMention = Getting Any ClientState WindowLineImportance
-> WindowLineImportance -> ClientState -> Bool
forall a s. Eq a => Getting Any s a -> a -> s -> Bool
elemOf ((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)
-> ((WindowLineImportance -> Const Any WindowLineImportance)
    -> Map Focus Window -> Const Any (Map Focus Window))
-> Getting Any ClientState WindowLineImportance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Const Any Window)
-> Map Focus Window -> Const Any (Map Focus Window)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((Window -> Const Any Window)
 -> Map Focus Window -> Const Any (Map Focus Window))
-> ((WindowLineImportance -> Const Any WindowLineImportance)
    -> Window -> Const Any Window)
-> (WindowLineImportance -> Const Any WindowLineImportance)
-> Map Focus Window
-> Const Any (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLineImportance -> Const Any WindowLineImportance)
-> Window -> Const Any Window
Lens' Window WindowLineImportance
winMention) WindowLineImportance
WLImportant

toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine :: MessageRendererParams
-> WindowLineImportance -> ClientMessage -> WindowLine
toWindowLine MessageRendererParams
params WindowLineImportance
importance ClientMessage
msg = WindowLine :: IrcSummary
-> Image'
-> Image'
-> Image'
-> WindowLineImportance
-> PackedTime
-> WindowLine
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 :: Palette
rendPalette     = 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) ClientState
st
    , rendHighlights :: HashMap Identifier Highlight
rendHighlights  = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st
    }


-- | Function applied to the client state every redraw.
clientTick :: ClientState -> ClientState
clientTick :: ClientState -> ClientState
clientTick = 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
. ClientState -> ClientState
markSeen
           (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 []


-- | 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 (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 FilePath)
-> (HashMap Identifier FilePath -> [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 FilePath
     -> Const [Identifier] (HashMap Identifier FilePath))
    -> NetworkState -> Const [Identifier] NetworkState)
-> LensLike'
     (Const [Identifier]) ClientState (HashMap Identifier FilePath)
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 FilePath
     -> Const [Identifier] (HashMap Identifier FilePath))
    -> HashMap Identifier ChannelState
    -> Const [Identifier] (HashMap Identifier ChannelState))
-> (HashMap Identifier FilePath
    -> Const [Identifier] (HashMap Identifier FilePath))
-> 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 FilePath
     -> Const [Identifier] (HashMap Identifier FilePath))
    -> ChannelState -> Const [Identifier] ChannelState)
-> (HashMap Identifier FilePath
    -> Const [Identifier] (HashMap Identifier FilePath))
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier FilePath
 -> Const [Identifier] (HashMap Identifier FilePath))
-> ChannelState -> Const [Identifier] ChannelState
Lens' ChannelState (HashMap Identifier FilePath)
chanUsers) HashMap Identifier FilePath -> [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 (FilePath, FilePath)
clientActiveCommand ClientState
st of
    Just (FilePath
"grep" , FilePath
reStr) -> FilePath -> Maybe Matcher
buildMatcher FilePath
reStr
    Maybe (FilePath, FilePath)
_ -> 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 :: 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)

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

    finish :: MatcherArgs -> FilePath -> Maybe Matcher
finish MatcherArgs
args FilePath
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 (FilePath -> Text
Text.pack FilePath
reStr)))
          else (Text -> Bool) -> Maybe Matcher
matcher (Text -> Text -> Bool
LText.isInfixOf (Text -> Text
LText.fromStrict (Text -> Text
Text.toLower (FilePath -> Text
Text.pack FilePath
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 -> FilePath -> Either FilePath Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt{caseSensitive :: Bool
caseSensitive=MatcherArgs -> Bool
argSensitive MatcherArgs
args}
                     ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt{captureGroups :: Bool
captureGroups=Bool
False}
                     FilePath
reStr of
          Left{}  -> Maybe Matcher
forall a. Maybe a
Nothing
          Right Regex
r -> (Text -> Bool) -> Maybe Matcher
matcher (Regex -> FilePath -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
matchTest Regex
r (FilePath -> Bool) -> (Text -> FilePath) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
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 (FilePath, FilePath)
clientActiveCommand ClientState
st =
  case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (ClientState -> FilePath
clientFirstLine ClientState
st)) of
    (Char
'/':FilePath
cmd,Char
_:FilePath
args) -> (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just (FilePath
cmd,FilePath
args)
    (FilePath, FilePath)
_                -> Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing


-- | Regular expression for matching HTTP/HTTPS URLs in chat text.
urlPattern :: Regex
Right Regex
urlPattern =
  CompOption -> ExecOption -> FilePath -> Either FilePath Regex
compile
    CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt
    ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt{captureGroups :: Bool
captureGroups=Bool
False}
    FilePath
"https?://([[:alnum:]-]+\\.)*([[:alnum:]-]+)(:[[:digit:]]+)?(/[-0-9a-zA-Z$_.+!*'(),%?&=:@/;~#]*)?|\
    \<https?://[^>]*>|\
    \\\(https?://[^\\)]*\\)"


-- | Find all the URL matches using 'urlPattern' in a given 'Text' suitable
-- for being opened. Surrounding @<@ and @>@ are removed.
urlMatches :: LText.Text -> [Text]
urlMatches :: Text -> [Text]
urlMatches Text
txt = Text -> Text
removeBrackets (Text -> Text) -> (MatchArray -> Text) -> MatchArray -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Text
forall a a. (Integral a, Integral a) => (a, a) -> Text
extractText ((Int, Int) -> Text)
-> (MatchArray -> (Int, Int)) -> MatchArray -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchArray
-> Getting (Endo (Int, Int)) MatchArray (Int, Int) -> (Int, Int)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index MatchArray -> Traversal' MatchArray (IxValue MatchArray)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index MatchArray
0)
             (MatchArray -> Text) -> [MatchArray] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> FilePath -> [MatchArray]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll Regex
urlPattern (Text -> FilePath
LText.unpack Text
txt)
  where
    extractText :: (a, a) -> Text
extractText (a
off,a
len) = Text -> Text
LText.toStrict
                          (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
LText.take (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len)
                          (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
LText.drop (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
off) Text
txt

    removeBrackets :: Text -> Text
removeBrackets Text
t =
      case Text -> Maybe (Char, Text)
Text.uncons Text
t of
       Just (Char
'<',Text
t') | Bool -> Bool
not (Text -> Bool
Text.null Text
t') -> Text -> Text
Text.init Text
t'
       Just (Char
'(',Text
t') | Bool -> Bool
not (Text -> Bool
Text.null Text
t') -> Text -> Text
Text.init Text
t'
       Maybe (Char, Text)
_                                  -> Text
t

-- | 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
_  ) -> FilePath -> (NetworkState, ClientState)
forall a. HasCallStack => FilePath -> a
error FilePath
"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 :: Maybe Text
_ssName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
network
                     , _ssHostName :: FilePath
_ssHostName = Text -> FilePath
Text.unpack Text
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 FilePath
label FilePath
err) ->
         do ZonedTime
now <- IO ZonedTime
getZonedTime
            let txt :: FilePath
txt = FilePath
"Failed loading secret \x02" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
label FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\x02: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err
            ClientState -> IO ClientState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
network (FilePath -> Text
Text.pack FilePath
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 (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 = FilePath -> Text
Text.pack (Getting FilePath ServerSettings FilePath
-> ServerSettings -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath ServerSettings FilePath
Lens' ServerSettings FilePath
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 (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 , DCC updates, 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)
`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
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


------------------------------------------------------------------------
-- 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, Window)
-> Maybe (Focus, Window) -> Maybe (Focus, Window)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe (Focus, Window)
highPriority Maybe (Focus, Window)
lowPriority of
    Just (Focus
focus,Window
_) -> Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st
    Maybe (Focus, Window)
Nothing ->
      case 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   = ((Focus, Window) -> Bool) -> [(Focus, Window)] -> [(Focus, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Focus, Window) -> Bool) -> (Focus, Window) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool Window Bool -> Window -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Window Bool
Lens' Window Bool
winSilent (Window -> Bool)
-> ((Focus, Window) -> Window) -> (Focus, Window) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focus, Window) -> Window
forall a b. (a, b) -> b
snd)
                 ([(Focus, Window)] -> [(Focus, Window)])
-> [(Focus, Window)] -> [(Focus, Window)]
forall a b. (a -> b) -> a -> b
$ 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
    highPriority :: Maybe (Focus, Window)
highPriority = ((Focus, Window) -> Bool)
-> [(Focus, Window)] -> Maybe (Focus, Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Focus, Window)
x -> WindowLineImportance
WLImportant WindowLineImportance -> WindowLineImportance -> Bool
forall a. Eq a => a -> a -> Bool
== 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 ((Focus, Window) -> Window
forall a b. (a, b) -> b
snd (Focus, Window)
x)) [(Focus, Window)]
windowList
    lowPriority :: Maybe (Focus, Window)
lowPriority  = ((Focus, Window) -> Bool)
-> [(Focus, Window)] -> Maybe (Focus, Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Focus, Window)
x -> Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winUnread ((Focus, Window) -> Window
forall a b. (a, b) -> b
snd (Focus, Window)
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [(Focus, Window)]
windowList

-- | Jump the focus directly to a window based on its zero-based index
-- while ignoring hidden windows.
jumpFocus ::
  Char {- ^ window name -} ->
  ClientState -> ClientState
jumpFocus :: Char -> ClientState -> ClientState
jumpFocus Char
i ClientState
st =
  case ((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 (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 (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 (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 (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 (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 (Getting 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 Getting 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, Hashable 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 FilePath
  -> Const [Identifier] (HashMap Identifier FilePath))
 -> NetworkState -> Const [Identifier] NetworkState)
-> (HashMap Identifier FilePath -> [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 FilePath
     -> Const [Identifier] (HashMap Identifier FilePath))
    -> HashMap Identifier ChannelState
    -> Const [Identifier] (HashMap Identifier ChannelState))
-> (HashMap Identifier FilePath
    -> Const [Identifier] (HashMap Identifier FilePath))
-> 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 FilePath
     -> Const [Identifier] (HashMap Identifier FilePath))
    -> ChannelState -> Const [Identifier] ChannelState)
-> (HashMap Identifier FilePath
    -> Const [Identifier] (HashMap Identifier FilePath))
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier FilePath
 -> Const [Identifier] (HashMap Identifier FilePath))
-> ChannelState -> Const [Identifier] ChannelState
Lens' ChannelState (HashMap Identifier FilePath)
chanUsers) HashMap Identifier FilePath -> [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 -> FilePath
clientWindowNames = LensLike' (Const FilePath) ClientState Text
-> (Text -> FilePath) -> ClientState -> FilePath
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const FilePath Configuration)
-> ClientState -> Const FilePath ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const FilePath Configuration)
 -> ClientState -> Const FilePath ClientState)
-> ((Text -> Const FilePath Text)
    -> Configuration -> Const FilePath Configuration)
-> LensLike' (Const FilePath) ClientState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const FilePath Text)
-> Configuration -> Const FilePath Configuration
Lens' Configuration Text
configWindowNames) Text -> FilePath
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