{-|
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
_ = ClientState -> IO CommandResult
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
_ = ClientState -> IO CommandResult
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
_ = ClientState -> IO CommandResult
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 = (Char -> Bool)
-> WordCompletionMode
-> [a]
-> [a]
-> Bool
-> ClientState
-> IO CommandResult
forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> [a]
-> [a]
-> Bool
-> ClientState
-> IO CommandResult
simpleTabCompletion' (Char
' ' Char -> Char -> Bool
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 LensLike Maybe ClientState ClientState EditBox EditBox
-> LensLike Maybe ClientState ClientState EditBox EditBox
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike Maybe ClientState ClientState EditBox EditBox
Lens' ClientState EditBox
clientTextBox EditBox -> Maybe EditBox
tryCompletion ClientState
st of
    Maybe ClientState
Nothing  -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
    Just ClientState
st' -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
  where
    tryCompletion :: EditBox -> Maybe EditBox
tryCompletion = (Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
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 =
  (Char -> Bool)
-> WordCompletionMode
-> [Identifier]
-> [Identifier]
-> Bool
-> ClientState
-> IO CommandResult
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 Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
hi

activeNicks ::
  ClientState ->
  [Identifier]
activeNicks :: ClientState -> [Identifier]
activeNicks ClientState
st =
  case Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st of
    focus :: Focus
focus@(ChannelFocus Text
network Identifier
channel) ->
      Getting (Endo [Identifier]) ClientState Identifier
-> ClientState -> [Identifier]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf
        ( (Map Focus Window -> Const (Endo [Identifier]) (Map Focus Window))
-> ClientState -> Const (Endo [Identifier]) ClientState
Lens' ClientState (Map Focus Window)
clientWindows    ((Map Focus Window -> Const (Endo [Identifier]) (Map Focus Window))
 -> ClientState -> Const (Endo [Identifier]) ClientState)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> Map Focus Window
    -> Const (Endo [Identifier]) (Map Focus Window))
-> Getting (Endo [Identifier]) ClientState Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus
        ((Window -> Const (Endo [Identifier]) Window)
 -> Map Focus Window
 -> Const (Endo [Identifier]) (Map Focus Window))
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> Window -> Const (Endo [Identifier]) Window)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> Map Focus Window
-> Const (Endo [Identifier]) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLines -> Const (Endo [Identifier]) WindowLines)
-> Window -> Const (Endo [Identifier]) Window
Lens' Window WindowLines
winMessages      ((WindowLines -> Const (Endo [Identifier]) WindowLines)
 -> Window -> Const (Endo [Identifier]) Window)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> WindowLines -> Const (Endo [Identifier]) WindowLines)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> Window
-> Const (Endo [Identifier]) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Const (Endo [Identifier]) WindowLine)
-> WindowLines -> Const (Endo [Identifier]) WindowLines
forall s t a b. Each s t a b => Traversal s t a b
Traversal WindowLines WindowLines WindowLine WindowLine
each
        ((WindowLine -> Const (Endo [Identifier]) WindowLine)
 -> WindowLines -> Const (Endo [Identifier]) WindowLines)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> WindowLine -> Const (Endo [Identifier]) WindowLine)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> WindowLines
-> Const (Endo [Identifier]) WindowLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IrcSummary -> Const (Endo [Identifier]) IrcSummary)
-> WindowLine -> Const (Endo [Identifier]) WindowLine
Lens' WindowLine IrcSummary
wlSummary        ((IrcSummary -> Const (Endo [Identifier]) IrcSummary)
 -> WindowLine -> Const (Endo [Identifier]) WindowLine)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> IrcSummary -> Const (Endo [Identifier]) IrcSummary)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> WindowLine
-> Const (Endo [Identifier]) WindowLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IrcSummary -> Maybe Identifier) -> Fold IrcSummary Identifier
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding IrcSummary -> Maybe Identifier
chatActor
        ((Identifier -> Const (Endo [Identifier]) Identifier)
 -> IrcSummary -> Const (Endo [Identifier]) IrcSummary)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> Identifier -> Const (Endo [Identifier]) Identifier)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> IrcSummary
-> Const (Endo [Identifier]) IrcSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Bool)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> Identifier
-> Const (Endo [Identifier]) Identifier
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Identifier -> Bool
isActive
        ((Identifier -> Const (Endo [Identifier]) Identifier)
 -> Identifier -> Const (Endo [Identifier]) Identifier)
-> ((Identifier -> Const (Endo [Identifier]) Identifier)
    -> Identifier -> Const (Endo [Identifier]) Identifier)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> Identifier
-> Const (Endo [Identifier]) Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Bool)
-> (Identifier -> Const (Endo [Identifier]) Identifier)
-> Identifier
-> Const (Endo [Identifier]) Identifier
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 = Identifier -> HashMap Identifier String -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Identifier
n HashMap Identifier String
userMap
        self :: Maybe Identifier
self = Getting (First Identifier) ClientState Identifier
-> ClientState -> Maybe Identifier
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ( Text
-> LensLike' (Const (First Identifier)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike' (Const (First Identifier)) ClientState NetworkState
-> ((Identifier -> Const (First Identifier) Identifier)
    -> NetworkState -> Const (First Identifier) NetworkState)
-> Getting (First Identifier) ClientState Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Const (First Identifier) Identifier)
-> NetworkState -> Const (First Identifier) NetworkState
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 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
s
        userMap :: HashMap Identifier String
userMap = Getting
  (HashMap Identifier String) ClientState (HashMap Identifier String)
-> ClientState -> HashMap Identifier String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ( Text
-> LensLike'
     (Const (HashMap Identifier String)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                       LensLike'
  (Const (HashMap Identifier String)) ClientState NetworkState
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> NetworkState -> Const (HashMap Identifier String) NetworkState)
-> Getting
     (HashMap Identifier String) ClientState (HashMap Identifier String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> NetworkState -> Const (HashMap Identifier String) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const
       (HashMap Identifier String) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (HashMap Identifier String) NetworkState)
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> HashMap Identifier ChannelState
    -> Const
         (HashMap Identifier String) (HashMap Identifier ChannelState))
-> (HashMap Identifier String
    -> Const (HashMap Identifier String) (HashMap Identifier String))
-> NetworkState
-> Const (HashMap Identifier String) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel
                       ((ChannelState -> Const (HashMap Identifier String) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> ChannelState -> Const (HashMap Identifier String) ChannelState)
-> (HashMap Identifier String
    -> Const (HashMap Identifier String) (HashMap Identifier String))
-> HashMap Identifier ChannelState
-> Const
     (HashMap Identifier String) (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const (HashMap Identifier String) (HashMap Identifier String))
-> ChannelState -> Const (HashMap Identifier String) ChannelState
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) = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier) -> Identifier -> Maybe Identifier
forall a b. (a -> b) -> a -> b
$! UserInfo -> Identifier
userNick UserInfo
who
    chatActor IrcSummary
_                 = Maybe Identifier
forall a. Maybe a
Nothing