{-|
Module      : Client.Commands.TabCompletion
Description : Common tab-completion logic
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.TabCompletion where

import Client.Commands.Types
import Client.Commands.WordCompletion (wordComplete, Prefix, WordCompletionMode)
import Client.Message (IrcSummary(ChatSummary))
import Client.State
import Client.State.Channel (chanUsers)
import Client.State.Focus (Focus(ChannelFocus))
import Client.State.Network (csChannels, csNick)
import Client.State.Window (winMessages, wlSummary)
import Control.Lens (view, filtered, folding, preview, toListOf, traverseOf, Ixed(ix), Each(each))
import Irc.Identifier (Identifier)
import Irc.UserInfo (UserInfo(userNick))
import qualified Data.HashMap.Strict as HashMap

-- | Provides no tab completion for client commands
noClientTab :: Bool -> ClientCommand String
noClientTab :: Bool -> ClientCommand String
noClientTab Bool
_ ClientState
st String
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

-- | Provides no tab completion for network commands
noNetworkTab :: Bool -> NetworkCommand String
noNetworkTab :: Bool -> NetworkCommand String
noNetworkTab Bool
_ NetworkState
_ ClientState
st String
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

-- | Provides no tab completion for channel commands
noChannelTab :: Bool -> ChannelCommand String
noChannelTab :: Bool -> ChannelCommand String
noChannelTab Bool
_ Identifier
_ NetworkState
_ ClientState
st String
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

-- | Provides nickname based tab completion for client commands
simpleClientTab :: Bool -> ClientCommand String
simpleClientTab :: Bool -> ClientCommand String
simpleClientTab Bool
isReversed ClientState
st String
_ =
  Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st

-- | Provides nickname based tab completion for network commands
simpleNetworkTab :: Bool -> NetworkCommand String
simpleNetworkTab :: Bool -> NetworkCommand String
simpleNetworkTab Bool
isReversed NetworkState
_ ClientState
st String
_ =
  Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st

-- | Provides nickname based tab completion for channel commands
simpleChannelTab :: Bool -> ChannelCommand String
simpleChannelTab :: Bool -> ChannelCommand String
simpleChannelTab Bool
isReversed Identifier
_ NetworkState
_ ClientState
st String
_ =
  Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st

simpleTabCompletion ::
  Prefix a =>
  WordCompletionMode {- ^ word completion mode -} ->
  [a]                {- ^ hints                -} ->
  [a]                {- ^ all completions      -} ->
  Bool               {- ^ reversed order       -} ->
  ClientState        {- ^ client state         -} ->
  IO CommandResult
simpleTabCompletion :: forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion = forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> [a]
-> [a]
-> Bool
-> ClientState
-> IO CommandResult
simpleTabCompletion' (Char
' ' forall a. Eq a => a -> a -> Bool
/=)

simpleTabCompletion' ::
  Prefix a =>
  (Char -> Bool)     {- ^ valid characters     -} ->
  WordCompletionMode {- ^ word completion mode -} ->
  [a]                {- ^ hints                -} ->
  [a]                {- ^ all completions      -} ->
  Bool               {- ^ reversed order       -} ->
  ClientState        {- ^ client state         -} ->
  IO CommandResult
simpleTabCompletion' :: forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> [a]
-> [a]
-> Bool
-> ClientState
-> IO CommandResult
simpleTabCompletion' Char -> Bool
p WordCompletionMode
mode [a]
hints [a]
completions Bool
isReversed ClientState
st =
  case forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf Lens' ClientState EditBox
clientTextBox EditBox -> Maybe EditBox
tryCompletion ClientState
st of
    Maybe ClientState
Nothing  -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
    Just ClientState
st' -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
  where
    tryCompletion :: EditBox -> Maybe EditBox
tryCompletion = forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
wordComplete Char -> Bool
p WordCompletionMode
mode Bool
isReversed [a]
hints [a]
completions

-- | Complete the nickname at the current cursor position using the
-- userlist for the currently focused channel (if any)
nickTabCompletion :: Bool {- ^ reversed -} -> ClientState -> IO CommandResult
nickTabCompletion :: Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st =
  forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> [a]
-> [a]
-> Bool
-> ClientState
-> IO CommandResult
simpleTabCompletion' Char -> Bool
isNickChar 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
    mode :: WordCompletionMode
mode          = ClientState -> WordCompletionMode
currentNickCompletionMode ClientState
st

isNickChar :: Char -> Bool
isNickChar :: Char -> Bool
isNickChar Char
x = Char -> Char -> Bool
inrange Char
'a' Char
'z' Bool -> Bool -> Bool
|| Char -> Char -> Bool
inrange Char
'A' Char
'Z' Bool -> Bool -> Bool
|| Char -> Char -> Bool
inrange Char
'0' Char
'9'
            Bool -> Bool -> Bool
|| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"-[\\]^_`{}|#"
  where inrange :: Char -> Char -> Bool
inrange Char
lo Char
hi = Char
lo forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
hi

activeNicks ::
  ClientState ->
  [Identifier]
activeNicks :: ClientState -> [Identifier]
activeNicks ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
    focus :: Focus
focus@(ChannelFocus Text
network Identifier
channel) ->
      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
. Lens' WindowLine IrcSummary
wlSummary        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding IrcSummary -> Maybe Identifier
chatActor
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Identifier -> Bool
isActive
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Identifier -> Bool
isNotSelf ) ClientState
st
      where
        isActive :: Identifier -> Bool
isActive Identifier
n = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Identifier
n HashMap Identifier String
userMap
        self :: Maybe Identifier
self = 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
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState Identifier
csNick ) ClientState
st
        isNotSelf :: Identifier -> Bool
isNotSelf Identifier
n = case Maybe Identifier
self of
                        Maybe Identifier
Nothing -> Bool
True
                        Just Identifier
s -> Identifier
n forall a. Eq a => a -> a -> Bool
/= Identifier
s
        userMap :: HashMap Identifier String
userMap = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ( 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
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers) ClientState
st

    Focus
_ -> []

  where
    -- Returns the 'Identifier' of the nickname responsible for
    -- the window line when that action was significant enough to
    -- be considered a hint for tab completion.
    chatActor :: IrcSummary -> Maybe Identifier
    chatActor :: IrcSummary -> Maybe Identifier
chatActor (ChatSummary UserInfo
who) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! UserInfo -> Identifier
userNick UserInfo
who
    chatActor IrcSummary
_                 = forall a. Maybe a
Nothing