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

module Client.Commands.Channel (channelCommands) where

import Client.Commands.Arguments.Spec
import Client.Commands.Docs (chanopDocs, cmdDoc)
import Client.Commands.TabCompletion (activeNicks, noChannelTab, simpleChannelTab, simpleTabCompletion)
import Client.Commands.Types
import Client.Commands.WordCompletion (plainWordCompleteMode)
import Client.State
import Client.State.Channel (chanLists, chanModes, chanTopic, chanUsers)
import Client.State.EditBox qualified as Edit
import Client.State.Focus
import Client.State.Network
import Client.UserHost ( UserAndHost(UserAndHost) )
import Control.Applicative (liftA2)
import Control.Lens
import Control.Monad (unless)
import Data.Foldable (traverse_)
import Data.HashMap.Strict qualified as HashMap
import Data.List.Split (chunksOf)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Irc.Commands (ircInvite, ircKick, ircMode, ircRemove)
import Irc.Identifier (Identifier, mkId)
import Irc.Modes
import Irc.UserInfo (UserInfo(UserInfo), renderUserInfo)

channelCommands :: CommandSection
channelCommands :: CommandSection
channelCommands = Text -> [Command] -> CommandSection
CommandSection Text
"IRC channel management"

  [ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"mode")
      (forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r a. [Char] -> (r -> [Char] -> Maybe (Args r a)) -> Args r a
extensionArg [Char]
"[modes]" ClientState -> [Char] -> Maybe (Ap (Arg ClientState) [[Char]])
modeParamArgs))
      $(chanopDocs `cmdDoc` "mode")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [[Char]]
cmdMode Bool -> NetworkCommand [Char]
tabMode

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"masks")
      (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"mode")
      $(chanopDocs `cmdDoc` "masks")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand [Char]
cmdMasks Bool -> ChannelCommand [Char]
noChannelTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"invite")
      (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"nick")
      $(chanopDocs `cmdDoc` "invite")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand [Char]
cmdInvite Bool -> ChannelCommand [Char]
simpleChannelTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"topic")
      (forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message")
      $(chanopDocs `cmdDoc` "topic")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand [Char]
cmdTopic Bool -> ChannelCommand [Char]
tabTopic

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"kick")
      (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"nick") (forall r. [Char] -> Args r [Char]
remainingArg [Char]
"reason"))
      $(chanopDocs `cmdDoc` "kick")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand ([Char], [Char])
cmdKick Bool -> ChannelCommand [Char]
simpleChannelTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"kickban")
      (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"nick") (forall r. [Char] -> Args r [Char]
remainingArg [Char]
"reason"))
      $(chanopDocs `cmdDoc` "kickban")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand ([Char], [Char])
cmdKickBan Bool -> ChannelCommand [Char]
simpleChannelTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"remove")
      (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"nick") (forall r. [Char] -> Args r [Char]
remainingArg [Char]
"reason"))
      $(chanopDocs `cmdDoc` "remove")
    forall a b. (a -> b) -> a -> b
$ forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand ([Char], [Char])
cmdRemove Bool -> ChannelCommand [Char]
simpleChannelTab

  ]

cmdRemove :: ChannelCommand (String, String)
cmdRemove :: ChannelCommand ([Char], [Char])
cmdRemove Identifier
channelId NetworkState
cs ClientState
st ([Char]
who,[Char]
reason) =
  do let msg :: Text
msg = [Char] -> Text
Text.pack [Char]
reason
         cmd :: RawIrcMsg
cmd = Identifier -> Text -> Text -> RawIrcMsg
ircRemove Identifier
channelId ([Char] -> Text
Text.pack [Char]
who) Text
msg
     NetworkState
cs' <- Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
channelId [RawIrcMsg
cmd] NetworkState
cs
     NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' ClientState
st

cmdKick :: ChannelCommand (String, String)
cmdKick :: ChannelCommand ([Char], [Char])
cmdKick Identifier
channelId NetworkState
cs ClientState
st ([Char]
who,[Char]
reason) =
  do let msg :: Text
msg = [Char] -> Text
Text.pack [Char]
reason
         cmd :: RawIrcMsg
cmd = Identifier -> Text -> Text -> RawIrcMsg
ircKick Identifier
channelId ([Char] -> Text
Text.pack [Char]
who) Text
msg
     NetworkState
cs' <- Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
channelId [RawIrcMsg
cmd] NetworkState
cs
     NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' ClientState
st


cmdKickBan :: ChannelCommand (String, String)
cmdKickBan :: ChannelCommand ([Char], [Char])
cmdKickBan Identifier
channelId NetworkState
cs ClientState
st ([Char]
who,[Char]
reason) =
  do let msg :: Text
msg = [Char] -> Text
Text.pack [Char]
reason

         whoTxt :: Text
