module Matterhorn.State.Autocomplete
  ( AutocompleteContext(..)
  , checkForAutocompletion
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( viewportScroll, vScrollToBeginning )
import           Brick.Widgets.Edit ( editContentsL )
import qualified Brick.Widgets.List as L
import           Data.Char ( isSpace )
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import           Data.List ( sortBy, partition )
import qualified Data.Map as M
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Zipper as Z
import qualified Data.Vector as V
import           Lens.Micro.Platform ( (%=), (.=), (.~), _Just, preuse )
import qualified Skylighting.Types as Sky

import           Network.Mattermost.Types (userId, channelId, Command(..), TeamId)
import qualified Network.Mattermost.Endpoints as MM

import           Matterhorn.Constants ( userSigil, normalChannelSigil )
import {-# SOURCE #-} Matterhorn.Command ( commandList, printArgSpec )
import           Matterhorn.State.Common
import {-# SOURCE #-} Matterhorn.State.Editing ( Direction(..), tabComplete )
import           Matterhorn.Types hiding ( newState )
import           Matterhorn.Emoji


data AutocompleteContext =
    AutocompleteContext { AutocompleteContext -> Bool
autocompleteManual :: Bool
                        -- ^ Whether the autocompletion was manual
                        -- (True) or automatic (False). The automatic
                        -- case is the case where the autocomplete
                        -- lookups and UI are triggered merely by
                        -- entering some initial text (such as "@").
                        -- The manual case is the case where the
                        -- autocomplete lookups and UI are triggered
                        -- explicitly by a user's TAB keypress.
                        , AutocompleteContext -> Bool
autocompleteFirstMatch :: Bool
                        -- ^ Once the results of the autocomplete lookup
                        -- are available, this flag determines whether
                        -- the user's input is replaced immediately
                        -- with the first available match (True) or not
                        -- (False).
                        }

-- | Check for whether the currently-edited word in the message editor
-- should cause an autocompletion UI to appear. If so, initiate a server
-- query or local cache lookup to present the completion alternatives
-- for the word at the cursor.
checkForAutocompletion :: AutocompleteContext -> MH ()
checkForAutocompletion :: AutocompleteContext -> MH ()
checkForAutocompletion AutocompleteContext
ctx = do
    Maybe
  (AutocompletionType,
   AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
result <- AutocompleteContext
-> MH
     (Maybe
        (AutocompletionType,
         AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput AutocompleteContext
ctx
    case Maybe
  (AutocompletionType,
   AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
result of
        Maybe
  (AutocompletionType,
   AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
Nothing -> MH ()
resetAutocomplete
        Just (AutocompletionType
ty, AutocompletionType -> AutocompleteContext -> Text -> MH ()
runUpdater, Text
searchString) -> do
            Maybe AutocompleteState
prevResult <- Getting
  (Maybe AutocompleteState) ChatState (Maybe AutocompleteState)
-> MH (Maybe AutocompleteState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe AutocompleteState) TeamState)
-> ChatState -> Const (Maybe AutocompleteState) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe AutocompleteState) TeamState)
 -> ChatState -> Const (Maybe AutocompleteState) ChatState)
-> ((Maybe AutocompleteState
     -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
    -> TeamState -> Const (Maybe AutocompleteState) TeamState)
-> Getting
     (Maybe AutocompleteState) ChatState (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
-> TeamState -> Const (Maybe AutocompleteState) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
 -> TeamState -> Const (Maybe AutocompleteState) TeamState)
-> ((Maybe AutocompleteState
     -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
    -> ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
-> (Maybe AutocompleteState
    -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
-> TeamState
-> Const (Maybe AutocompleteState) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
-> ChatEditState -> Const (Maybe AutocompleteState) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete)
            -- We should update the completion state if EITHER:
            --
            -- 1) The type changed
            --
            -- or
            --
            -- 2) The search string changed but the type did NOT change
            let shouldUpdate :: Bool
shouldUpdate = ((Bool
-> (AutocompleteState -> Bool) -> Maybe AutocompleteState -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
searchString) (Text -> Bool)
-> (AutocompleteState -> Text) -> AutocompleteState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutocompleteState -> Text
_acPreviousSearchString)
                                 Maybe AutocompleteState
prevResult) Bool -> Bool -> Bool
&&
                                (Bool
-> (AutocompleteState -> Bool) -> Maybe AutocompleteState -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((AutocompletionType -> AutocompletionType -> Bool
forall a. Eq a => a -> a -> Bool
== AutocompletionType
ty) (AutocompletionType -> Bool)
-> (AutocompleteState -> AutocompletionType)
-> AutocompleteState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutocompleteState -> AutocompletionType
_acType) Maybe AutocompleteState
prevResult)) Bool -> Bool -> Bool
||
                               (Bool
-> (AutocompleteState -> Bool) -> Maybe AutocompleteState -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((AutocompletionType -> AutocompletionType -> Bool
forall a. Eq a => a -> a -> Bool
/= AutocompletionType
ty) (AutocompletionType -> Bool)
-> (AutocompleteState -> AutocompletionType)
-> AutocompleteState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutocompleteState -> AutocompletionType
_acType) Maybe AutocompleteState
prevResult)
            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdate (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe Text -> Identity (Maybe Text))
    -> TeamState -> Identity TeamState)
-> (Maybe Text -> Identity (Maybe Text))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe Text -> Identity (Maybe Text))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe Text -> Identity (Maybe Text))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Identity (Maybe Text))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Maybe Text)
cedAutocompletePending ((Maybe Text -> Identity (Maybe Text))
 -> ChatState -> Identity ChatState)
