{-# Language OverloadedStrings #-}
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.Image.PackedImage
import Client.Mask (buildMask)
import Client.State
import Client.State.Focus
import Client.State.Network
import Client.State.Window (emptyWindow, WindowLines((:-), Nil), wlFullImage, winMessages)
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 "Window management"
[ Command
(pure "focus")
(liftA2 (,) (simpleToken "network") (optionalArg (simpleToken "[target]")))
"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"
$ ClientCommand cmdFocus tabFocus
, Command
("c" :| ["channel"])
(simpleToken "focus")
"\^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"
$ ClientCommand cmdChannel tabChannel
, Command
(pure "clear")
(optionalArg (liftA2 (,) (simpleToken "[network]") (optionalArg (simpleToken "[channel]"))))
"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"
$ ClientCommand cmdClear tabFocus
, Command
(pure "windows")
(optionalArg (simpleToken "[kind]"))
"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"
$ ClientCommand cmdWindows tabWindows
, Command
(pure "splits")
(remainingArg "focuses")
"\^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"
$ ClientCommand cmdSplits tabSplits
, Command
(pure "splits+")
(remainingArg "focuses")
"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"
$ ClientCommand cmdSplitsAdd tabSplits
, Command
(pure "splits-")
(remainingArg "focuses")
"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"
$ ClientCommand cmdSplitsDel tabActiveSplits
, Command
(pure "ignore")
(remainingArg "masks")
"\^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"
$ ClientCommand cmdIgnore tabIgnore
, Command
(pure "grep")
(remainingArg "regular-expression")
"Set the persistent regular expression.\n\
\\n\
\\^BFlags:\^B\n\
\ -An Show n messages after match\n\
\ -Bn Show n messages before match\n\
\ -Cn Show n messages before and after match\n\
\ -i Case insensitive match\n\
\ -v Invert pattern match\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"
$ ClientCommand cmdGrep simpleClientTab
, Command
(pure "dump")
(simpleToken "filename")
"Dump current buffer to file.\n"
$ ClientCommand cmdDump simpleClientTab
, Command
(pure "mentions")
(pure ())
"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"
$ ClientCommand cmdMentions noClientTab
]
cmdGrep :: ClientCommand String
cmdGrep st str
| null str = commandSuccess (set clientRegex Nothing st)
| otherwise =
case buildMatcher str of
Nothing -> commandFailureMsg "bad grep" st
Just r -> commandSuccess (set clientRegex (Just r) st)
cmdWindows :: ClientCommand (Maybe String)
cmdWindows st arg =
case arg of
Nothing -> success AllWindows
Just "networks" -> success NetworkWindows
Just "channels" -> success ChannelWindows
Just "users" -> success UserWindows
_ -> commandFailureMsg errmsg st
where
errmsg = "/windows expected networks, channels, or users"
success x =
commandSuccess (changeSubfocus (FocusWindows x) st)
cmdMentions :: ClientCommand ()
cmdMentions st _ = commandSuccess (changeSubfocus FocusMentions st)
cmdIgnore :: ClientCommand String
cmdIgnore st rest =
case mkId <$> Text.words (Text.pack rest) of
[] -> commandSuccess (changeSubfocus FocusIgnoreList st)
xs -> commandSuccess st2
where
(newIgnores, st1) = (clientIgnores <%~ updateIgnores) st
st2 = set clientIgnoreMask (buildMask (toList newIgnores)) st1
updateIgnores :: HashSet Identifier -> HashSet Identifier
updateIgnores s = foldl' updateIgnore s xs
updateIgnore s x = over (contains x) not s
tabIgnore :: Bool -> ClientCommand String
tabIgnore isReversed st _ =
simpleTabCompletion mode hint completions isReversed st
where
hint = activeNicks st
completions = currentCompletionList st ++ views clientIgnores toList st
mode = currentNickCompletionMode st
cmdSplits :: ClientCommand String
cmdSplits st str =
withSplitFocuses st str $ \args ->
commandSuccess (setExtraFocus (nub args) st)
cmdSplitsAdd :: ClientCommand String
cmdSplitsAdd st str =
withSplitFocuses st str $ \args ->
let args'
| null args = [(view clientFocus st, view clientSubfocus st)]
| otherwise = args
extras = nub (args' ++ view clientExtraFocus st)
in commandSuccess (setExtraFocus extras st)
cmdSplitsDel :: ClientCommand String
cmdSplitsDel st str =
withSplitFocuses st str $ \args ->
let args'
| null args = [(view clientFocus st, view clientSubfocus st)]
| otherwise = args
extras = view clientExtraFocus st \\ args'
in commandSuccess (setExtraFocus extras st)
withSplitFocuses ::
ClientState ->
String ->
([(Focus, Subfocus)] -> IO CommandResult) ->
IO CommandResult
withSplitFocuses st str k =
case mb of
Nothing -> commandFailureMsg "unable to parse arguments" st
Just args -> k [(x, FocusMessages) | x <- args]
where
mb = traverse
(parseFocus (views clientFocus focusNetwork st))
(words str)
parseFocus ::
Maybe Text ->
String ->
Maybe Focus
parseFocus mbNet x =
case break (==':') x of
("*","") -> pure Unfocused
(net,_:"") -> pure (NetworkFocus (Text.pack net))
(net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))
(chan,"") -> mbNet <&> \net ->
ChannelFocus net (mkId (Text.pack chan))
cmdFocus :: ClientCommand (String, Maybe String)
cmdFocus st (network, mbChannel)
| network == "*" = commandSuccess (changeFocus Unfocused st)
| otherwise =
case mbChannel of
Nothing ->
let focus = NetworkFocus (Text.pack network) in
commandSuccess (changeFocus focus st)
Just channel ->
let focus = ChannelFocus (Text.pack network) (mkId (Text.pack channel)) in
commandSuccess
$ changeFocus focus st
tabWindows :: Bool -> ClientCommand String
tabWindows isReversed st _ =
simpleTabCompletion plainWordCompleteMode [] completions isReversed st
where
completions = ["networks","channels","users"] :: [Text]
tabActiveSplits :: Bool -> ClientCommand String
tabActiveSplits isReversed st _ =
simpleTabCompletion plainWordCompleteMode [] completions isReversed st
where
completions = currentNetSplits <> currentSplits
currentSplits = [renderSplitFocus x | (x, FocusMessages) <- view clientExtraFocus st]
currentNetSplits =
[ idText chan
| (ChannelFocus net chan, FocusMessages) <- view clientExtraFocus st
, views clientFocus focusNetwork st == Just net
]
cmdClear :: ClientCommand (Maybe (String, Maybe String))
cmdClear st args =
case args of
Nothing -> clearFocus (view clientFocus st)
Just ("*", Nothing ) -> clearFocus Unfocused
Just (network, Nothing ) -> clearFocus (NetworkFocus (Text.pack network))
Just (network, Just "*" ) -> clearNetworkWindows network
Just (network, Just channel) -> clearFocus (ChannelFocus (Text.pack network) (mkId (Text.pack channel)))
where
clearNetworkWindows network
= commandSuccess
$ foldl' (flip clearFocus1) st
$ filter (\x -> focusNetwork x == Just (Text.pack network))
$ views clientWindows Map.keys st
clearFocus focus = commandSuccess (clearFocus1 focus st)
clearFocus1 focus st' = focusEffect (windowEffect st')
where
windowEffect = set (clientWindows . at focus)
(if isActive then Just emptyWindow else Nothing)
focusEffect
| noChangeNeeded = id
| prevExists = changeFocus prev
| otherwise = advanceFocus
where
noChangeNeeded = isActive || view clientFocus st' /= focus
prevExists = has (clientWindows . ix prev) st'
prev = view clientPrevFocus st
isActive =
case focus of
Unfocused -> False
NetworkFocus network -> has (clientConnection network) st'
ChannelFocus network channel -> has (clientConnection network
.csChannels . ix channel) st'
tabSplits :: Bool -> ClientCommand String
tabSplits isReversed st rest
| all (' '==) rest =
let cmd = unwords $ "/splits"
: [Text.unpack (renderSplitFocus x) | (x, FocusMessages) <- view clientExtraFocus st]
newline = Edit.endLine cmd
in commandSuccess (set (clientTextBox . Edit.line) newline st)
| otherwise =
let completions = currentNet <> allWindows
allWindows = renderSplitFocus <$> views clientWindows Map.keys st
currentNet = case views clientFocus focusNetwork st of
Just net -> idText <$> channelWindowsOnNetwork net st
Nothing -> []
in simpleTabCompletion plainWordCompleteMode [] completions isReversed st
renderSplitFocus :: Focus -> Text
renderSplitFocus Unfocused = "*"
renderSplitFocus (NetworkFocus x) = x <> ":"
renderSplitFocus (ChannelFocus x y) = x <> ":" <> idText y
tabFocus :: Bool -> ClientCommand String
tabFocus isReversed st _ =
simpleTabCompletion plainWordCompleteMode [] completions isReversed st
where
networks = map mkId $ HashMap.keys $ view clientConnections st
params = words $ uncurry take $ clientLine st
completions =
case params of
[_cmd,_net] -> networks
[_cmd,net,_chan] -> channelWindowsOnNetwork (Text.pack net) st
_ -> []
cmdChannel :: ClientCommand String
cmdChannel st channel =
case parseFocus (views clientFocus focusNetwork st) channel of
Just focus -> commandSuccess (changeFocus focus st)
Nothing -> commandFailureMsg "No current network" st
tabChannel ::
Bool ->
ClientCommand String
tabChannel isReversed st _ =
simpleTabCompletion plainWordCompleteMode [] completions isReversed st
where
completions = currentNet <> allWindows
allWindows = renderSplitFocus <$> views clientWindows Map.keys st
currentNet = case views clientFocus focusNetwork st of
Just net -> idText <$> channelWindowsOnNetwork net st
Nothing -> []
channelWindowsOnNetwork ::
Text ->
ClientState ->
[Identifier]
channelWindowsOnNetwork network st =
[ chan | ChannelFocus net chan <- Map.keys (view clientWindows st)
, net == network ]
cmdDump :: ClientCommand String
cmdDump st fp =
do res <- try (LText.writeFile fp (LText.unlines outputLines))
case res of
Left e -> commandFailureMsg (Text.pack (displayException (e :: SomeException))) st
Right{} -> commandSuccess st
where
focus = view clientFocus st
msgs = preview (clientWindows . ix focus . winMessages) st
outputLines =
case msgs of
Nothing -> []
Just wls -> convert [] wls
convert acc Nil = acc
convert acc (wl :- wls) = convert (views wlFullImage imageText wl : acc) wls