whoTxt     = [Char] -> Text
Text.pack [Char]
who

         mask :: Text
mask = UserInfo -> Text
renderUserInfo (Identifier -> NetworkState -> UserInfo
computeBanUserInfo (Text -> Identifier
mkId Text
whoTxt) NetworkState
cs)
         cmds :: [RawIrcMsg]
cmds = [ Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
channelId [Text
"b", Text
mask]
                , Identifier -> Text -> Text -> RawIrcMsg
ircKick Identifier
channelId Text
whoTxt Text
msg
                ]
     NetworkState
cs' <- Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
channelId [RawIrcMsg]
cmds NetworkState
cs
     NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' ClientState
st

cmdInvite :: ChannelCommand String
cmdInvite :: ChannelCommand [Char]
cmdInvite Identifier
channelId NetworkState
cs ClientState
st [Char]
nick =
  do let freeTarget :: Bool
freeTarget = forall s a. Getting Any s a -> s -> Bool
has (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
channelId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char Text)
chanModes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
'g') NetworkState
cs
         cmd :: RawIrcMsg
cmd = Text -> Identifier -> RawIrcMsg
ircInvite ([Char] -> Text
Text.pack [Char]
nick) Identifier
channelId
     NetworkState
cs' <- if Bool
freeTarget
              then NetworkState
cs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
cmd
              else Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
channelId [RawIrcMsg
cmd] NetworkState
cs
     NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' ClientState
st

cmdMasks :: ChannelCommand String
cmdMasks :: ChannelCommand [Char]
cmdMasks Identifier
channel NetworkState
cs ClientState
st [Char]
rest =
  case [Char]
rest of
    [Char
mode] | Char
mode forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState ModeTypes
csModeTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists) NetworkState
cs ->

        do let connecting :: Bool
connecting = forall s a. Getting Any s a -> s -> Bool
has (Lens' NetworkState PingStatus
csPingStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting) NetworkState
cs
               listLoaded :: Bool
listLoaded = forall s a. Getting Any s a -> s -> Bool
has (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
mode) NetworkState
cs
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
connecting Bool -> Bool -> Bool
|| Bool
listLoaded)
             (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
channel [Char -> Text
Text.singleton Char
mode]))

           forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus (Char -> Subfocus
FocusMasks Char
mode) ClientState
st)

    [Char]
_ -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown mask mode" ClientState
st

computeBanUserInfo :: Identifier -> NetworkState    -> UserInfo
computeBanUserInfo :: Identifier -> NetworkState -> UserInfo
computeBanUserInfo Identifier
who NetworkState
cs =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall (f :: * -> *).
Functor f =>
Identifier -> LensLike' f NetworkState (Maybe UserAndHost)
csUser Identifier
who) NetworkState
cs of
    Maybe UserAndHost
Nothing                     -> Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
who Text
"*" Text
"*"
    Just (UserAndHost Text
_ Text
host Text
_) -> Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
"*" Text
"*" Text
host

cmdTopic :: ChannelCommand String
cmdTopic :: ChannelCommand [Char]
cmdTopic Identifier
channelId NetworkState
cs ClientState
st [Char]
rest =
  do Identifier -> Text -> NetworkState -> IO ()
sendTopic Identifier
channelId ([Char] -> Text
Text.pack [Char]
rest) NetworkState
cs
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

tabTopic ::
  Bool {- ^ reversed -} ->
  ChannelCommand String
tabTopic :: Bool -> ChannelCommand [Char]
tabTopic Bool
_ Identifier
channelId NetworkState
cs ClientState
st [Char]
rest

  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
rest
  , Just Text
topic <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (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
channelId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState Text
chanTopic) NetworkState
cs =
     do let textBox :: EditBox -> EditBox
textBox = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasLine c => Lens' c Line
Edit.line ([Char] -> Line
Edit.endLine forall a b. (a -> b) -> a -> b
$ [Char]
"/topic " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
topic)
        forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState EditBox
clientTextBox EditBox -> EditBox
textBox ClientState
st)

  | Bool
otherwise = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

cmdMode :: NetworkCommand [String]
cmdMode :: NetworkCommand [[Char]]
cmdMode NetworkState
cs ClientState
st [[Char]]
xs = [Text] -> NetworkState -> ClientState -> IO CommandResult
modeCommand ([Char] -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
xs) NetworkState
cs ClientState
st

modeCommand ::
  [Text] {- mode parameters -} ->
  NetworkState                 ->
  ClientState                  ->
  IO CommandResult
modeCommand :: [Text] -> NetworkState -> ClientState -> IO CommandResult
modeCommand [Text]
modes NetworkState
cs ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of

    NetworkFocus Text
_ ->
      do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> [Text] -> RawIrcMsg
ircMode (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs) [Text]
modes)
         forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

    ChannelFocus Text
_ Identifier
chan ->
      case [Text]
