{-# Language OverloadedStrings #-}
{-|
Module      : Client.Commands.Window
Description : Window command implementations
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.Window (windowCommands, parseFocus) where

import           Client.Commands.Arguments.Spec
import           Client.Commands.TabCompletion
import           Client.Commands.Types
import           Client.Commands.WordCompletion
import           Client.Mask (buildMask)
import           Client.State
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window (windowClear, wlText, winMessages, winHidden, winSilent, winName)
import           Control.Applicative
import           Control.Exception
import           Control.Lens
import           Data.Foldable
import           Data.List ((\\), nub)
import qualified Client.State.EditBox as Edit
import           Data.HashSet (HashSet)
import           Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.IO as LText
import           Irc.Identifier

windowCommands :: CommandSection
windowCommands :: CommandSection
windowCommands = Text -> [Command] -> CommandSection
CommandSection Text
"Window management"
  ------------------------------------------------------------------------

  [ NonEmpty Text
-> Args ClientState (String, Maybe String)
-> Text
-> CommandImpl (String, Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"focus")
      ((String -> Maybe String -> (String, Maybe String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) (Maybe String)
-> Args ClientState (String, Maybe String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"network") (Ap (Arg ClientState) String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[target]")))
      Text
"Change the focused window.\n\
      \\n\
      \When only \^Bnetwork\^B is specified this switches to the network status window.\n\
      \When \^Bnetwork\^B and \^Btarget\^B are specified this switches to that chat window.\n\
      \\n\
      \Nickname and channels can be specified in the \^Btarget\^B parameter.\n\
      \See also: /query (aliased /c /channel) to switch to a target on the current network.\n"
    (CommandImpl (String, Maybe String) -> Command)
-> CommandImpl (String, Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (String, Maybe String)
-> (Bool -> ClientCommand String)
-> CommandImpl (String, Maybe String)
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (String, Maybe String)
cmdFocus Bool -> ClientCommand String
tabFocus

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text
"c" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"channel"])
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"focus")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    focuses: Focus name\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    This command sets the current window focus. When\n\
      \    no network is specified, the current network will\n\
      \    be used.\n\
      \\n\
      \    Client:  *\n\
      \    Network: \^_network\^_:\n\
      \    Channel: \^_#channel\^_\n\
      \    Channel: \^_network\^_:\^_#channel\^_\n\
      \    User:    \^_nick\^_\n\
      \    User:    \^_network\^_:\^_nick\^_\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /c fn:#haskell\n\
      \    /c #haskell\n\
      \    /c fn:\n\
      \    /c *:\n\
      \\n\
      \\^BSee also:\^B focus\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdChannel Bool -> ClientCommand String
tabChannel

  , NonEmpty Text
-> Args ClientState (Maybe (String, Maybe String))
-> Text
-> CommandImpl (Maybe (String, Maybe String))
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"clear")
      (Args ClientState (String, Maybe String)
-> Args ClientState (Maybe (String, Maybe String))
forall r a. Args r a -> Args r (Maybe a)
optionalArg ((String -> Maybe String -> (String, Maybe String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) (Maybe String)
-> Args ClientState (String, Maybe String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[network]") (Ap (Arg ClientState) String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[channel]"))))
      Text
"Clear a window.\n\
      \\n\
      \If no arguments are provided the current window is cleared.\n\
      \If \^Bnetwork\^B is provided the that network window is cleared.\n\
      \If \^Bnetwork\^B and \^Bchannel\^B are provided that chat window is cleared.\n\
      \If \^Bnetwork\^B is provided and \^Bchannel\^B is \^B*\^O all windows for that network are cleared.\n\
      \\n\
      \If a window is cleared and no longer active that window will be removed from the client.\n"
    (CommandImpl (Maybe (String, Maybe String)) -> Command)
-> CommandImpl (Maybe (String, Maybe String)) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (Maybe (String, Maybe String))
-> (Bool -> ClientCommand String)
-> CommandImpl (Maybe (String, Maybe String))
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (Maybe (String, Maybe String))
cmdClear Bool -> ClientCommand String
tabFocus

  , NonEmpty Text
-> Ap (Arg ClientState) (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"windows")
      (Ap (Arg ClientState) String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[kind]"))
      Text
"Show a list of all windows with an optional argument to limit the kinds of windows listed.\n\
      \\n\
      \\^Bkind\^O: one of \^Bnetworks\^O, \^Bchannels\^O, \^Busers\^O\n\
      \\n"
    (CommandImpl (Maybe String) -> Command)
-> CommandImpl (Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (Maybe String)
-> (Bool -> ClientCommand String) -> CommandImpl (Maybe String)
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdWindows Bool -> ClientCommand String
tabWindows

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"focuses")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    focuses: List of focus names\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    This command sents the set of focuses that will always\n\
      \    be visible, even when unfocused. When the client is focused\n\
      \    to an active network, the network can be omitted when\n\
      \    specifying a focus. If no focuses are listed, they will\n\
      \    all be cleared.\n\
      \\n\
      \    Client:  *\n\
      \    Network: \^_network\^_:\n\
      \    Channel: \^_#channel\^_\n\
      \    Channel: \^_network\^_:\^_#channel\^_\n\
      \    User:    \^_nick\^_\n\
      \    User:    \^_network\^_:\^_nick\^_\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /splits * fn:#haskell fn:chanserv\n\
      \    /splits #haskell #haskell-lens nickserv\n\
      \    /splits\n\
      \\n\
      \\^BSee also:\^B splits+, splits-\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplits Bool -> ClientCommand String
tabSplits

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits+")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"focuses")
      Text
"Add windows to the splits list. Omit the list of focuses to add the\
      \ current window.\n\
      \\n\
      \\^Bfocuses\^B: space delimited list of focus names.\n\
      \\n\
      \Client:  *\n\
      \Network: \^BNETWORK\^B\n\
      \Channel: \^BNETWORK\^B:\^B#CHANNEL\^B\n\
      \User:    \^BNETWORK\^B:\^BNICK\^B\n\
      \\n\
      \If the network part is omitted, the current network will be used.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplitsAdd Bool -> ClientCommand String
tabSplits

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits-")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"focuses")
      Text
"Remove windows from the splits list. Omit the list of focuses to\
      \ remove the current window.\n\
      \\n\
      \\^Bfocuses\^B: space delimited list of focus names.\n\
      \\n\
      \Client:  *\n\
      \Network: \^BNETWORK\^B\n\
      \Channel: \^BNETWORK\^B:\^B#CHANNEL\^B\n\
      \User:    \^BNETWORK\^B:\^BNICK\^B\n\
      \\n\
      \If the network part is omitted, the current network will be used.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplitsDel Bool -> ClientCommand String
tabActiveSplits

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"ignore")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"masks")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    masks: List of masks\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Toggle the soft-ignore on each of the space-delimited given\n\
      \    nicknames. Ignores can use \^B*\^B (many) and \^B?\^B (one) wildcards.\n\
      \    Masks can be of the form: nick[[!user]@host]\n\
      \    Masks use a case-insensitive comparison.\n\
      \\n\
      \    If no masks are specified the current ignore list is displayed.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /ignore\n\
      \    /ignore nick1 nick2 nick3\n\
      \    /ignore nick@host\n\
      \    /ignore nick!user@host\n\
      \    /ignore *@host\n\
      \    /ignore *!baduser@*\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdIgnore Bool -> ClientCommand String
tabIgnore

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"grep")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"regular-expression")
      Text