-> Maybe Text -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
searchString
                AutocompletionType -> AutocompleteContext -> Text -> MH ()
runUpdater AutocompletionType
ty AutocompleteContext
ctx Text
searchString

getCompleterForInput :: AutocompleteContext
                     -> MH (Maybe (AutocompletionType, AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput :: AutocompleteContext
-> MH
     (Maybe
        (AutocompletionType,
         AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput AutocompleteContext
ctx = do
    TextZipper Text
z <- Getting (TextZipper Text) ChatState (TextZipper Text)
-> MH (TextZipper Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (TextZipper Text) TeamState)
-> ChatState -> Const (TextZipper Text) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (TextZipper Text) TeamState)
 -> ChatState -> Const (TextZipper Text) ChatState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> TeamState -> Const (TextZipper Text) TeamState)
-> Getting (TextZipper Text) ChatState (TextZipper Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (TextZipper Text) ChatEditState)
-> TeamState -> Const (TextZipper Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (TextZipper Text) ChatEditState)
 -> TeamState -> Const (TextZipper Text) TeamState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> TeamState
-> Const (TextZipper Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> ChatEditState -> Const (TextZipper Text) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor((Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
 -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> ChatEditState
-> Const (TextZipper Text) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> Editor Text Name -> Const (TextZipper Text) (Editor Text Name)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL)

    let col :: Int
col = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ TextZipper Text -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper Text
z
        curLine :: Text
curLine = TextZipper Text -> Text
forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper Text
z

    Maybe
  (AutocompletionType,
   AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> MH
     (Maybe
        (AutocompletionType,
         AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (AutocompletionType,
    AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
 -> MH
      (Maybe
         (AutocompletionType,
          AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)))
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> MH
     (Maybe
        (AutocompletionType,
         AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
forall a b. (a -> b) -> a -> b
$ case Int -> Text -> Maybe (Int, Text)
wordAtColumn Int
col Text
curLine of
        Just (Int
startCol, Text
w)
            | Text
userSigil Text -> Text -> Bool
`T.isPrefixOf` Text
w ->
                (AutocompletionType,
 AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. a -> Maybe a
Just (AutocompletionType
ACUsers, AutocompletionType -> AutocompleteContext -> Text -> MH ()
doUserAutoCompletion, Text -> Text
T.tail Text
w)
            | Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
w ->
                (AutocompletionType,
 AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. a -> Maybe a
Just (AutocompletionType
ACChannels, AutocompletionType -> AutocompleteContext -> Text -> MH ()
doChannelAutoCompletion, Text -> Text
T.tail Text
w)
            | Text
":" Text -> Text -> Bool
`T.isPrefixOf` Text
w Bool -> Bool -> Bool
&& AutocompleteContext -> Bool
autocompleteManual AutocompleteContext
ctx ->
                (AutocompletionType,
 AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. a -> Maybe a
Just (AutocompletionType
ACEmoji, AutocompletionType -> AutocompleteContext -> Text -> MH ()
doEmojiAutoCompletion, Text -> Text
T.tail Text
w)
            | Text
"```" Text -> Text -> Bool
`T.isPrefixOf` Text
w ->
                (AutocompletionType,
 AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. a -> Maybe a
Just (AutocompletionType
ACCodeBlockLanguage, AutocompletionType -> AutocompleteContext -> Text -> MH ()
doSyntaxAutoCompletion, Int -> Text -> Text
T.drop Int
3 Text
w)
            | Text
"/" Text -> Text -> Bool
`T.isPrefixOf` Text
w Bool -> Bool -> Bool
&& Int
startCol Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                (AutocompletionType,
 AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
-> Maybe
     (AutocompletionType,
      AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. a -> Maybe a
Just (AutocompletionType
ACCommands, AutocompletionType -> AutocompleteContext -> Text -> MH ()
doCommandAutoCompletion, Text -> Text
T.tail Text
w)
        Maybe (Int, Text)
_ -> Maybe
  (AutocompletionType,
   AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
forall a. Maybe a
Nothing

-- Completion implementations

doEmojiAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doEmojiAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doEmojiAutoCompletion AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
    Session
session <- MH Session
getSession
    EmojiCollection
em <- Getting EmojiCollection ChatState EmojiCollection
-> MH EmojiCollection
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const EmojiCollection ChatResources)
-> ChatState -> Const EmojiCollection ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const EmojiCollection ChatResources)
 -> ChatState -> Const EmojiCollection ChatState)
-> ((EmojiCollection -> Const EmojiCollection EmojiCollection)
    -> ChatResources -> Const EmojiCollection ChatResources)
-> Getting EmojiCollection ChatState EmojiCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EmojiCollection -> Const EmojiCollection EmojiCollection)
-> ChatResources -> Const EmojiCollection ChatResources
Lens' ChatResources EmojiCollection
crEmoji)
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    TeamId
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults TeamId
tId AutocompleteContext
ctx AutocompletionType
ty Text
searchString (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            [Text]
results <- Session -> EmojiCollection -> Text -> IO [Text]
getMatchingEmoji Session
session EmojiCollection
em Text
searchString
            let alts :: [AutocompleteAlternative]
alts = Text -> AutocompleteAlternative
EmojiCompletion (Text -> AutocompleteAlternative)
-> [Text] -> [AutocompleteAlternative]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
results
            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty

doSyntaxAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doSyntaxAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doSyntaxAutoCompletion AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
    SyntaxMap
mapping <- Getting SyntaxMap ChatState SyntaxMap -> MH SyntaxMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const SyntaxMap ChatResources)
-> ChatState -> Const SyntaxMap ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const SyntaxMap ChatResources)
 -> ChatState -> Const SyntaxMap ChatState)
-> ((SyntaxMap -> Const SyntaxMap SyntaxMap)
    -> ChatResources -> Const SyntaxMap ChatResources)
-> Getting SyntaxMap ChatState SyntaxMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SyntaxMap -> Const SyntaxMap SyntaxMap)
-> ChatResources -> Const SyntaxMap ChatResources
Lens' ChatResources SyntaxMap
crSyntaxMap)
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    let allNames :: [Text]
allNames = Syntax -> Text
Sky.sShortname (Syntax -> Text) -> [Syntax] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxMap -> [Syntax]
forall k a. Map k a -> [a]
M.elems SyntaxMap
mapping
        ([Text]
prefixed, [Text]
notPrefixed) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Text -> Bool
isPrefixed ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
match [Text]
allNames
        match :: Text -> Bool
match = (((Text -> Text
T.toLower Text
searchString) Text -> Text -> Bool
`T.isInfixOf`) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower)
        isPrefixed :: Text -> Bool
isPrefixed = (((Text -> Text
T.toLower Text
searchString) Text -> Text -> Bool
`T.isPrefixOf`) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower)
        alts :: [AutocompleteAlternative]
alts = Text -> AutocompleteAlternative
SyntaxCompletion (Text -> AutocompleteAlternative)
-> [Text] -> [AutocompleteAlternative]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
prefixed [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
notPrefixed)
    TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty

-- | This list of server commands should be hidden because they make
-- assumptions about a web-based client or otherwise just don't make
-- sense for Matterhorn.
--
-- It's worth mentioning that other official mattermost client
-- implementations use this technique, too. The web client maintains
-- a list of commands to exclude when they aren't supported in the
-- mobile client. (Really this is a design flaw; they should never be
-- advertised by the server to begin with.)
hiddenServerCommands :: [Text]
hiddenServerCommands :: [Text]
hiddenServerCommands =
    -- These commands all only work in the web client.
    [ Text
"settings"
    , Text
"help"
    , Text
"collapse"
    , Text
"expand"

    -- We don't think this command makes sense for Matterhorn.
    , Text
"logout"

    , Text
"remove"
    , Text
"msg"

    -- We provide a version of /leave with confirmation.
    , Text
"leave"

    -- We provide our own join UI.
    , Text
"join"

    -- We provide our own search UI.
    , Text
"search"

    -- We provide our own version of this command that opens our own
    -- help UI.
    , Text
"shortcuts"

    -- Hidden because we provide other mechanisms to switch between
    -- channels.
    , Text
"open"
    ]

hiddenCommand :: Command -> Bool
hiddenCommand :: Command -> Bool
hiddenCommand Command
c = (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Command -> Text
commandTrigger Command
c) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
hiddenServerCommands

isDeletedCommand :: Command -> Bool
isDeletedCommand :: Command -> Bool
isDeletedCommand Command
cmd = Command -> ServerTime
commandDeleteAt Command
cmd ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
> Command -> ServerTime
commandCreateAt Command
cmd

doCommandAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doCommandAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doCommandAutoCompletion AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
    Session
session <- MH Session
getSession
    TeamId
myTid <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId

    Maybe (HashMap Text [AutocompleteAlternative])
mCache <- Getting
  (First (HashMap Text [AutocompleteAlternative]))
  ChatState
  (HashMap Text [AutocompleteAlternative])
-> MH (Maybe (HashMap Text [AutocompleteAlternative]))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
myTid)((TeamState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) TeamState)
 -> ChatState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> TeamState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) TeamState)
-> Getting
     (First (HashMap Text [AutocompleteAlternative]))
     ChatState
     (HashMap Text [AutocompleteAlternative])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> TeamState
-> Const (First (HashMap Text [AutocompleteAlternative])) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
 -> TeamState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) TeamState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> ChatEditState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> TeamState
-> Const (First (HashMap Text [AutocompleteAlternative])) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (Maybe AutocompleteState))
-> ChatEditState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete((Maybe AutocompleteState
  -> Const
       (First (HashMap Text [AutocompleteAlternative]))
       (Maybe AutocompleteState))
 -> ChatEditState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> Maybe AutocompleteState
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (Maybe AutocompleteState))
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> ChatEditState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
-> Maybe AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative]))
     (Maybe AutocompleteState)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((AutocompleteState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
 -> Maybe AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (Maybe AutocompleteState))
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> AutocompleteState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> Maybe AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative]))
     (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(HashMap Text [AutocompleteAlternative]
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (HashMap Text [AutocompleteAlternative]))
-> AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) AutocompleteState
Lens' AutocompleteState (HashMap Text [AutocompleteAlternative])
acCachedResponses)
    Maybe AutocompletionType
