{-# Language OverloadedStrings, TemplateHaskell #-}
module Client.Commands.Window (windowCommands, parseFocus) where
import Client.Commands.Arguments.Spec
import Client.Commands.Docs (windowDocs, cmdDoc)
import Client.Commands.TabCompletion
import Client.Commands.Types
import Client.Commands.WordCompletion (plainWordCompleteMode)
import Client.Mask (buildMask)
import Client.State
import Client.State.EditBox qualified as Edit
import Client.State.Focus
import Client.State.Network (csChannels)
import Client.State.Window (windowClear, wlText, winMessages, winHidden, winActivityFilter, winName, activityFilterStrings, readActivityFilter)
import Control.Applicative (liftA2)
import Control.Exception (SomeException, Exception(displayException), try)
import Control.Lens
import Data.Foldable (Foldable(foldl', toList))
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.List ((\\), nub)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LText
import Data.Text.Lazy.IO qualified as LText
import Irc.Identifier (Identifier, idText, mkId)
windowCommands :: CommandSection
windowCommands :: CommandSection
windowCommands = Text -> [Command] -> CommandSection
CommandSection Text
"Window management"
[ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"focus")
(forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. String -> Args r String
simpleToken String
"network") (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[target]")))
$(windowDocs `cmdDoc` "focus")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (String, Maybe String)
cmdFocus Bool -> ClientCommand String
tabFocus
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text
"c" forall a. a -> [a] -> NonEmpty a
:| [Text
"channel"])
(forall r. String -> Args r String
simpleToken String
"focus")
$(windowDocs `cmdDoc` "channel")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdChannel Bool -> ClientCommand String
tabChannel
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"clear")
(forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. String -> Args r String
simpleToken String
"[network]") (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[channel]"))))
$(windowDocs `cmdDoc` "clear")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (Maybe (String, Maybe String))
cmdClear Bool -> ClientCommand String
tabFocus
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"windows")
(forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[kind]"))
$(windowDocs `cmdDoc` "windows")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdWindows Bool -> ClientCommand String
tabWindows
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits")
(forall r. String -> Args r String
remainingArg String
"focuses")
$(windowDocs `cmdDoc` "splits")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplits Bool -> ClientCommand String
tabSplits
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits+")
(forall r. String -> Args r String
remainingArg String
"focuses")
$(windowDocs `cmdDoc` "splits")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplitsAdd Bool -> ClientCommand String
tabSplits
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"splits-")
(forall r. String -> Args r String
remainingArg String
"focuses")
$(windowDocs `cmdDoc` "splits")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSplitsDel Bool -> ClientCommand String
tabActiveSplits
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"ignore")
(forall r. String -> Args r String
remainingArg String
"masks")
$(windowDocs `cmdDoc` "ignore")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdIgnore Bool -> ClientCommand String
tabIgnore
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"grep")
(forall r. String -> Args r String
remainingArg String
"regular-expression")
$(windowDocs `cmdDoc` "grep")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdGrep Bool -> ClientCommand String
simpleClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"dump")
(forall r. String -> Args r String
simpleToken String
"filename")
$(windowDocs `cmdDoc` "dump")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdDump Bool -> ClientCommand String
simpleClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"mentions")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(windowDocs `cmdDoc` "mentions")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdMentions Bool -> ClientCommand String
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"setwindow")
(forall r. String -> Args r String
simpleToken (String
"hide|show" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char
'|'forall a. a -> [a] -> [a]
:) [String]
activityFilterStrings))
$(windowDocs `cmdDoc` "setwindow")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdSetWindow Bool -> ClientCommand String
tabSetWindow
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"setname")
(forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[letter]"))
$(windowDocs `cmdDoc` "setname")
forall a b. (a -> b) -> a -> b
$ 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 =
let mbSt1 :: Maybe ClientState
mbSt1 = forall (m :: * -> *) s t a b.
Alternative m =>
LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window (Maybe Char)
winName) (\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 = Maybe WindowHint -> ClientState -> Char
clientNextWindowName (Focus -> ClientState -> Maybe WindowHint
clientWindowHint (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) ClientState
st) ClientState
st
mbName :: Either Text Char
mbName =
case Maybe String
arg of
Just [Char
n] | Char
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ClientState -> String
clientWindowNames ClientState
st -> forall a b. b -> Either a b
Right Char
n
Just String
_ -> forall a b. a -> Either a b
Left Text
"invalid name"
Maybe String
Nothing
| Char
next forall a. Eq a => a -> a -> Bool
/= Char
'\0' -> forall a b. b -> Either a b
Right Char
next
| Bool
otherwise -> 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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Char
name then forall a. Maybe a
Nothing else Maybe Char
n in
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window (Maybe Char)
winName) (forall a. a -> Maybe a
Just Char
name)
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Each s t a b => Traversal s t a b
each forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window (Maybe Char)
winName) Maybe Char -> Maybe Char
unset
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 forall (m :: * -> *) s t a b.
Alternative m =>
LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st)) Window -> Window
f ClientState
st of
Maybe ClientState
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"no such window" ClientState
st
Just ClientState
st' -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
where
mbFun :: Maybe (Window -> Window)
mbFun =
case String
cmd of
String
"show" -> forall a. a -> Maybe a
Just (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window Bool
winHidden Bool
False)
String
"hide" -> forall a. a -> Maybe a
Just (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window (Maybe Char)
winName forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window Bool
winHidden Bool
True)
String
other -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Window ActivityFilter
winActivityFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe ActivityFilter
readActivityFilter String
other
tabSetWindow :: Bool -> ClientCommand String
tabSetWindow :: Bool -> ClientCommand String
tabSetWindow Bool
isReversed ClientState
st String
_ =
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"forall a. a -> [a] -> [a]
:Text
"show"forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
activityFilterStrings
cmdGrep :: ClientCommand String
cmdGrep :: ClientCommand String
cmdGrep ClientState
st String
str
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Matcher)
clientRegex 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 -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Matcher)
clientRegex (forall a. a -> Maybe a
Just Matcher
r) ClientState
st)
cmdWindows :: ClientCommand (Maybe String)
cmdWindows :: ClientCommand (Maybe String)
cmdWindows ClientState
st Maybe String
arg =
case Maybe String
arg of
Maybe String
Nothing -> forall {m :: * -> *}. Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
AllWindows
Just String
"networks" -> forall {m :: * -> *}. Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
NetworkWindows
Just String
"channels" -> forall {m :: * -> *}. Monad m => WindowsFilter -> m CommandResult
success WindowsFilter
ChannelWindows
Just String
"users" -> 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 =
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus (WindowsFilter -> Subfocus
FocusWindows WindowsFilter
x) ClientState
st)
cmdMentions :: ClientCommand ()
cmdMentions :: ClientCommand ()
cmdMentions ClientState
st ()
_ = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
Text.words (String -> Text
Text.pack String
rest) of
[] -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusIgnoreList ClientState
st)
[Identifier]
xs -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st2
where
(HashSet Identifier
newIgnores, ClientState
st1) = (Lens' ClientState (HashSet Identifier)
clientIgnores 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 = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Mask
clientIgnoreMask ([Identifier] -> Mask
buildMask (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall m. Contains m => Index m -> Lens' m Bool
contains Index t
x) Bool -> Bool
not t
s
tabIgnore :: Bool -> ClientCommand String
tabIgnore :: Bool -> ClientCommand String
tabIgnore Bool
isReversed ClientState
st String
_ =
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 forall a. [a] -> [a] -> [a]
++ forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (HashSet Identifier)
clientIgnores forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ClientState
st
mode :: WordCompletionMode
mode = ClientState -> WordCompletionMode
currentNickCompletionMode ClientState
st
cmdSplits :: ClientCommand String
cmdSplits :: ClientCommand String
cmdSplits ClientState
st String
str =
ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ([(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus (forall a. Eq a => [a] -> [a]
nub [(Focus, Subfocus)]
args) ClientState
st)
cmdSplitsAdd :: ClientCommand String
cmdSplitsAdd :: ClientCommand String
cmdSplitsAdd ClientState
st String
str =
ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
let args' :: [(Focus, Subfocus)]
args'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Focus, Subfocus)]
args = [(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st)]
| Bool
otherwise = [(Focus, Subfocus)]
args
extras :: [(Focus, Subfocus)]
extras = forall a. Eq a => [a] -> [a]
nub ([(Focus, Subfocus)]
args' forall a. [a] -> [a] -> [a]
++ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st)
in forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ([(Focus, Subfocus)] -> ClientState -> ClientState
setExtraFocus [(Focus, Subfocus)]
extras ClientState
st)
cmdSplitsDel :: ClientCommand String
cmdSplitsDel :: ClientCommand String
cmdSplitsDel ClientState
st String
str =
ClientState
-> String
-> ([(Focus, Subfocus)] -> IO CommandResult)
-> IO CommandResult
withSplitFocuses ClientState
st String
str forall a b. (a -> b) -> a -> b
$ \[(Focus, Subfocus)]
args ->
let args' :: [(Focus, Subfocus)]
args'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Focus, Subfocus)]
args = [(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st, forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st)]
| Bool
otherwise = [(Focus, Subfocus)]
args
extras :: [(Focus, Subfocus)]
extras = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st forall a. Eq a => [a] -> [a] -> [a]
\\ [(Focus, Subfocus)]
args'
in 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 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(Maybe Text -> String -> Maybe Focus
parseFocus (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st))
(String -> [String]
words String
str)
parseFocus ::
Maybe Text ->
String ->
Maybe Focus
parseFocus :: Maybe Text -> String -> Maybe Focus
parseFocus Maybe Text
mbNet String
x =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
':') String
x of
(String
"*",String
"") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
Unfocused
(String
net,Char
_:String
"") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Focus
NetworkFocus (String -> Text
Text.pack String
net))
(String
net,Char
_:String
chan) -> 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 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 forall a. Eq a => a -> a -> Bool
== String
"*" = 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
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
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
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
_ =
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]
tabActiveSplits :: Bool -> ClientCommand String
tabActiveSplits :: Bool -> ClientCommand String
tabActiveSplits Bool
isReversed ClientState
st String
_ =
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 forall a. Semigroup a => a -> a -> a
<> [Text]
currentSplits
currentSplits :: [Text]
currentSplits = [Focus -> Text
renderSplitFocus Focus
x | (Focus
x, Subfocus
FocusMessages) <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st]
currentNetSplits :: [Text]
currentNetSplits =
[ Identifier -> Text
idText Identifier
chan
| (ChannelFocus Text
net Identifier
chan, Subfocus
FocusMessages) <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st
, forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
net
]
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 -> forall {m :: * -> *}. Monad m => Focus -> m CommandResult
clearFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st)
Just (String
"*", Maybe String
Nothing ) -> forall {m :: * -> *}. Monad m => Focus -> m CommandResult
clearFocus Focus
Unfocused
Just (String
network, Maybe String
Nothing ) -> forall {m :: * -> *}. Monad m => Focus -> m CommandResult
clearFocus (Text -> Focus
NetworkFocus (String -> Text
Text.pack String
network))
Just (String
network, Just String
"*" ) -> forall {m :: * -> *}. Monad m => String -> m CommandResult
clearNetworkWindows String
network
Just (String
network, Just String
channel) -> 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
= forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Focus -> ClientState -> ClientState
clearFocus1) ClientState
st
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Focus
x -> Focus -> Maybe Text
focusNetwork Focus
x forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (String -> Text
Text.pack String
network))
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (Map Focus Window)
clientWindows forall k a. Map k a -> [k]
Map.keys ClientState
st
clearFocus :: Focus -> m CommandResult
clearFocus Focus
focus = 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Focus
focus)
(if Bool
isActive then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> Window
windowClear else forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
focusEffect :: ClientState -> ClientState
focusEffect
| Bool
noChangeNeeded = 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
|| forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st' forall a. Eq a => a -> a -> Bool
/= Focus
focus
prevExists :: Bool
prevExists = forall s a. Getting Any s a -> s -> Bool
has (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
prev) ClientState
st'
prev :: Focus
prev = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientPrevFocus ClientState
st
isActive :: Bool
isActive =
case Focus
focus of
Focus
Unfocused -> Bool
False
NetworkFocus Text
network -> forall s a. Getting Any s a -> s -> Bool
has (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st'
ChannelFocus Text
network Identifier
channel -> forall s a. Getting Any s a -> s -> Bool
has (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel) ClientState
st'
tabSplits :: Bool -> ClientCommand String
tabSplits :: Bool -> ClientCommand String
tabSplits Bool
isReversed ClientState
st String
rest
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
rest =
let cmd :: String
cmd = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
"/splits"
forall a. a -> [a] -> [a]
: [Text -> String
Text.unpack (Focus -> Text
renderSplitFocus Focus
x) | (Focus
x, Subfocus
FocusMessages) <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState [(Focus, Subfocus)]
clientExtraFocus ClientState
st]
newline :: Line
newline = String -> Line
Edit.endLine String
cmd
in forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' ClientState EditBox
clientTextBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasLine c => Lens' c Line
Edit.line) Line
newline ClientState
st)
| Bool
otherwise =
let completions :: [Text]
completions = [Text]
currentNet forall a. Semigroup a => a -> a -> a
<> [Text]
allWindows
allWindows :: [Text]
allWindows = Focus -> Text
renderSplitFocus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (Map Focus Window)
clientWindows forall k a. Map k a -> [k]
Map.keys ClientState
st
currentNet :: [Text]
currentNet = case forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st of
Just Text
net -> Identifier -> Text
idText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
net ClientState
st
Maybe Text
Nothing -> []
in forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
completions Bool
isReversed ClientState
st
renderSplitFocus :: Focus -> Text
renderSplitFocus :: Focus -> Text
renderSplitFocus Focus
Unfocused = Text
"*"
renderSplitFocus (NetworkFocus Text
x) = Text
x forall a. Semigroup a => a -> a -> a
<> Text
":"
renderSplitFocus (ChannelFocus Text
x Identifier
y) = Text
x forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
idText Identifier
y
tabFocus :: Bool -> ClientCommand String
tabFocus :: Bool -> ClientCommand String
tabFocus Bool
isReversed ClientState
st String
_ =
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Identifier]
completions Bool
isReversed ClientState
st
where
networks :: [Identifier]
networks = forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HashMap.keys forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (HashMap Text NetworkState)
clientConnections ClientState
st
params :: [String]
params = String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Int -> [a] -> [a]
take 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]
_ -> []
cmdChannel :: ClientCommand String
cmdChannel :: ClientCommand String
cmdChannel ClientState
st String
channel =
case Maybe Text -> String -> Maybe Focus
parseFocus (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st) String
channel of
Just Focus
focus -> 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
tabChannel ::
Bool ->
ClientCommand String
tabChannel :: Bool -> ClientCommand String
tabChannel Bool
isReversed ClientState
st String
_ =
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 forall a. Semigroup a => a -> a -> a
<> [Text]
allWindows
allWindows :: [Text]
allWindows = Focus -> Text
renderSplitFocus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (Map Focus Window)
clientWindows forall k a. Map k a -> [k]
Map.keys ClientState
st
currentNet :: [Text]
currentNet = case forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st of
Just Text
net -> Identifier -> Text
idText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
net ClientState
st
Maybe Text
Nothing -> []
channelWindowsOnNetwork ::
Text ->
ClientState ->
[Identifier]
channelWindowsOnNetwork :: Text -> ClientState -> [Identifier]
channelWindowsOnNetwork Text
network ClientState
st =
[ Identifier
chan | ChannelFocus Text
net Identifier
chan <- forall k a. Map k a -> [k]
Map.keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st)
, Text
net forall a. Eq a => a -> a -> Bool
== Text
network ]
cmdDump :: ClientCommand String
cmdDump :: ClientCommand String
cmdDump ClientState
st String
fp =
do Either SomeException ()
res <- 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 (forall e. Exception e => e -> String
displayException (SomeException
e :: SomeException))) ClientState
st
Right{} -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st
where
focus :: Focus
focus = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
outputLines :: [Text]
outputLines
= forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window WindowLines
winMessages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Each s t a b => Traversal s t a b
each forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter WindowLine Text
wlText) ClientState
st