"Set the persistent regular expression.\n\
      \\n\
      \\^BFlags:\^B\n\
      \    -A n Show n messages after match\n\
      \    -B n Show n messages before match\n\
      \    -C n Show n messages before and after match\n\
      \    -F   Use plain-text match instead of regular expression\n\
      \    -i   Case insensitive match\n\
      \    -v   Invert pattern match\n\
      \    -m n Limit results to n matches\n\
      \    --   Stop processing flags\n\
      \\n\
      \Clear the regular expression by calling this without an argument.\n\
      \\n\
      \\^B/grep\^O is case-sensitive.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdGrep Bool -> ClientCommand String
simpleClientTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"dump")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"filename")
      Text
"Dump current buffer to file.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdDump Bool -> ClientCommand String
simpleClientTab

  , NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"mentions")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"Show a list of all message that were highlighted as important.\n\
      \\n\
      \When using \^B/grep\^B the important messages are those matching\n\
      \the regular expression instead.\n"
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientCommand String) -> CommandImpl ()
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdMentions Bool -> ClientCommand String
noClientTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"setwindow")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"hide|show|loud|silent")
      Text
"Set window property.\n\
      \\n\
      \\^Bloud\^B / \^Bsilent\^B\n\
      \    Toggles if window activity appears in the status bar.\n\
      \n\
      \\^Bshow\^B / \^Bhide\^B\n\
      \    Toggles if window appears in window command shortcuts.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSetWindow Bool -> ClientCommand String
tabSetWindow

  , NonEmpty Text
-> Ap (Arg ClientState) (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"setname")
      (Ap (Arg ClientState) String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[letter]"))
      Text
"Set window shortcut letter. If no letter is provided the next available\n\
      \letter will automatically be assigned.\n\
      \\n\
      \Available letters are configured in the 'window-names' configuration setting.\n"
    (CommandImpl (Maybe String) -> Command)
-> CommandImpl (Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (Maybe String)
-> (Bool -> ClientCommand String) -> CommandImpl (Maybe String)
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdSetWindowName Bool -> ClientCommand String
noClientTab

  ]

cmdSetWindowName :: ClientCommand (Maybe String)
cmdSetWindowName :: ClientCommand (Maybe String)
cmdSetWindowName ClientState
st Maybe String
arg =
  -- unset current name so that it becomes available
  let mbSt1 :: Maybe ClientState
mbSt1 = LensLike
  ((,) Any) ClientState ClientState (Maybe Char) (Maybe Char)
-> (Maybe Char -> Maybe Char) -> ClientState -> Maybe ClientState
forall (m :: * -> *) s t a b.
Alternative m =>
LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover ((Map Focus Window -> (Any, Map Focus Window))
-> ClientState -> (Any, ClientState)
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> (Any, Map Focus Window))
 -> ClientState -> (Any, ClientState))