mActiveTy <- Getting (First AutocompletionType) ChatState AutocompletionType
-> MH (Maybe AutocompletionType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
myTid)((TeamState -> Const (First AutocompletionType) TeamState)
 -> ChatState -> Const (First AutocompletionType) ChatState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> TeamState -> Const (First AutocompletionType) TeamState)
-> Getting (First AutocompletionType) ChatState AutocompletionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> TeamState -> Const (First AutocompletionType) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (First AutocompletionType) ChatEditState)
 -> TeamState -> Const (First AutocompletionType) TeamState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> TeamState
-> Const (First AutocompletionType) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> ChatEditState -> Const (First AutocompletionType) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete((Maybe AutocompleteState
  -> Const (First AutocompletionType) (Maybe AutocompleteState))
 -> ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> Maybe AutocompleteState
    -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> ChatEditState
-> Const (First AutocompletionType) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompleteState
 -> Const (First AutocompletionType) AutocompleteState)
-> Maybe AutocompleteState
-> Const (First AutocompletionType) (Maybe AutocompleteState)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((AutocompleteState
  -> Const (First AutocompletionType) AutocompleteState)
 -> Maybe AutocompleteState
 -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> AutocompleteState
    -> Const (First AutocompletionType) AutocompleteState)
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> Maybe AutocompleteState
-> Const (First AutocompletionType) (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompletionType
 -> Const (First AutocompletionType) AutocompletionType)
