{-# Language OverloadedStrings, TemplateHaskell #-}
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 ->
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] ->
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
_ ->
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
[(Bool, Char, Text)]
flags <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes ModeTypes
types ([Char] -> Text
Text.pack [Char]
str) []
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))
countFlags ::
ModeTypes ->
(Bool, Char, Text) ->
([String],[String]) ->
([String],[String])
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)
computeModeCompletion ::
Bool ->
Char ->
Identifier ->
NetworkState ->
ClientState ->
([Identifier],[Identifier])
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)
]
isPublicChannelMode :: (Bool, Char, Text) -> Bool
isPublicChannelMode :: (Bool, Char, Text) -> Bool
isPublicChannelMode (Bool
True, Char
'b', Text
param) = Text -> Bool
Text.null Text
param
isPublicChannelMode (Bool
True, Char
'q', Text
param) = Text -> Bool
Text.null Text
param
isPublicChannelMode (Bool, Char, Text)
_ = Bool
False