-> ((Maybe Char -> (Any, Maybe Char))
    -> Map Focus Window -> (Any, Map Focus Window))
-> LensLike
     ((,) Any) ClientState ClientState (Maybe Char) (Maybe Char)
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 -> (Any, Window))
 -> Map Focus Window -> (Any, Map Focus Window))
-> ((Maybe Char -> (Any, Maybe Char)) -> Window -> (Any, Window))
-> (Maybe Char -> (Any, Maybe Char))
-> Map Focus Window
-> (Any, Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> (Any, Maybe Char)) -> Window -> (Any, Window)
Lens' Window (Maybe Char)
winName) (\Maybe Char
_ -> Maybe Char
forall a. Maybe a
Nothing) ClientState
st in
  case Maybe ClientState
mbSt1 of
    Maybe ClientState
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"no current window" ClientState
st
    Just ClientState
st1 ->
      let next :: Char
next = ClientState -> Char
clientNextWindowName ClientState
st
          mbName :: Either Text Char
mbName =
            case Maybe String
arg of
              Just [Char
n] | Char
n Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ClientState -> String
clientWindowNames ClientState
st -> Char -> Either Text Char
forall a b. b -> Either a b
Right Char
n
              Just String
_ -> Text -> Either Text Char
forall a b. a -> Either a b
Left Text
"invalid name"
              Maybe String
Nothing
                | Char
next Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0' -> Char -> Either Text Char
forall a b. b -> Either a b
Right Char
next
                | Bool
otherwise -> Text -> Either Text Char
forall a b. a -> Either a b
Left Text
"no free names" in
      case Either Text Char
mbName of
        Left Text
e -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
e ClientState
st
        Right Char
name ->
          let unset :: Maybe Char -> Maybe Char
unset Maybe Char
n = if Maybe Char
n Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
name then Maybe Char
forall a. Maybe a
Nothing else Maybe Char
n in
          ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
            (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState (Maybe Char) (Maybe Char)
-> Maybe Char -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set  ((Map Focus Window -> Identity (Map Focus Window))
-> ClientState -> Identity ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Identity (Map Focus Window))
 -> ClientState -> Identity ClientState)
-> ((Maybe Char -> Identity (Maybe Char))
    -> Map Focus Window -> Identity (Map Focus Window))
-> ASetter ClientState ClientState (Maybe Char) (Maybe Char)
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 -> Identity Window)
 -> Map Focus Window -> Identity (Map Focus Window))
-> ((Maybe Char -> Identity (Maybe Char))
    -> Window -> Identity Window)
-> (Maybe Char -> Identity (Maybe Char))
-> Map Focus Window
-> Identity (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> Identity (Maybe Char)) -> Window -> Identity Window
Lens' Window (Maybe Char)
winName) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
name)
            (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState (Maybe Char) (Maybe Char)
-> (Maybe Char -> Maybe Char) -> 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 Char -> Identity (Maybe Char))
    -> Map Focus Window -> Identity (Map Focus Window))
-> ASetter ClientState ClientState (Maybe Char) (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Identity Window)
-> Map Focus Window -> Identity (Map Focus Window)
forall s t a b. Each s t a b => Traversal s t a b
each                     ((Window -> Identity Window)
 -> Map Focus Window -> Identity (Map Focus Window))
-> ((Maybe Char -> Identity (Maybe Char))
    -> Window -> Identity Window)
-> (Maybe Char -> Identity (Maybe Char))
-> Map Focus Window
-> Identity (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> Identity (Maybe Char)) -> Window -> Identity Window
Lens' Window (Maybe Char)
winName) Maybe Char -> Maybe Char
unset
            (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ClientState
st1

cmdSetWindow :: ClientCommand String
cmdSetWindow :: ClientCommand String
cmdSetWindow ClientState
st String
cmd =
  case Maybe (Window -> Window)
mbFun of
    Maybe (Window -> Window)
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad window setting" ClientState
st
    Just Window -> Window
f ->
      case LensLike ((,) Any) ClientState ClientState Window Window
-> (Window -> Window) -> ClientState -> Maybe ClientState
forall (m :: * -> *) s t a b.
Alternative m =>
LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover ((Map Focus Window -> (Any, Map Focus Window))
-> ClientState -> (Any, ClientState)
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> (Any, Map Focus Window))
 -> ClientState -> (Any, ClientState))
-> ((Window -> (Any, Window))
    -> Map Focus Window -> (Any, Map Focus Window))