-> AutocompleteState
-> Const (First AutocompletionType) AutocompleteState
Lens' AutocompleteState AutocompletionType
acType)

    -- Command completion works a little differently than the other
    -- modes. To do command autocompletion, we want to query the server
    -- for the list of available commands and merge that list with
    -- our own list of client-provided commands. But the server's API
    -- doesn't support *searching* commands; we can only ask for the
    -- full list. That means that, unlike the other completion modes
    -- where we want to ask the server repeatedly as the search string
    -- is refined, in this case we want to ask the server only once
    -- and avoid repeating the request for the same data as the user
    -- types more of the search string. To accomplish that, we use a
    -- special cache key -- the empty string, which normal user input
    -- processing will never use -- as the cache key for the "full" list
    -- of commands obtained by merging the server's list with our own.
    -- We populate that cache entry when completion starts and then
    -- subsequent completions consult *that* list instead of asking the
    -- server again. Subsequent completions then filter and match the
    -- cached list against the user's search string.
    let entry :: Maybe [AutocompleteAlternative]
entry = Text
-> HashMap Text [AutocompleteAlternative]
-> Maybe [AutocompleteAlternative]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
serverResponseKey (HashMap Text [AutocompleteAlternative]
 -> Maybe [AutocompleteAlternative])
-> Maybe (HashMap Text [AutocompleteAlternative])
-> Maybe [AutocompleteAlternative]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (HashMap Text [AutocompleteAlternative])
mCache
        -- The special cache key to use to store the merged server and
        -- client command list, sorted but otherwise unfiltered except
        -- for eliminating deleted or hidden commands.
        serverResponseKey :: Text
serverResponseKey = Text
""
        lowerSearch :: Text
lowerSearch = Text -> Text
T.toLower Text
searchString
        matches :: AutocompleteAlternative -> Bool
matches (CommandCompletion CompletionSource
_ Text
name Text
_ Text
desc) =
            Text
lowerSearch Text -> Text -> Bool
`T.isInfixOf` (Text -> Text
T.toLower Text
name) Bool -> Bool -> Bool
||
            Text
lowerSearch Text -> Text -> Bool
`T.isInfixOf` (Text -> Text
T.toLower Text
desc)
        matches AutocompleteAlternative
_ = Bool
False

    if (Maybe [AutocompleteAlternative] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [AutocompleteAlternative]
entry Bool -> Bool -> Bool
|| (Maybe AutocompletionType
mActiveTy Maybe AutocompletionType -> Maybe AutocompletionType -> Bool
forall a. Eq a => a -> a -> Bool
/= (AutocompletionType -> Maybe AutocompletionType
forall a. a -> Maybe a
Just AutocompletionType
ACCommands)))
       then AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                let clientAlts :: [(CompletionSource, Text, Text, Text)]
clientAlts = Cmd -> (CompletionSource, Text, Text, Text)
mkAlt (Cmd -> (CompletionSource, Text, Text, Text))
-> [Cmd] -> [(CompletionSource, Text, Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd]
commandList
                    mkAlt :: Cmd -> (CompletionSource, Text, Text, Text)
mkAlt (Cmd Text
name Text
desc CmdArgs a
args CmdExec a
_) =
                        (CompletionSource
Client, Text
name, CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
args, Text
desc)

                Seq Command
serverCommands <- TeamId -> Bool -> Session -> IO (Seq Command)
MM.mmListCommandsForTeam TeamId
myTid Bool
False Session
session
                let filteredServerCommands :: [Command]
filteredServerCommands =
                        (Command -> Bool) -> [Command] -> [Command]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Command
c -> Bool -> Bool
not (Command -> Bool
hiddenCommand Command
c Bool -> Bool -> Bool
|| Command -> Bool
isDeletedCommand Command
c)) ([Command] -> [Command]) -> [Command] -> [Command]
forall a b. (a -> b) -> a -> b
$
                        Seq Command -> [Command]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Command
serverCommands
                    serverAlts :: [(CompletionSource, Text, Text, Text)]
