{-|
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
import           Client.Message
import           Client.State
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window
import           Client.State.Channel
import           Control.Lens
import qualified Data.HashMap.Strict as HashMap
import           Irc.Identifier
import           Irc.UserInfo

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