-> LensLike ((,) Any) 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 (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 -> Window
f ClientState
st of
        Maybe ClientState
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"no such window" ClientState
st
        Just ClientState
st' -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
  where
    mbFun :: Maybe (Window -> Window)
mbFun =
      case String
cmd of
        String
"show"   -> (Window -> Window) -> Maybe (Window -> Window)
forall a. a -> Maybe a
Just (ASetter Window Window Bool Bool -> Bool -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window Bool Bool
Lens' Window Bool
winHidden Bool
False)
        String
"hide"   -> (Window -> Window) -> Maybe (Window -> Window)
forall a. a -> Maybe a
Just (((Maybe Char -> Identity (Maybe Char))
 -> Window -> Identity Window)
-> Maybe Char -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set (Maybe Char -> Identity (Maybe Char)) -> Window -> Identity Window
Lens' Window (Maybe Char)
winName Maybe Char
forall a. Maybe a
Nothing (Window -> Window) -> (Window -> Window) -> Window -> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Window Window Bool Bool -> Bool -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window Bool Bool
Lens' Window Bool
winHidden Bool
True)
        String
"loud"   -> (Window -> Window) -> Maybe (Window -> Window)
forall a. a -> Maybe a
Just (ASetter Window Window Bool Bool -> Bool -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window Bool Bool
Lens' Window Bool
winSilent Bool
False)
        String
"silent" -> (Window -> Window) -> Maybe (Window -> Window)
forall a. a -> Maybe a
Just (ASetter Window Window Bool Bool -> Bool -> Window -> Window
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Window Window Bool Bool
Lens' Window Bool
winSilent Bool
True)
        String
_        -> Maybe (Window -> Window)
forall a. Maybe a
Nothing

tabSetWindow :: Bool {- ^ reversed -} -> ClientCommand String
tabSetWindow :: Bool -> ClientCommand String
tabSetWindow Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st
  where
    completions :: [Text]
completions = [Text
"hide", Text
"show", Text
"loud", Text
"silent"] :: [Text]

-- | Implementation of @/grep@
cmdGrep :: ClientCommand String
cmdGrep :: ClientCommand String
cmdGrep ClientState
st String
str
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str  = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ASetter ClientState ClientState (Maybe Matcher) (Maybe Matcher)
-> Maybe Matcher -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Matcher) (Maybe Matcher)
Lens' ClientState (Maybe Matcher)
clientRegex Maybe Matcher
forall a. Maybe a
Nothing ClientState
st)
  | Bool
otherwise =
      case String -> Maybe Matcher
buildMatcher String
str of
        Maybe Matcher
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad grep" ClientState
st
        Just  Matcher
r -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ASetter ClientState ClientState (Maybe Matcher) (Maybe Matcher)
-> Maybe Matcher -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Matcher) (Maybe Matcher)
Lens' ClientState (Maybe Matcher)
clientRegex (Matcher -> Maybe Matcher
forall a. a -> Maybe a
Just Matcher
r) ClientState
st)

-- | Implementation of @/windows@ command. Set subfocus to Windows.
cmdWindows :: ClientCommand (Maybe String)
cmdWindows :: ClientCommand (Maybe String)
cmdWindows ClientState
st Maybe String
arg =
  case Maybe String
arg of
    Maybe String
Nothing         -> WindowsFilter -> IO CommandResult
forall (m :: * -> *). Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
AllWindows
    Just String
"networks" -> WindowsFilter -> IO CommandResult
forall (m :: * -> *). Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
NetworkWindows
    Just String
"channels" -> WindowsFilter -> IO CommandResult
forall (m :: * -> *). Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
ChannelWindows
    Just String
"users"    -> WindowsFilter -> IO CommandResult
forall (m :: * -> *). Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
UserWindows
    Maybe String
_               -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
errmsg ClientState
st
  where
    errmsg :: Text
errmsg = Text
"/windows expected networks, channels, or users"
    success :: WindowsFilter -> m CommandResult
success WindowsFilter
x =
      ClientState -> m CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus (WindowsFilter -> Subfocus
FocusWindows WindowsFilter
x) ClientState
st)

-- | Implementation of @/mentions@ command. Set subfocus to Mentions.
cmdMentions :: ClientCommand ()
cmdMentions :: ClientCommand ()
cmdMentions ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusMentions ClientState
st)

cmdIgnore :: ClientCommand String
cmdIgnore :: ClientCommand String
cmdIgnore ClientState
st String
rest =
  case Text -> Identifier
mkId (Text -> Identifier) -> [Text] -> [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
Text.words (String -> Text
Text.pack String
rest) of
    [] -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusIgnoreList ClientState
st)
    [Identifier]
xs -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st2
      where
        (HashSet Identifier
newIgnores, ClientState
st1) = ((HashSet Identifier -> (HashSet Identifier, HashSet Identifier))
-> ClientState -> (HashSet Identifier, ClientState)
Lens' ClientState (HashSet Identifier)
clientIgnores ((HashSet Identifier -> (HashSet Identifier, HashSet Identifier))
 -> ClientState -> (HashSet Identifier, ClientState))
-> (HashSet Identifier -> HashSet Identifier)
-> ClientState
-> (HashSet Identifier, ClientState)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ HashSet Identifier -> HashSet Identifier
updateIgnores) ClientState
st
        st2 :: ClientState
st2 = ASetter ClientState ClientState Mask Mask
-> Mask -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Mask Mask
Lens' ClientState Mask
clientIgnoreMask ([Identifier] -> Mask
buildMask (HashSet Identifier -> [Identifier]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet Identifier
newIgnores)) ClientState
st1

        updateIgnores :: HashSet Identifier -> HashSet Identifier
        updateIgnores :: HashSet Identifier -> HashSet Identifier
updateIgnores HashSet Identifier
s = (HashSet Identifier -> Identifier -> HashSet Identifier)
-> HashSet Identifier -> [Identifier] -> HashSet Identifier
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashSet Identifier -> Identifier -> HashSet Identifier
forall t. Contains t => t -> Index t -> t
updateIgnore HashSet Identifier
s [Identifier]
xs

        updateIgnore :: t -> Index t -> t