serverAlts = Command -> (CompletionSource, Text, Text, Text)
mkTuple (Command -> (CompletionSource, Text, Text, Text))
-> [Command] -> [(CompletionSource, Text, Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command]
filteredServerCommands
                    mkTuple :: Command -> (CompletionSource, Text, Text, Text)
mkTuple Command
cmd =
                        ( CompletionSource
Server
                        , Command -> Text
commandTrigger Command
cmd
                        , Command -> Text
commandAutoCompleteHint Command
cmd
                        , Command -> Text
commandAutoCompleteDesc Command
cmd
                        )
                    mkCompletion :: (CompletionSource, Text, Text, Text) -> AutocompleteAlternative
mkCompletion (CompletionSource
src, Text
name, Text
args, Text
desc) =
                        CompletionSource -> Text -> Text -> Text -> AutocompleteAlternative
CommandCompletion CompletionSource
src Text
name Text
args Text
desc
                    alts :: [AutocompleteAlternative]
alts = ((CompletionSource, Text, Text, Text) -> AutocompleteAlternative)
-> [(CompletionSource, Text, Text, Text)]
-> [AutocompleteAlternative]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompletionSource, Text, Text, Text) -> AutocompleteAlternative
mkCompletion ([(CompletionSource, Text, Text, Text)]
 -> [AutocompleteAlternative])
-> [(CompletionSource, Text, Text, Text)]
-> [AutocompleteAlternative]
forall a b. (a -> b) -> a -> b
$
                           [(CompletionSource, Text, Text, Text)]
clientAlts [(CompletionSource, Text, Text, Text)]
-> [(CompletionSource, Text, Text, Text)]
-> [(CompletionSource, Text, Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(CompletionSource, Text, Text, Text)]
serverAlts

                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                    -- Store the complete list of alterantives in the cache
                    TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
myTid AutocompleteContext
ctx Text
serverResponseKey [AutocompleteAlternative]
alts AutocompletionType
ty

                    -- Also store the list of alternatives specific to
                    -- this search string
                    let newAlts :: [AutocompleteAlternative]
newAlts = (AutocompleteAlternative -> AutocompleteAlternative -> Ordering)
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text
-> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts Text
searchString) ([AutocompleteAlternative] -> [AutocompleteAlternative])
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a b. (a -> b) -> a -> b
$
                                  (AutocompleteAlternative -> Bool)
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a. (a -> Bool) -> [a] -> [a]
filter AutocompleteAlternative -> Bool
matches [AutocompleteAlternative]
alts
                    TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
myTid AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
newAlts AutocompletionType
ty

       else case Maybe [AutocompleteAlternative]
entry of
           Just [AutocompleteAlternative]
alts | Maybe AutocompletionType
mActiveTy Maybe AutocompletionType -> Maybe AutocompletionType -> Bool
forall a. Eq a => a -> a -> Bool
== AutocompletionType -> Maybe AutocompletionType
forall a. a -> Maybe a
Just AutocompletionType
ACCommands ->
               let newAlts :: [AutocompleteAlternative]
newAlts = (AutocompleteAlternative -> AutocompleteAlternative -> Ordering)
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text
-> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts Text
searchString) ([AutocompleteAlternative] -> [AutocompleteAlternative])
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a b. (a -> b) -> a -> b
$
                             (AutocompleteAlternative -> Bool)
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a. (a -> Bool) -> [a] -> [a]
filter AutocompleteAlternative -> Bool
matches [AutocompleteAlternative]
alts
               in TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
myTid AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
newAlts AutocompletionType
ty
           Maybe [AutocompleteAlternative]
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

compareCommandAlts :: Text -> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts :: Text
-> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts Text
s (CommandCompletion CompletionSource
_ Text
nameA Text
_ Text
_)
                     (CommandCompletion CompletionSource
_ Text
nameB Text
_ Text
_) =
    let isAPrefix :: Bool
isAPrefix = Text
s Text -> Text -> Bool
`T.isPrefixOf` Text
nameA
        isBPrefix :: Bool
isBPrefix = Text
s Text -> Text -> Bool
`T.isPrefixOf` Text
nameB
    in if Bool
isAPrefix Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isBPrefix
       then Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
nameA Text
nameB
       else if Bool
isAPrefix
            then Ordering
LT
            else Ordering
GT
compareCommandAlts Text
_ AutocompleteAlternative
_ AutocompleteAlternative
_ = Ordering
LT

doUserAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doUserAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doUserAutoCompletion AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
    Session
session <- MH Session
getSession
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    UserId
myUid <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(TeamId
tId))

    TeamId
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults TeamId
tId AutocompleteContext
ctx AutocompletionType
ty Text
searchString (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            UserAutocomplete
ac <- Maybe TeamId
-> Maybe ChannelId -> Text -> Session -> IO UserAutocomplete
MM.mmAutocompleteUsers (TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tId) (ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId) Text
searchString Session
session

            let active :: Seq User -> Seq User
active = (User -> Bool) -> Seq User -> Seq User
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\User
u -> User -> UserId
userId User
u UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
myUid Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ User -> Bool
userDeleted User
u))
                alts :: [AutocompleteAlternative]
