{-# Language OverloadedStrings, TemplateHaskell #-}
{-|
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.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 =
  -- unset current name so that it becomes available
  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 {- ^ reversed -} -> 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

-- | Implementation of @/grep@
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)

-- | 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         -> 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)

-- | Implementation of @/mentions@ command. Set subfocus to Mentions.
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

-- | 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
_ =
  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

-- | 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 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)


-- | 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 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)

-- | 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 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)

-- | 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 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]

-- | 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
_ =
  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
        ]

-- | 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                      -> 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'

-- | 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
  | 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)

  -- 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 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

-- | 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 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

-- | 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
_ =
  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]
_                -> []

-- | @/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 (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

-- | 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
_ =
  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  -> []

-- | 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 <- 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 ]

-- | 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 <- 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