updateIgnore t
s Index t
x = ASetter t t Bool Bool -> (Bool -> Bool) -> t -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Index t -> Lens' t Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index t
x) Bool -> Bool
not t
s

-- | Complete the nickname at the current cursor position using the
-- userlist for the currently focused channel (if any)
tabIgnore :: Bool {- ^ reversed -} -> ClientCommand String
tabIgnore :: Bool -> ClientCommand String
tabIgnore Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Identifier]
-> [Identifier]
-> Bool
-> ClientState
-> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
mode [Identifier]
hint [Identifier]
completions Bool
isReversed ClientState
st
  where
    hint :: [Identifier]
hint          = ClientState -> [Identifier]
activeNicks ClientState
st
    completions :: [Identifier]
completions   = ClientState -> [Identifier]
currentCompletionList ClientState
st [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ LensLike' (Const [Identifier]) ClientState (HashSet Identifier)
-> (HashSet Identifier -> [Identifier])
-> ClientState
-> [Identifier]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Identifier]) ClientState (HashSet Identifier)
Lens' ClientState (HashSet Identifier)
clientIgnores HashSet Identifier -> [Identifier]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ClientState
st
    mode :: WordCompletionMode
mode          = ClientState -> WordCompletionMode
currentNickCompletionMode ClientState
st