alts = Seq AutocompleteAlternative -> [AutocompleteAlternative]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq AutocompleteAlternative -> [AutocompleteAlternative])
-> Seq AutocompleteAlternative -> [AutocompleteAlternative]
forall a b. (a -> b) -> a -> b
$
                       ((\User
u -> User -> Bool -> AutocompleteAlternative
UserCompletion User
u Bool
True) (User -> AutocompleteAlternative)
-> Seq User -> Seq AutocompleteAlternative
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq User -> Seq User
active (Seq User -> Seq User) -> Seq User -> Seq User
forall a b. (a -> b) -> a -> b
$ UserAutocomplete -> Seq User
MM.userAutocompleteUsers UserAutocomplete
ac)) Seq AutocompleteAlternative
-> Seq AutocompleteAlternative -> Seq AutocompleteAlternative
forall a. Semigroup a => a -> a -> a
<>
                       (Seq AutocompleteAlternative
-> (Seq User -> Seq AutocompleteAlternative)
-> Maybe (Seq User)
-> Seq AutocompleteAlternative
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq AutocompleteAlternative
forall a. Monoid a => a
mempty ((User -> AutocompleteAlternative)
-> Seq User -> Seq AutocompleteAlternative
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\User
u -> User -> Bool -> AutocompleteAlternative
UserCompletion User
u Bool
False) (Seq User -> Seq AutocompleteAlternative)
-> (Seq User -> Seq User)
-> Seq User
-> Seq AutocompleteAlternative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq User -> Seq User
active) (Maybe (Seq User) -> Seq AutocompleteAlternative)
-> Maybe (Seq User) -> Seq AutocompleteAlternative
forall a b. (a -> b) -> a -> b
$
                              UserAutocomplete -> Maybe (Seq User)
MM.userAutocompleteOutOfChannel UserAutocomplete
ac)

                specials :: [SpecialMention]
specials = [ SpecialMention
MentionAll
                           , SpecialMention
MentionChannel
                           ]
                extras :: [AutocompleteAlternative]
extras = [ SpecialMention -> AutocompleteAlternative
SpecialMention SpecialMention
m | SpecialMention
m <- [SpecialMention]
specials
                         , (Text -> Text
T.toLower Text
searchString) Text -> Text -> Bool
`T.isPrefixOf` SpecialMention -> Text
specialMentionName SpecialMention
m
                         ]

            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString ([AutocompleteAlternative]
alts [AutocompleteAlternative]
-> [AutocompleteAlternative] -> [AutocompleteAlternative]
forall a. Semigroup a => a -> a -> a
<> [AutocompleteAlternative]
extras) AutocompletionType
ty

doChannelAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doChannelAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH ()
doChannelAutoCompletion AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
    Session
session <- MH Session
getSession
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels

    TeamId
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults TeamId
tId AutocompleteContext
ctx AutocompletionType
ty Text
searchString (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Seq Channel
results <- TeamId -> Text -> Session -> IO (Seq Channel)
MM.mmAutocompleteChannels TeamId
tId Text
searchString Session
session
            let alts :: [AutocompleteAlternative]
alts = Seq AutocompleteAlternative -> [AutocompleteAlternative]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq AutocompleteAlternative -> [AutocompleteAlternative])
-> Seq AutocompleteAlternative -> [AutocompleteAlternative]
forall a b. (a -> b) -> a -> b
$ (Bool -> Channel -> AutocompleteAlternative
ChannelCompletion Bool
True (Channel -> AutocompleteAlternative)
-> Seq Channel -> Seq AutocompleteAlternative
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
inChannels) Seq AutocompleteAlternative
-> Seq AutocompleteAlternative -> Seq AutocompleteAlternative
forall a. Semigroup a => a -> a -> a
<>
                                  (Bool -> Channel -> AutocompleteAlternative
ChannelCompletion Bool
False (Channel -> AutocompleteAlternative)
-> Seq Channel -> Seq AutocompleteAlternative
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
notInChannels)
                (Seq Channel
inChannels, Seq Channel
notInChannels) = (Channel -> Bool) -> Seq Channel -> (Seq Channel, Seq Channel)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition Channel -> Bool
isMember Seq Channel
results
                isMember :: Channel -> Bool
isMember Channel
c = Maybe ClientChannel -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ClientChannel -> Bool) -> Maybe ClientChannel -> Bool
forall a b. (a -> b) -> a -> b
$ ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Channel -> ChannelId
channelId Channel
c) ClientChannels
cs
            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty

-- Utility functions

-- | Attempt to re-use a cached autocomplete alternative list for
-- a given search string. If the cache contains no such entry (keyed
-- on search string), run the specified action, which is assumed to be
-- responsible for fetching the completion results from the server.
withCachedAutocompleteResults :: TeamId
                              -> AutocompleteContext
                              -- ^ The autocomplete context
                              -> AutocompletionType
                              -- ^ The type of autocompletion we're
                              -- doing
                              -> Text
                              -- ^ The search string to look for in the
                              -- cache
                              -> MH ()
                              -- ^ The action to execute on a cache miss
                              -> MH ()
withCachedAutocompleteResults :: TeamId
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults TeamId
tId AutocompleteContext
ctx AutocompletionType
ty Text
searchString MH ()
act = do
    Maybe (HashMap Text [AutocompleteAlternative])
mCache <- Getting
  (First (HashMap Text [AutocompleteAlternative]))
  ChatState
  (HashMap Text [AutocompleteAlternative])
-> MH (Maybe (HashMap Text [AutocompleteAlternative]))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) TeamState)
 -> ChatState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> TeamState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) TeamState)
-> Getting
     (First (HashMap Text [AutocompleteAlternative]))
     ChatState
     (HashMap Text [AutocompleteAlternative])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> TeamState
-> Const (First (HashMap Text [AutocompleteAlternative])) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
 -> TeamState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) TeamState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> ChatEditState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> TeamState