modes of
        [] -> Bool -> [[Text]] -> IO CommandResult
success Bool
False [[]]
        Text
flags:[Text]
params ->
          case ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs) Text
flags [Text]
params of
            Maybe [(Bool, Char, Text)]
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"failed to parse modes" ClientState
st
            Just [(Bool, Char, Text)]
parsedModes ->
              Bool -> [[Text]] -> IO CommandResult
success Bool
needOp ([(Bool, Char, Text)] -> [Text]
unsplitModes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Int -> [e] -> [[e]]
chunksOf (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Int
csModeCount NetworkState
cs) [(Bool, Char, Text)]
parsedModes')
              where
                parsedModes' :: [(Bool, Char, Text)]
parsedModes'
                  | Identifier -> NetworkState -> Bool
useChanServ Identifier
chan NetworkState
cs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Char, Text) -> Bool
isOpMe) [(Bool, Char, Text)]
parsedModes
                  | Bool
otherwise           = [(Bool, Char, Text)]
parsedModes

                needOp :: Bool
needOp = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool, Char, Text) -> Bool
isPublicChannelMode [(Bool, Char, Text)]
parsedModes)
      where
        isOpMe :: (Bool, Char, Text) -> Bool
isOpMe (Bool
True, Char
'o', Text
param) = Text -> Identifier
mkId Text
param forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs
        isOpMe (Bool, Char, Text)
_                  = Bool
False

        success :: Bool -> [[Text]] -> IO CommandResult
success Bool
needOp [[Text]]
argss =
          do let cmds :: [RawIrcMsg]
cmds = Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
chan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]]
argss
             NetworkState
cs' <- if Bool
needOp
                      then Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
chan [RawIrcMsg]
cmds NetworkState
cs
                      else NetworkState
cs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) [RawIrcMsg]
cmds
             NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' ClientState
st

    Focus
_ -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

tabMode :: Bool -> NetworkCommand String
tabMode :: Bool -> NetworkCommand [Char]
tabMode Bool
isReversed NetworkState
cs ClientState
st [Char]
rest =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of

    ChannelFocus Text
_ Identifier
channel
      | Text
flags:[Text]
params     <- Text -> [Text]
Text.words ([Char] -> Text
Text.pack [Char]
rest)
      , Just [(Bool, Char, Text)]
parsedModes <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs) Text
flags [Text]
params
      , let parsedModesWithParams :: [(Bool, Char)]
parsedModesWithParams =
              [ (Bool
pol,Char
mode) | (Bool
pol,Char
mode,Text
arg) <- [(Bool, Char, Text)]
parsedModes, Bool -> Bool
not (Text -> Bool
Text.null Text
arg) ]
      , (Bool
pol,Char
mode):[(Bool, Char)]
_      <- forall a. Int -> [a] -> [a]
drop (Int
paramIndexforall a. Num a => a -> a -> a
-Int
3) [(Bool, Char)]
parsedModesWithParams
      , let ([Identifier]
hint, [Identifier]
completions) = Bool
-> Char
-> Identifier
-> NetworkState
-> ClientState
-> ([Identifier], [Identifier])
computeModeCompletion Bool
pol Char
mode Identifier
channel NetworkState
cs ClientState
st
      -> forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [Identifier]
hint [Identifier]
completions Bool
isReversed ClientState
st

    Focus
_ -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

  where
    paramIndex :: Int
paramIndex = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
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, [Char])
clientLine ClientState
st

modeParamArgs :: ClientState -> String -> Maybe (Args ClientState [String])
modeParamArgs :: ClientState -> [Char] -> Maybe (Ap (Arg ClientState) [[Char]])
modeParamArgs ClientState
st [Char]
str =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
    Focus
Unfocused      -> forall a. Maybe a
Nothing
    NetworkFocus Text
_ -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
str])
    ChannelFocus Text
net Identifier
_ ->

         -- determine current mode types
      do NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st
         let types :: ModeTypes
types = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs

         -- parse the list of modes being set
         [(Bool, Char, Text)]
flags <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes ModeTypes
types ([Char] -> Text
Text.pack [Char]
str) []

         -- generate the argument specification
         let ([[Char]]
req,[[Char]]
opt) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModeTypes
-> (Bool, Char, Text)
-> ([[Char]], [[Char]])
-> ([[Char]], [[Char]])
countFlags ModeTypes
types) ([],[]) [(Bool, Char, Text)]
flags
         forall (m :: * -> *) a. Monad m => a -> m a
return (([Char]
strforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. [[Char]] -> [[Char]] -> Args r [[Char]]
tokenList [[Char]]
req (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++[Char]
"?") [[Char]]
opt))