-- | Implementation of @/splits@
cmdSplits :: ClientCommand String
cmdSplits :: ClientCommand String
cmdSplits ClientState
st String
str =
  ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str (([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult)
-> ([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
    ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ([(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus ([(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. Eq a => [a] -> [a]
nub [(Focus, Subfocus)]
args) ClientState
st)


-- | Implementation of @/splits+@. When no focuses are provided
-- the current focus is used instead.
cmdSplitsAdd :: ClientCommand String
cmdSplitsAdd :: ClientCommand String
cmdSplitsAdd ClientState
st String
str =
  ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str (([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult)
-> ([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
    let args' :: [(Focus, Subfocus)]
args'
          | [(Focus, Subfocus)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Focus, Subfocus)]
args = [(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)]
          | Bool
otherwise = [(Focus, Subfocus)]
args
        extras :: [(Focus, Subfocus)]
extras = [(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. Eq a => [a] -> [a]
nub ([(Focus, Subfocus)]
args' [(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)

    in ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ([(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus [(Focus, Subfocus)]
extras ClientState
st)

-- | Implementation of @/splits-@. When no focuses are provided
-- the current focus is used instead.
cmdSplitsDel :: ClientCommand String
cmdSplitsDel :: ClientCommand String
cmdSplitsDel ClientState
st String
str =
  ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str (([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult)
-> ([(Focus, Subfocus)] -> IO CommandResult) -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
    let args' :: [(Focus, Subfocus)]
args'
          | [(Focus, Subfocus)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Focus, Subfocus)]
args = [(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)]
          | Bool
otherwise = [(Focus, Subfocus)]
args
        extras :: [(Focus, Subfocus)]
extras = 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, Subfocus)] -> [(Focus, Subfocus)] -> [(Focus, Subfocus)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Focus, Subfocus)]
args'

    in ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ([(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus [(Focus, Subfocus)]
extras ClientState
st)

withSplitFocuses ::
  ClientState                   ->
  String                        ->
  ([(Focus, Subfocus)] -> IO CommandResult) ->
  IO CommandResult
withSplitFocuses :: ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str [(Focus, Subfocus)] -> IO CommandResult
k =
  case Maybe [Focus]
mb of
    Maybe [Focus]
Nothing   -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unable to parse arguments" ClientState
st
    Just [Focus]
args -> [(Focus, Subfocus)] -> IO CommandResult
k [(Focus
x, Subfocus
FocusMessages) | Focus
x <- [Focus]
args]
  where
    mb :: Maybe [Focus]
mb = (String -> Maybe Focus) -> [String] -> Maybe [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
           (Maybe Text -> String -> Maybe Focus
parseFocus (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))
           (String -> [String]
words String
str)

-- | Parses a single focus name given a default network.
parseFocus ::
  Maybe Text {- ^ default network    -} ->
  String {- ^ @[network:]target@ -} ->
  Maybe Focus
parseFocus :: Maybe Text -> String -> Maybe Focus
parseFocus Maybe Text
mbNet String
x =
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
x of
    (String
"*",String
"")     -> Focus -> Maybe Focus
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
Unfocused
    (String
net,Char
_:String
"")   -> Focus -> Maybe Focus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Focus
NetworkFocus (String -> Text
Text.pack String
net))
    (String
net,Char
_:String
chan) -> Focus -> Maybe Focus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Identifier -> Focus
ChannelFocus (String -> Text
Text.pack String
net) (Text -> Identifier
mkId (String -> Text
Text.pack String
chan)))
    (String
chan,String
"")    -> Maybe Text
mbNet Maybe Text -> (Text -> Focus) -> Maybe Focus
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
net ->
                    Text -> Identifier -> Focus
ChannelFocus Text
net (Text -> Identifier
mkId (String -> Text
Text.pack String
chan))

cmdFocus :: ClientCommand (String, Maybe String)
cmdFocus :: ClientCommand (String, Maybe String)
cmdFocus ClientState
st (String
network, Maybe String
mbChannel)
  | String
network String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"*" = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Focus -> ClientState -> ClientState
changeFocus Focus
Unfocused ClientState
st)
  | Bool
otherwise =
     case Maybe String
mbChannel of
       Maybe String
Nothing ->
         let focus :: Focus
focus = Text -> Focus
NetworkFocus (String -> Text
Text.pack String
network) in
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st)
       Just String
channel ->
         let focus :: Focus
focus = Text -> Identifier -> Focus
ChannelFocus (String -> Text
Text.pack String
network) (Text -> Identifier
mkId (String -> Text
Text.pack String
channel)) in
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
           (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st

tabWindows :: Bool -> ClientCommand String
tabWindows :: Bool -> ClientCommand String
tabWindows Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st
  where
    completions :: [Text]
completions = [Text
"networks",Text
"channels",Text
"users"] :: [Text]

-- | Tab completion for @/splits-@. This completes only from the list of active
-- entries in the splits list.
tabActiveSplits :: Bool -> ClientCommand String
tabActiveSplits :: Bool -> ClientCommand String
tabActiveSplits Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st
  where
    completions :: [Text]
completions = [Text]
currentNetSplits [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
currentSplits
    currentSplits :: [Text]
currentSplits = [Focus -> Text
renderSplitFocus Focus
x | (Focus
x, Subfocus
FocusMessages) <- 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]
    currentNetSplits :: [Text]
currentNetSplits =
      [ Identifier -> Text
idText Identifier
chan
        | (ChannelFocus Text
net Identifier
chan, Subfocus
FocusMessages) <- 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
        , 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 Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
net
        ]

-- | When used on a channel that the user is currently
-- joined to this command will clear the messages but
-- preserve the window. When used on a window that the
-- user is not joined to this command will delete the window.
cmdClear :: ClientCommand (Maybe (String, Maybe String))
cmdClear :: ClientCommand (Maybe (String, Maybe String))
cmdClear ClientState
st Maybe (String, Maybe String)
args =
  case Maybe (String, Maybe String)
args of
    Maybe (String, Maybe String)
Nothing                      -> Focus -> IO CommandResult
forall (m :: * -> *). Monad m => Focus -> m CommandResult
clearFocus (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)
    Just (String
"*",     Maybe String
Nothing     ) -> Focus -> IO CommandResult
forall (m :: * -> *). Monad m => Focus -> m CommandResult
clearFocus Focus
Unfocused
    Just (String
network, Maybe String
Nothing     ) -> Focus -> IO CommandResult
forall (m :: * -> *). Monad m => Focus -> m CommandResult
clearFocus (Text -> Focus
NetworkFocus (String -> Text
Text.pack String
network))
    Just (String
network, Just String
"*"    ) -> String -> IO CommandResult
forall (m :: * -> *). Monad m => String -> m CommandResult
clearNetworkWindows String
network
    Just (String
network, Just String
channel) -> Focus -> IO CommandResult
forall (m :: * -> *). Monad m => Focus -> m CommandResult
clearFocus (Text -> Identifier -> Focus
ChannelFocus (String -> Text
Text.pack String
network) (Text -> Identifier
mkId (String -> Text
Text.pack String
channel)))
  where
    clearNetworkWindows :: String -> m CommandResult
clearNetworkWindows String
network
      = ClientState -> m CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
      (ClientState -> m CommandResult) -> ClientState -> m CommandResult
forall a b. (a -> b) -> a -> b
$ (ClientState -> Focus -> ClientState)
-> ClientState -> [Focus] -> ClientState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Focus -> ClientState -> ClientState)
-> ClientState -> Focus -> ClientState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Focus -> ClientState -> ClientState
clearFocus1) ClientState
st
      ([Focus] -> ClientState) -> [Focus] -> ClientState
forall a b. (a -> b) -> a -> b
$ (Focus -> Bool) -> [Focus] -> [Focus]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Focus
x -> Focus -> Maybe Text
focusNetwork Focus
x Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Text.pack String
network))
      ([Focus] -> [Focus]) -> [Focus] -> [Focus]
forall a b. (a -> b) -> a -> b
$ LensLike' (Const [Focus]) ClientState (Map Focus Window)
-> (Map Focus Window -> [Focus]) -> ClientState -> [Focus]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Focus]) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> [Focus]
forall k a. Map k a -> [k]
Map.keys ClientState
st

    clearFocus :: Focus -> m CommandResult
clearFocus Focus
focus = ClientState -> m CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Focus -> ClientState -> ClientState
clearFocus1 Focus
focus ClientState
st)

    clearFocus1 :: Focus -> ClientState -> ClientState
clearFocus1 Focus
focus ClientState
st' = ClientState -> ClientState
focusEffect (ClientState -> ClientState
windowEffect ClientState
st')
      where
        windowEffect :: ClientState -> ClientState
windowEffect = 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)
                           (if Bool
isActive then (Window -> Window) -> Maybe Window -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> Window
windowClear else Maybe Window -> Maybe Window -> Maybe Window
forall a b. a -> b -> a
const Maybe Window
forall a. Maybe a
Nothing)

        focusEffect :: ClientState -> ClientState
focusEffect
          | Bool
noChangeNeeded    = ClientState -> ClientState
forall a. a -> a
id
          | Bool
prevExists        = Focus -> ClientState -> ClientState
changeFocus Focus
prev
          | Bool
otherwise         = ClientState -> ClientState
advanceFocus
          where
            noChangeNeeded :: Bool
noChangeNeeded    = Bool
isActive Bool -> Bool -> Bool
|| Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st' Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
/= Focus
focus
            prevExists :: Bool
prevExists        = 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 Index (Map Focus Window)
Focus
prev) ClientState
st'

            prev :: Focus
prev              = 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

        isActive :: Bool
isActive =
          case Focus
focus of
            Focus
Unfocused                    -> Bool
False
            NetworkFocus network         -> Getting Any ClientState NetworkState -> ClientState -> Bool
forall s a. Getting Any s a -> s -> Bool
has (Text -> Getting Any ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st'
            ChannelFocus network channel -> Getting Any ClientState ChannelState -> ClientState -> Bool
forall s a. Getting Any s a -> s -> Bool
has (Text -> Getting Any ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                                                Getting Any ClientState NetworkState
-> ((ChannelState -> Const Any ChannelState)
    -> NetworkState -> Const Any NetworkState)
-> Getting Any ClientState ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> NetworkState -> Const Any NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const Any (HashMap Identifier ChannelState))
 -> NetworkState -> Const Any NetworkState)
-> ((ChannelState -> Const Any ChannelState)
    -> HashMap Identifier ChannelState
    -> Const Any (HashMap Identifier ChannelState))
-> (ChannelState -> Const Any ChannelState)
-> NetworkState
-> Const Any 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) ClientState
st'

-- | Tab completion for @/splits[+]@. When given no arguments this
-- populates the current list of splits, otherwise it tab completes
-- all of the currently available windows.
tabSplits :: Bool -> ClientCommand String
tabSplits :: Bool -> ClientCommand String
tabSplits Bool
isReversed ClientState
st String
rest

  -- If no arguments, populate the current splits
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
rest =
     let cmd :: String
cmd = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"/splits"
                       String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Text -> String
Text.unpack (Focus -> Text
renderSplitFocus Focus
x) | (Focus
x, Subfocus
FocusMessages) <- 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]
         newline :: Line
newline = String -> Line
Edit.endLine String
cmd
     in ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ASetter ClientState ClientState Line Line
-> Line -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((EditBox -> Identity EditBox)
-> ClientState -> Identity ClientState
Lens' ClientState EditBox
clientTextBox ((EditBox -> Identity EditBox)
 -> ClientState -> Identity ClientState)
-> ((Line -> Identity Line) -> EditBox -> Identity EditBox)
-> ASetter ClientState ClientState Line Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Identity Line) -> EditBox -> Identity EditBox
forall c. HasLine c => Lens' c Line
Edit.line) Line
newline ClientState
st)

  -- Tab complete the available windows. Accepts either fully qualified
  -- window names or current network names without the ':'
  | Bool
otherwise =
     let completions :: [Text]
completions = [Text]
currentNet [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
allWindows
         allWindows :: [Text]
allWindows  = Focus -> Text
renderSplitFocus (Focus -> Text) -> [Focus] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike' (Const [Focus]) ClientState (Map Focus Window)
-> (Map Focus Window -> [Focus]) -> ClientState -> [Focus]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Focus]) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> [Focus]
forall k a. Map k a -> [k]
Map.keys ClientState
st
         currentNet :: [Text]
currentNet  = case 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 of
                         Just Text
net -> Identifier -> Text
idText (Identifier -> Text) -> [Identifier] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
net ClientState
st
                         Maybe Text
Nothing  -> []
     in WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st

-- | Render a entry from splits back to the textual format.
renderSplitFocus :: Focus -> Text
renderSplitFocus :: Focus -> Text
renderSplitFocus Focus
Unfocused          = Text
"*"
renderSplitFocus (NetworkFocus Text
x)   = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
renderSplitFocus (ChannelFocus Text
x Identifier
y) = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
idText Identifier
y

-- | When tab completing the first parameter of the focus command
-- the current networks are used.
tabFocus :: Bool -> ClientCommand String
tabFocus :: Bool -> ClientCommand String
tabFocus Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Identifier]
-> [Identifier]
-> Bool
-> ClientState
-> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Identifier]
completions Bool
isReversed ClientState
st
  where
    networks :: [Identifier]