-> Const (First (HashMap Text [AutocompleteAlternative])) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (Maybe AutocompleteState))
-> ChatEditState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete((Maybe AutocompleteState
  -> Const
       (First (HashMap Text [AutocompleteAlternative]))
       (Maybe AutocompleteState))
 -> ChatEditState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) ChatEditState)
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> Maybe AutocompleteState
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (Maybe AutocompleteState))
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> ChatEditState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
-> Maybe AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative]))
     (Maybe AutocompleteState)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((AutocompleteState
  -> Const
       (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
 -> Maybe AutocompleteState
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (Maybe AutocompleteState))
-> ((HashMap Text [AutocompleteAlternative]
     -> Const
          (First (HashMap Text [AutocompleteAlternative]))
          (HashMap Text [AutocompleteAlternative]))
    -> AutocompleteState
    -> Const
         (First (HashMap Text [AutocompleteAlternative])) AutocompleteState)
-> (HashMap Text [AutocompleteAlternative]
    -> Const
         (First (HashMap Text [AutocompleteAlternative]))
         (HashMap Text [AutocompleteAlternative]))
-> Maybe AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative]))
     (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(HashMap Text [AutocompleteAlternative]
 -> Const
      (First (HashMap Text [AutocompleteAlternative]))
      (HashMap Text [AutocompleteAlternative]))
-> AutocompleteState
-> Const
     (First (HashMap Text [AutocompleteAlternative])) AutocompleteState
Lens' AutocompleteState (HashMap Text [AutocompleteAlternative])
acCachedResponses)
    Maybe AutocompletionType
mActiveTy <- Getting (First AutocompletionType) ChatState AutocompletionType
-> MH (Maybe AutocompletionType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (First AutocompletionType) TeamState)
 -> ChatState -> Const (First AutocompletionType) ChatState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> TeamState -> Const (First AutocompletionType) TeamState)
-> Getting (First AutocompletionType) ChatState AutocompletionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> TeamState -> Const (First AutocompletionType) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (First AutocompletionType) ChatEditState)
 -> TeamState -> Const (First AutocompletionType) TeamState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> TeamState
-> Const (First AutocompletionType) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> ChatEditState -> Const (First AutocompletionType) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete((Maybe AutocompleteState
  -> Const (First AutocompletionType) (Maybe AutocompleteState))
 -> ChatEditState -> Const (First AutocompletionType) ChatEditState)
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> Maybe AutocompleteState
    -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> ChatEditState
-> Const (First AutocompletionType) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompleteState
 -> Const (First AutocompletionType) AutocompleteState)
-> Maybe AutocompleteState
-> Const (First AutocompletionType) (Maybe AutocompleteState)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((AutocompleteState
  -> Const (First AutocompletionType) AutocompleteState)
 -> Maybe AutocompleteState
 -> Const (First AutocompletionType) (Maybe AutocompleteState))
-> ((AutocompletionType
     -> Const (First AutocompletionType) AutocompletionType)
    -> AutocompleteState
    -> Const (First AutocompletionType) AutocompleteState)
-> (AutocompletionType
    -> Const (First AutocompletionType) AutocompletionType)
-> Maybe AutocompleteState
-> Const (First AutocompletionType) (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AutocompletionType
 -> Const (First AutocompletionType) AutocompletionType)
-> AutocompleteState
-> Const (First AutocompletionType) AutocompleteState
Lens' AutocompleteState AutocompletionType
acType)

    case AutocompletionType -> Maybe AutocompletionType
forall a. a -> Maybe a
Just AutocompletionType
ty Maybe AutocompletionType -> Maybe AutocompletionType -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe AutocompletionType
mActiveTy of
        Bool
True ->
            -- Does the cache have results for this search string? If
            -- so, use them; otherwise invoke the specified action.
            case Text
-> HashMap Text [AutocompleteAlternative]
-> Maybe [AutocompleteAlternative]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
searchString (HashMap Text [AutocompleteAlternative]
 -> Maybe [AutocompleteAlternative])
-> Maybe (HashMap Text [AutocompleteAlternative])
-> Maybe [AutocompleteAlternative]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (HashMap Text [AutocompleteAlternative])
mCache of
                Just [AutocompleteAlternative]
alts -> TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty
                Maybe [AutocompleteAlternative]
Nothing -> MH ()
act
        Bool
False -> MH ()
act

setCompletionAlternatives :: TeamId
                          -> AutocompleteContext
                          -> Text
                          -> [AutocompleteAlternative]
                          -> AutocompletionType
                          -> MH ()
setCompletionAlternatives :: TeamId
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives TeamId
tId AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty = do
    let list :: GenericList Name Vector AutocompleteAlternative
list = Name
-> Vector AutocompleteAlternative
-> Int
-> GenericList Name Vector AutocompleteAlternative
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list (TeamId -> Name
CompletionList TeamId
tId) ([AutocompleteAlternative] -> Vector AutocompleteAlternative
forall a. [a] -> Vector a
V.fromList ([AutocompleteAlternative] -> Vector AutocompleteAlternative)
-> [AutocompleteAlternative] -> Vector AutocompleteAlternative
forall a b. (a -> b) -> a -> b
$ [AutocompleteAlternative] -> [AutocompleteAlternative]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [AutocompleteAlternative]
alts) Int
1
        state :: AutocompleteState
state = AutocompleteState :: Text
-> GenericList Name Vector AutocompleteAlternative
-> AutocompletionType
-> HashMap Text [AutocompleteAlternative]
-> AutocompleteState
AutocompleteState { _acPreviousSearchString :: Text
_acPreviousSearchString = Text
searchString
                                  , _acCompletionList :: GenericList Name Vector AutocompleteAlternative
_acCompletionList =
                                      GenericList Name Vector AutocompleteAlternative
list GenericList Name Vector AutocompleteAlternative
-> (GenericList Name Vector AutocompleteAlternative
    -> GenericList Name Vector AutocompleteAlternative)
-> GenericList Name Vector AutocompleteAlternative
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList Name Vector AutocompleteAlternative
-> Identity (GenericList Name Vector AutocompleteAlternative)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList Name Vector AutocompleteAlternative
 -> Identity (GenericList Name Vector AutocompleteAlternative))
