{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.Autocomplete
( AutocompleteContext(..)
, checkForAutocompletion
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick ( getName )
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 Data.Maybe ( fromJust )
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, Traversal' )
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
, AutocompleteContext -> Bool
autocompleteFirstMatch :: Bool
}
checkForAutocompletion :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> MH ()
checkForAutocompletion :: Traversal' ChatState (EditState Name)
-> AutocompleteContext -> MH ()
checkForAutocompletion Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx = do
Maybe
(AutocompletionType,
AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
result <- Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> MH
(Maybe
(AutocompletionType,
AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx
case Maybe
(AutocompletionType,
AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
result of
Maybe
(AutocompletionType,
AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)
Nothing -> forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Traversal' ChatState (EditState Name)
which
Just (AutocompletionType
ty, AutocompletionType -> AutocompleteContext -> Text -> MH ()
runUpdater, Text
searchString) -> do
Maybe (AutocompleteState Name)
prevResult <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocomplete)
let shouldUpdate :: Bool
shouldUpdate = ((forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((forall a. Eq a => a -> a -> Bool
/= Text
searchString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AutocompleteState n -> Text
_acPreviousSearchString)
Maybe (AutocompleteState Name)
prevResult) Bool -> Bool -> Bool
&&
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((forall a. Eq a => a -> a -> Bool
== AutocompletionType
ty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AutocompleteState n -> AutocompletionType
_acType) Maybe (AutocompleteState Name)
prevResult)) Bool -> Bool -> Bool
||
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((forall a. Eq a => a -> a -> Bool
/= AutocompletionType
ty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AutocompleteState n -> AutocompletionType
_acType) Maybe (AutocompleteState Name)
prevResult)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdate forall a b. (a -> b) -> a -> b
$ do
Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe Text)
esAutocompletePending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Text
searchString
AutocompletionType -> AutocompleteContext -> Text -> MH ()
runUpdater AutocompletionType
ty AutocompleteContext
ctx Text
searchString
getCompleterForInput :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> MH (Maybe (AutocompletionType, AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> MH
(Maybe
(AutocompletionType,
AutocompletionType -> AutocompleteContext -> Text -> MH (), Text))
getCompleterForInput Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx = do
Maybe (TextZipper Text)
maybeZipper <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL)
Maybe (Maybe TeamId)
mmTid <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe TeamId)
esTeamId)
TeamId
tId <- do
case Maybe (Maybe TeamId)
mmTid of
Just (Just TeamId
i) -> forall (m :: * -> *) a. Monad m => a -> m a
return TeamId
i
Maybe (Maybe TeamId)
_ -> forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
case Maybe (TextZipper Text)
maybeZipper of
Just TextZipper Text
z -> do
let col :: Int
col = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper Text
z
curLine :: Text
curLine = forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper Text
z
forall (m :: * -> *) a. Monad m => a -> m a
return 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 ->
forall a. a -> Maybe a
Just (AutocompletionType
ACUsers, Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doUserAutoCompletion Traversal' ChatState (EditState Name)
which TeamId
tId, Text -> Text
T.tail Text
w)
| Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
w ->
forall a. a -> Maybe a
Just (AutocompletionType
ACChannels, TeamId
-> Traversal' ChatState (EditState Name)
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doChannelAutoCompletion TeamId
tId Traversal' ChatState (EditState Name)
which, Text -> Text
T.tail Text
w)
| Text
":" Text -> Text -> Bool
`T.isPrefixOf` Text
w Bool -> Bool -> Bool
&& AutocompleteContext -> Bool
autocompleteManual AutocompleteContext
ctx ->
forall a. a -> Maybe a
Just (AutocompletionType
ACEmoji, Traversal' ChatState (EditState Name)
-> AutocompletionType -> AutocompleteContext -> Text -> MH ()
doEmojiAutoCompletion Traversal' ChatState (EditState Name)
which, Text -> Text
T.tail Text
w)
| Text
"```" Text -> Text -> Bool
`T.isPrefixOf` Text
w ->
forall a. a -> Maybe a
Just (AutocompletionType
ACCodeBlockLanguage, Traversal' ChatState (EditState Name)
-> AutocompletionType -> AutocompleteContext -> Text -> MH ()
doSyntaxAutoCompletion Traversal' ChatState (EditState Name)
which, Int -> Text -> Text
T.drop Int
3 Text
w)
| Text
"/" Text -> Text -> Bool
`T.isPrefixOf` Text
w Bool -> Bool -> Bool
&& Int
startCol forall a. Eq a => a -> a -> Bool
== Int
0 ->
forall a. a -> Maybe a
Just (AutocompletionType
ACCommands, Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doCommandAutoCompletion Traversal' ChatState (EditState Name)
which TeamId
tId, Text -> Text
T.tail Text
w)
Maybe (Int, Text)
_ -> forall a. Maybe a
Nothing
Maybe (TextZipper Text)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
doEmojiAutoCompletion :: Traversal' ChatState (EditState Name)
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doEmojiAutoCompletion :: Traversal' ChatState (EditState Name)
-> AutocompletionType -> AutocompleteContext -> Text -> MH ()
doEmojiAutoCompletion Traversal' ChatState (EditState Name)
which AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
Session
session <- MH Session
getSession
EmojiCollection
em <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources EmojiCollection
crEmoji)
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx AutocompletionType
ty Text
searchString forall a b. (a -> b) -> a -> b
$
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
results
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty
doSyntaxAutoCompletion :: Traversal' ChatState (EditState Name)
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doSyntaxAutoCompletion :: Traversal' ChatState (EditState Name)
-> AutocompletionType -> AutocompleteContext -> Text -> MH ()
doSyntaxAutoCompletion Traversal' ChatState (EditState Name)
which AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
SyntaxMap
mapping <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources SyntaxMap
crSyntaxMap)
let allNames :: [Text]
allNames = Syntax -> Text
Sky.sShortname forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
M.elems SyntaxMap
mapping
([Text]
prefixed, [Text]
notPrefixed) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Text -> Bool
isPrefixed forall a b. (a -> b) -> a -> b
$ 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`) 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`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower)
alts :: [AutocompleteAlternative]
alts = Text -> AutocompleteAlternative
SyntaxCompletion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => [a] -> [a]
sort [Text]
prefixed forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> [a]
sort [Text]
notPrefixed)
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty
hiddenServerCommands :: [Text]
hiddenServerCommands :: [Text]
hiddenServerCommands =
[ Text
"settings"
, Text
"help"
, Text
"collapse"
, Text
"expand"
, Text
"logout"
, Text
"remove"
, Text
"msg"
, Text
"leave"
, Text
"join"
, Text
"search"
, Text
"shortcuts"
, Text
"open"
]
hiddenCommand :: Command -> Bool
hiddenCommand :: Command -> Bool
hiddenCommand Command
c = (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Command -> Text
commandTrigger Command
c) 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 forall a. Ord a => a -> a -> Bool
> Command -> ServerTime
commandCreateAt Command
cmd
doCommandAutoCompletion :: Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doCommandAutoCompletion :: Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doCommandAutoCompletion Traversal' ChatState (EditState Name)
which TeamId
tId AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
Session
session <- MH Session
getSession
Maybe (HashMap Text [AutocompleteAlternative])
mCache <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocompleteforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n.
Lens'
(AutocompleteState n) (HashMap Text [AutocompleteAlternative])
acCachedResponses)
Maybe AutocompletionType
mActiveTy <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocompleteforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (AutocompleteState n) AutocompletionType
acType)
let entry :: Maybe [AutocompleteAlternative]
entry = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
serverResponseKey forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (HashMap Text [AutocompleteAlternative])
mCache
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 (forall a. Maybe a -> Bool
isNothing Maybe [AutocompleteAlternative]
entry Bool -> Bool -> Bool
|| (Maybe AutocompletionType
mActiveTy forall a. Eq a => a -> a -> Bool
/= (forall a. a -> Maybe a
Just AutocompletionType
ACCommands)))
then AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
let clientAlts :: [(CompletionSource, Text, Text, Text)]
clientAlts = Cmd -> (CompletionSource, Text, Text, Text)
mkAlt 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, forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
args, Text
desc)
Seq Command
serverCommands <- TeamId -> Bool -> Session -> IO (Seq Command)
MM.mmListCommandsForTeam TeamId
tId Bool
False Session
session
let filteredServerCommands :: [Command]
filteredServerCommands =
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)) forall a b. (a -> b) -> a -> b
$
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 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompletionSource, Text, Text, Text) -> AutocompleteAlternative
mkCompletion forall a b. (a -> b) -> a -> b
$
[(CompletionSource, Text, Text, Text)]
clientAlts forall a. Semigroup a => a -> a -> a
<> [(CompletionSource, Text, Text, Text)]
serverAlts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
serverResponseKey [AutocompleteAlternative]
alts AutocompletionType
ty
let newAlts :: [AutocompleteAlternative]
newAlts = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text
-> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts Text
searchString) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter AutocompleteAlternative -> Bool
matches [AutocompleteAlternative]
alts
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
newAlts AutocompletionType
ty
else case Maybe [AutocompleteAlternative]
entry of
Just [AutocompleteAlternative]
alts | Maybe AutocompletionType
mActiveTy forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AutocompletionType
ACCommands ->
let newAlts :: [AutocompleteAlternative]
newAlts = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text
-> AutocompleteAlternative -> AutocompleteAlternative -> Ordering
compareCommandAlts Text
searchString) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter AutocompleteAlternative -> Bool
matches [AutocompleteAlternative]
alts
in Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
newAlts AutocompletionType
ty
Maybe [AutocompleteAlternative]
_ -> 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 forall a. Eq a => a -> a -> Bool
== Bool
isBPrefix
then 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 :: Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doUserAutoCompletion :: Traversal' ChatState (EditState Name)
-> TeamId
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doUserAutoCompletion Traversal' ChatState (EditState Name)
which TeamId
tId AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
Session
session <- MH Session
getSession
UserId
myUid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
ChannelId
cId <- forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx AutocompletionType
ty Text
searchString forall a b. (a -> b) -> a -> b
$
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
UserAutocomplete
ac <- Maybe TeamId
-> Maybe ChannelId -> Text -> Session -> IO UserAutocomplete
MM.mmAutocompleteUsers (forall a. a -> Maybe a
Just TeamId
tId) (forall a. a -> Maybe a
Just ChannelId
cId) Text
searchString Session
session
let active :: Seq User -> Seq User
active = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\User
u -> User -> UserId
userId User
u forall a. Eq a => a -> a -> Bool
/= UserId
myUid Bool -> Bool -> Bool
&& (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ User -> Bool
userDeleted User
u))
alts :: [AutocompleteAlternative]
alts = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$
((\User
u -> User -> Bool -> AutocompleteAlternative
UserCompletion User
u Bool
True) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq User -> Seq User
active forall a b. (a -> b) -> a -> b
$ UserAutocomplete -> Seq User
MM.userAutocompleteUsers UserAutocomplete
ac)) forall a. Semigroup a => a -> a -> a
<>
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\User
u -> User -> Bool -> AutocompleteAlternative
UserCompletion User
u Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq User -> Seq User
active) 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
]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString ([AutocompleteAlternative]
alts forall a. Semigroup a => a -> a -> a
<> [AutocompleteAlternative]
extras) AutocompletionType
ty
doChannelAutoCompletion :: TeamId
-> Traversal' ChatState (EditState Name)
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doChannelAutoCompletion :: TeamId
-> Traversal' ChatState (EditState Name)
-> AutocompletionType
-> AutocompleteContext
-> Text
-> MH ()
doChannelAutoCompletion TeamId
tId Traversal' ChatState (EditState Name)
which AutocompletionType
ty AutocompleteContext
ctx Text
searchString = do
Session
session <- MH Session
getSession
ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx AutocompletionType
ty Text
searchString forall a b. (a -> b) -> a -> b
$ do
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ (Bool -> Channel -> AutocompleteAlternative
ChannelCompletion Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
inChannels) forall a. Semigroup a => a -> a -> a
<>
(Bool -> Channel -> AutocompleteAlternative
ChannelCompletion Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
notInChannels)
(Seq Channel
inChannels, Seq Channel
notInChannels) = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition Channel -> Bool
isMember Seq Channel
results
isMember :: Channel -> Bool
isMember Channel
c = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Channel -> ChannelId
channelId Channel
c) ClientChannels
cs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty
withCachedAutocompleteResults :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> AutocompletionType
-> Text
-> MH ()
-> MH ()
withCachedAutocompleteResults Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx AutocompletionType
ty Text
searchString MH ()
act = do
Maybe (HashMap Text [AutocompleteAlternative])
mCache <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocompleteforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n.
Lens'
(AutocompleteState n) (HashMap Text [AutocompleteAlternative])
acCachedResponses)
Maybe AutocompletionType
mActiveTy <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocompleteforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (AutocompleteState n) AutocompletionType
acType)
case forall a. a -> Maybe a
Just AutocompletionType
ty forall a. Eq a => a -> a -> Bool
== Maybe AutocompletionType
mActiveTy of
Bool
True ->
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
searchString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (HashMap Text [AutocompleteAlternative])
mCache of
Just [AutocompleteAlternative]
alts -> Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty
Maybe [AutocompleteAlternative]
Nothing -> MH ()
act
Bool
False -> MH ()
act
setCompletionAlternatives :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives :: Traversal' ChatState (EditState Name)
-> AutocompleteContext
-> Text
-> [AutocompleteAlternative]
-> AutocompletionType
-> MH ()
setCompletionAlternatives Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx Text
searchString [AutocompleteAlternative]
alts AutocompletionType
ty = do
Maybe (EditState Name)
mVal <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse Traversal' ChatState (EditState Name)
which
case Maybe (EditState Name)
mVal of
Maybe (EditState Name)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just EditState Name
esVal -> do
let list :: GenericList Name Vector AutocompleteAlternative
list = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list (Name -> Name
CompletionList forall a b. (a -> b) -> a -> b
$ forall a n. Named a n => a -> n
getName forall a b. (a -> b) -> a -> b
$ EditState Name
esValforall s a. s -> Getting a s a -> a
^.forall n. Lens' (EditState n) (Editor Text n)
esEditor) (forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [AutocompleteAlternative]
alts) Int
1
pending :: Maybe Text
pending = EditState Name
esValforall s a. s -> Getting a s a -> a
^.forall n. Lens' (EditState n) (Maybe Text)
esAutocompletePending
state :: AutocompleteState Name
state = AutocompleteState { _acPreviousSearchString :: Text
_acPreviousSearchString = Text
searchString
, _acCompletionList :: GenericList Name Vector AutocompleteAlternative
_acCompletionList =
GenericList Name Vector AutocompleteAlternative
list forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
, _acCachedResponses :: HashMap Text [AutocompleteAlternative]
_acCachedResponses = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text
searchString, [AutocompleteAlternative]
alts)]
, _acType :: AutocompletionType
_acType = AutocompletionType
ty
}
case Maybe Text
pending of
Just Text
val | Text
val forall a. Eq a => a -> a -> Bool
== Text
searchString -> do
Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocomplete forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Maybe (AutocompleteState Name)
prev ->
let newState :: AutocompleteState Name
newState = case Maybe (AutocompleteState Name)
prev of
Maybe (AutocompleteState Name)
Nothing ->
AutocompleteState Name
state
Just AutocompleteState Name
oldState ->
AutocompleteState Name
state forall a b. a -> (a -> b) -> b
& forall n.
Lens'
(AutocompleteState n) (HashMap Text [AutocompleteAlternative])
acCachedResponses forall s t a b. ASetter s t a b -> b -> s -> t
.~
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
searchString [AutocompleteAlternative]
alts (AutocompleteState Name
oldStateforall s a. s -> Getting a s a -> a
^.forall n.
Lens'
(AutocompleteState n) (HashMap Text [AutocompleteAlternative])
acCachedResponses)
in forall a. a -> Maybe a
Just AutocompleteState Name
newState
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning forall a b. (a -> b) -> a -> b
$ forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ Name -> Name
CompletionList forall a b. (a -> b) -> a -> b
$ forall a n. Named a n => a -> n
getName forall a b. (a -> b) -> a -> b
$ EditState Name
esValforall s a. s -> Getting a s a -> a
^.forall n. Lens' (EditState n) (Editor Text n)
esEditor
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutocompleteContext -> Bool
autocompleteFirstMatch AutocompleteContext
ctx) forall a b. (a -> b) -> a -> b
$
Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete Traversal' ChatState (EditState Name)
which Direction
Forwards
Maybe Text
_ ->
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 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
go Int
col Int
j [Text]
ts = case [Text]
ts of
[] -> forall a. Maybe a
Nothing
(Text
w:[Text]
rest) | Int
j forall a. Ord a => a -> a -> Bool
<= Text -> Int
T.length Text
w Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
w) -> forall a. a -> Maybe a
Just (Int
col, Text
w)
| Bool
otherwise -> Int -> Int -> [Text] -> Maybe (Int, Text)
go (Int
col forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
w) (Int
j 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