networks   = (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId ([Text] -> [Identifier]) -> [Text] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ HashMap Text NetworkState -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap Text NetworkState -> [Text])
-> HashMap Text NetworkState -> [Text]
forall a b. (a -> b) -> a -> b
$ Getting
  (HashMap Text NetworkState) ClientState (HashMap Text NetworkState)
-> ClientState -> HashMap Text NetworkState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Text NetworkState) ClientState (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections ClientState
st
    params :: [String]
params     = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String -> String) -> (Int, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> String -> String
forall a. Int -> [a] -> [a]
take ((Int, String) -> String) -> (Int, String) -> String
forall a b. (a -> b) -> a -> b
$ ClientState -> (Int, String)
clientLine ClientState
st

    completions :: [Identifier]
completions =
      case [String]
params of
        [String
_cmd,String
_net]      -> [Identifier]
networks
        [String
_cmd,String
net,String
_chan] -> Text -> ClientState -> [Identifier]
channelWindowsOnNetwork (String -> Text
Text.pack String
net) ClientState
st
        [String]
_                -> []

-- | @/channel@ command. Takes a channel or nickname and switches
-- focus to that target on the current network.
cmdChannel :: ClientCommand String
cmdChannel :: ClientCommand String
cmdChannel ClientState
st String
channel =
  case Maybe Text -> String -> Maybe Focus
parseFocus (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) String
channel of
    Just Focus
focus -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Focus -> ClientState -> ClientState
changeFocus Focus
focus ClientState
st)
    Maybe Focus