-> Maybe Int
-> GenericList Name Vector AutocompleteAlternative
-> GenericList Name Vector AutocompleteAlternative
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Int
forall a. Maybe a
Nothing
                                  , _acCachedResponses :: HashMap Text [AutocompleteAlternative]
_acCachedResponses = [(Text, [AutocompleteAlternative])]
-> HashMap Text [AutocompleteAlternative]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text
searchString, [AutocompleteAlternative]
alts)]
                                  , _acType :: AutocompletionType
_acType = AutocompletionType
ty
                                  }

    Maybe Text
pending <- Getting (Maybe Text) ChatState (Maybe Text) -> MH (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe Text) TeamState)
 -> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> TeamState -> Const (Maybe Text) TeamState)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe Text) ChatEditState)
-> TeamState -> Const (Maybe Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe Text) ChatEditState)
 -> TeamState -> Const (Maybe Text) TeamState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> ChatEditState -> Const (Maybe Text) ChatEditState)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> TeamState
-> Const (Maybe Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatEditState -> Const (Maybe Text) ChatEditState
Lens' ChatEditState (Maybe Text)
cedAutocompletePending)
    case Maybe Text
pending of
        Just Text
val | Text
val Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
searchString -> do

            -- If there is already state, update it, but also cache the
            -- search results.
            TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
    -> TeamState -> Identity TeamState)
-> (Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
 -> ChatState -> Identity ChatState)
-> (Maybe AutocompleteState -> Maybe AutocompleteState) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Maybe AutocompleteState
prev ->
                let newState :: AutocompleteState
newState = case Maybe AutocompleteState
prev of
                        Maybe AutocompleteState
Nothing ->
                            AutocompleteState
state
                        Just AutocompleteState
oldState ->
                            AutocompleteState
state AutocompleteState
-> (AutocompleteState -> AutocompleteState) -> AutocompleteState
forall a b. a -> (a -> b) -> b
& (HashMap Text [AutocompleteAlternative]
 -> Identity (HashMap Text [AutocompleteAlternative]))
-> AutocompleteState -> Identity AutocompleteState
Lens' AutocompleteState (HashMap Text [AutocompleteAlternative])
acCachedResponses ((HashMap Text [AutocompleteAlternative]
  -> Identity (HashMap Text [AutocompleteAlternative]))
 -> AutocompleteState -> Identity AutocompleteState)
-> HashMap Text [AutocompleteAlternative]
-> AutocompleteState
-> AutocompleteState
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                                Text
-> [AutocompleteAlternative]
-> HashMap Text [AutocompleteAlternative]
-> HashMap Text [AutocompleteAlternative]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
searchString [AutocompleteAlternative]
alts (AutocompleteState
oldStateAutocompleteState
-> Getting
     (HashMap Text [AutocompleteAlternative])
     AutocompleteState
     (HashMap Text [AutocompleteAlternative])
-> HashMap Text [AutocompleteAlternative]
forall s a. s -> Getting a s a -> a
^.Getting
  (HashMap Text [AutocompleteAlternative])
  AutocompleteState
  (HashMap Text [AutocompleteAlternative])
Lens' AutocompleteState (HashMap Text [AutocompleteAlternative])
acCachedResponses)
                in AutocompleteState -> Maybe AutocompleteState
forall a. a -> Maybe a
Just AutocompleteState
newState

            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning (ViewportScroll Name -> EventM Name ())
-> ViewportScroll Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
CompletionList TeamId
tId

            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutocompleteContext -> Bool
autocompleteFirstMatch AutocompleteContext
ctx) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                Direction -> MH ()
tabComplete Direction
Forwards
        Maybe Text
_ ->
            -- Do not update the state if this result does not
            -- correspond to the search string we used most recently.
            -- This happens when the editor changes faster than the
            -- async completion responses arrive from the server. If we
            -- don't check this, we show completion results that are
            -- wrong for the editor state.
            () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

wordAtColumn :: Int -> Text -> Maybe (Int, Text)
wordAtColumn :: Int -> Text -> Maybe (Int, Text)
wordAtColumn Int
i Text
t =
    let tokens :: [Text]
tokens = (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
a Char
b -> Char -> Bool
isSpace Char
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isSpace Char
b) Text
t
        go :: Int -> Int -> [Text] -> Maybe (Int, Text)
go Int
_ Int
j [Text]
_ | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (Int, Text)
forall a. Maybe a
Nothing
        go Int
col Int
j [Text]
ts = case [Text]
ts of
            [] -> Maybe (Int, Text)
forall a. Maybe a
Nothing
            (Text
w:[Text]
rest) | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Text -> Int
T.length Text
w Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
w) -> (Int, Text) -> Maybe (Int, Text)
forall a. a -> Maybe a
Just (Int
col, Text
w)
                     | Bool
otherwise -> Int -> Int -> [Text] -> Maybe (Int, Text)
go (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
w) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
w) [Text]
rest
    in Int -> Int -> [Text] -> Maybe (Int, Text)
go Int
0 Int
i [Text]
tokens