-- | This function computes the list of required and optional parameters
-- corresponding to the flags that have been entered.
countFlags ::
  ModeTypes           {- ^ network's mode behaviors              -} ->
  (Bool, Char, Text)  {- ^ polarity mode-letter unused-parameter -} ->
  ([String],[String]) {- ^ required-names optional-names         -} ->
  ([String],[String]) {- ^ required-names optional-names         -}
countFlags :: ModeTypes
-> (Bool, Char, Text)
-> ([[Char]], [[Char]])
-> ([[Char]], [[Char]])
countFlags ModeTypes
types (Bool
pol, Char
flag, Text
_)
  |        Char
flag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists       ModeTypes
types = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
addOpt
  | Bool
pol Bool -> Bool -> Bool
&& Char
flag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg      ModeTypes
types = forall {b}. ([[Char]], b) -> ([[Char]], b)
addReq
  |        Char
flag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesAlwaysArg   ModeTypes
types = forall {b}. ([[Char]], b) -> ([[Char]], b)
addReq
  | forall a s. Eq a => Getting Any s a -> a -> s -> Bool
elemOf (forall (f :: * -> *).
Functor f =>
([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1) Char
flag ModeTypes
types = forall {b}. ([[Char]], b) -> ([[Char]], b)
addReq
  | Bool
otherwise                                      = forall a. a -> a
id
  where
    addReq :: ([[Char]], b) -> ([[Char]], b)
addReq ([[Char]]
req,b
opt) = ((Char
flagforall a. a -> [a] -> [a]
:[Char]
" param")forall a. a -> [a] -> [a]
:[[Char]]
req,b
opt)
    addOpt :: ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
addOpt ([] ,[[Char]]
opt) = ([], (Char
flagforall a. a -> [a] -> [a]
:[Char]
" param")forall a. a -> [a] -> [a]
:[[Char]]
opt)
    addOpt ([[Char]]
req,[[Char]]
opt) = ((Char
flagforall a. a -> [a] -> [a]
:[Char]
" param")forall a. a -> [a] -> [a]
:[[Char]]
req,[[Char]]
opt)


-- | Use the *!*@host masks of users for channel lists when setting list modes
--
-- Use the channel's mask list for removing modes
--
-- Use the nick list otherwise
computeModeCompletion ::
  Bool {- ^ mode polarity -} ->
  Char {- ^ mode          -} ->
  Identifier {- ^ channel -} ->
  NetworkState    ->
  ClientState ->
  ([Identifier],[Identifier]) {- ^ (hint, complete) -}
computeModeCompletion :: Bool
-> Char
-> Identifier
-> NetworkState
-> ClientState
-> ([Identifier], [Identifier])
computeModeCompletion Bool
pol Char
mode Identifier
channel NetworkState
cs ClientState
st
  | Char
mode forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists ModeTypes
modeSettings =
        if Bool
pol then ([],[Identifier]
usermasks forall a. Semigroup a => a -> a -> a
<> [Identifier]
accounts) else ([],[Identifier]
masks)
  | Bool
otherwise = (ClientState -> [Identifier]
activeNicks ClientState
st, [Identifier]
nicks)
  where
    modeSettings :: ModeTypes
modeSettings = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs
    nicks :: [Identifier]
nicks = forall k v. HashMap k v -> [k]
HashMap.keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier [Char])
chanUsers) NetworkState
cs)

    masks :: [Identifier]
masks = Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. HashMap k v -> [k]
HashMap.keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
mode) NetworkState
cs)

    usermasks :: [Identifier]
usermasks =
      [ Text -> Identifier
mkId (Text
"*!*@" forall a. Semigroup a => a -> a -> a
<> Text
host)
        | Identifier
nick <- forall k v. HashMap k v -> [k]
HashMap.keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier [Char])
chanUsers) NetworkState
cs)
        , UserAndHost Text
_ Text
host Text
_ <- forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
nick) NetworkState
cs
        ]
    accounts :: [Identifier]
accounts =
      [ Text -> Identifier
mkId (Text
"$a:" forall a. Semigroup a => a -> a -> a
<> Text
account)
        | Identifier
nick <- forall k v. HashMap k v -> [k]
HashMap.keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier [Char])
chanUsers) NetworkState
cs)
        , UserAndHost Text
_ Text
_ Text
account <- forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
nick) NetworkState
cs
        , Bool -> Bool
not (Text -> Bool
Text.null Text
account)
        ]

-- | Predicate for mode commands that can be performed without ops
isPublicChannelMode :: (Bool, Char, Text) -> Bool
isPublicChannelMode :: (Bool, Char, Text) -> Bool
isPublicChannelMode (Bool
True, Char
'b', Text
param) = Text -> Bool
Text.null Text
param -- query ban list
isPublicChannelMode (Bool
True, Char
'q', Text
param) = Text -> Bool
Text.null Text
param -- query quiet list
isPublicChannelMode (Bool, Char, Text)
_                  = Bool
False