Nothing    -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"No current network" ClientState
st

-- | Tab completion for @/channel@. Tab completion uses pre-existing
-- windows.
tabChannel ::
  Bool {- ^ reversed order -} ->
  ClientCommand String
tabChannel :: Bool -> ClientCommand String
tabChannel Bool
isReversed ClientState
st String
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st
  where
    completions :: [Text]
completions = [Text]
currentNet [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
allWindows
    allWindows :: [Text]
allWindows  = Focus -> Text
renderSplitFocus (Focus -> Text) -> [Focus] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike' (Const [Focus]) ClientState (Map Focus Window)
-> (Map Focus Window -> [Focus]) -> ClientState -> [Focus]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Focus]) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> [Focus]
forall k a. Map k a -> [k]
Map.keys ClientState
st
    currentNet :: [Text]
currentNet  = case 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 of
                    Just Text
net -> Identifier -> Text
idText (Identifier -> Text) -> [Identifier] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
net ClientState
st
                    Maybe Text
Nothing  -> []

-- | Return the list of identifiers for open channel windows on
-- the given network name.
channelWindowsOnNetwork ::
  Text         {- ^ network              -} ->
  ClientState  {- ^ client state         -} ->
  [Identifier] {- ^ open channel windows -}
channelWindowsOnNetwork :: Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
network ClientState
st =
  [ Identifier
chan | ChannelFocus Text
net Identifier
chan <- Map Focus Window -> [Focus]
forall k a. Map k a -> [k]
Map.keys (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)
         , Text
net Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
network ]

-- | Implementation of @/dump@. Writes detailed contents of focused buffer
-- to the given filename.
cmdDump :: ClientCommand String
cmdDump :: ClientCommand String
cmdDump ClientState
st String
fp =
  do Either SomeException ()
res <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> Text -> IO ()
LText.writeFile String
fp ([Text] -> Text
LText.unlines [Text]
outputLines))
     case Either SomeException ()
res of
       Left SomeException
e  -> Text -> ClientState -> IO CommandResult
commandFailureMsg (String -> Text
Text.pack (SomeException -> String
forall e. Exception e => e -> String
displayException (SomeException
e :: SomeException))) ClientState
st
       Right{} -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

  where
    focus :: Focus
focus = 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

    outputLines :: [Text]
outputLines
      = [Text] -> [Text]
forall a. [a] -> [a]
reverse
      ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ClientState -> (Text -> Text) -> [Text] -> [Text]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st Text -> Text
forall a. a -> a
id
      ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Getting (Endo [Text]) ClientState Text -> ClientState -> [Text]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> ClientState -> Const (Endo [Text]) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
 -> ClientState -> Const (Endo [Text]) ClientState)
-> ((Text -> Const (Endo [Text]) Text)
    -> Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> Getting (Endo [Text]) ClientState Text
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 -> Const (Endo [Text]) Window)
 -> Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> ((Text -> Const (Endo [Text]) Text)
    -> Window -> Const (Endo [Text]) Window)
-> (Text -> Const (Endo [Text]) Text)
-> Map Focus Window
-> Const (Endo [Text]) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLines -> Const (Endo [Text]) WindowLines)
-> Window -> Const (Endo [Text]) Window
Lens' Window WindowLines
winMessages ((WindowLines -> Const (Endo [Text]) WindowLines)
 -> Window -> Const (Endo [Text]) Window)
-> ((Text -> Const (Endo [Text]) Text)
    -> WindowLines -> Const (Endo [Text]) WindowLines)
-> (Text -> Const (Endo [Text]) Text)
-> Window
-> Const (Endo [Text]) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Const (Endo [Text]) WindowLine)
-> WindowLines -> Const (Endo [Text]) WindowLines
forall s t a b. Each s t a b => Traversal s t a b
each ((WindowLine -> Const (Endo [Text]) WindowLine)
 -> WindowLines -> Const (Endo [Text]) WindowLines)
-> ((Text -> Const (Endo [Text]) Text)
    -> WindowLine -> Const (Endo [Text]) WindowLine)
-> (Text -> Const (Endo [Text]) Text)
-> WindowLines
-> Const (Endo [Text]) WindowLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> WindowLine -> Const (Endo [Text]) WindowLine
Getter WindowLine Text
wlText) ClientState
st