{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.Editing
  ( requestSpellCheck
  , editingKeybindings
  , editingKeyHandlers
  , toggleMultilineEditing
  , invokeExternalEditor
  , handlePaste
  , handleInputSubmission
  , getEditorContent
  , handleEditingInput
  , cancelAutocompleteOrReplyOrEdit
  , replyToLatestMessage
  , Direction(..)
  , tabComplete
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( BrickEvent(VtyEvent) )
import           Brick.Keybindings
import           Brick.Main ( invalidateCache )
import           Brick.Widgets.Edit ( Editor, applyEdit , handleEditorEvent
                                    , getEditContents, editContentsL )
import qualified Brick.Widgets.List as L
import qualified Codec.Binary.UTF8.Generic as UTF8
import           Control.Arrow
import qualified Control.Concurrent.STM as STM
import qualified Data.ByteString as BS
import           Data.Char ( isSpace )
import qualified Data.Foldable as F
import           Data.Maybe ( fromJust )
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Zipper as Z
import qualified Data.Text.Zipper.Generic.Words as Z
import           Data.Time ( getCurrentTime )
import           Graphics.Vty ( Event(..), Key(..) )
import           Lens.Micro.Platform ( Traversal', Lens', (%=), (.=), (.~), to, _Just )
import qualified System.Environment as Sys
import qualified System.Exit as Sys
import qualified System.IO as Sys
import qualified System.IO.Temp as Sys
import qualified System.Process as Sys
import           Text.Aspell ( Aspell, AspellResponse(..), mistakeWord, askAspell )

import           Network.Mattermost.Types ( Post(..) )

import           Matterhorn.Config
import {-# SOURCE #-} Matterhorn.Command ( dispatchCommand )
import           Matterhorn.InputHistory
import           Matterhorn.State.Common
import           Matterhorn.State.Autocomplete
import {-# SOURCE #-} Matterhorn.State.Messages
import {-# SOURCE #-} Matterhorn.State.ThreadWindow
import           Matterhorn.Types hiding ( newState )
import           Matterhorn.Types.Common ( sanitizeUserText' )


startMultilineEditing :: Lens' ChatState (EditState Name) -> MH ()
startMultilineEditing :: Lens' ChatState (EditState Name) -> MH ()
startMultilineEditing Lens' ChatState (EditState Name)
which = do
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

toggleMultilineEditing :: Lens' ChatState (EditState Name) -> MH ()
toggleMultilineEditing :: Lens' ChatState (EditState Name) -> MH ()
toggleMultilineEditing Lens' ChatState (EditState Name)
which = do
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not

    -- If multiline is now disabled and there is more than one line in
    -- the editor, that means we're showing the multiline message status
    -- (see Draw.Main.renderUserCommandBox.commandBox) so we want to be
    -- sure no autocomplete UI is present in case the cursor was left on
    -- a word that would otherwise show completion alternatives.
    Bool
multiline <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline)
    Int
numLines <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' 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 s a. (s -> a) -> SimpleGetter s a
to forall t n. Monoid t => Editor t n -> [t]
getEditContentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
multiline Bool -> Bool -> Bool
&& Int
numLines forall a. Ord a => a -> a -> Bool
> Int
1) (forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Lens' ChatState (EditState Name)
which)

invokeExternalEditor :: Lens' ChatState (EditState Name) -> MH ()
invokeExternalEditor :: Lens' ChatState (EditState Name) -> MH ()
invokeExternalEditor Lens' ChatState (EditState Name)
which = do
    -- If EDITOR is in the environment, write the current message to a
    -- temp file, invoke EDITOR on it, read the result, remove the temp
    -- file, and update the program state.
    --
    -- If EDITOR is not present, fall back to 'vi'.
    Maybe String
mEnv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Sys.lookupEnv String
"EDITOR"
    let editorProgram :: String
editorProgram = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"vi" forall a. a -> a
id Maybe String
mEnv

    (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume forall a b. (a -> b) -> a -> b
$ \ ChatState
st -> do
      forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
Sys.withSystemTempFile String
"matterhorn_editor.md" forall a b. (a -> b) -> a -> b
$ \String
tmpFileName Handle
tmpFileHandle -> do
        -- Write the current message to the temp file
        Handle -> String -> IO ()
Sys.hPutStr Handle
tmpFileHandle forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$
            forall t n. Monoid t => Editor t n -> [t]
getEditContents forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor
        Handle -> IO ()
Sys.hClose Handle
tmpFileHandle

        -- Run the editor
        ExitCode
status <- String -> IO ExitCode
Sys.system (String
editorProgram forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
tmpFileName)

        -- On editor exit, if exited with zero status, read temp file.
        -- If non-zero status, skip temp file read.
        case ExitCode
status of
            ExitCode
Sys.ExitSuccess -> do
                ByteString
tmpBytes <- String -> IO ByteString
BS.readFile String
tmpFileName
                case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
tmpBytes of
                    Left UnicodeException
_ -> do
                        Text -> ChatState -> IO ChatState
postErrorMessageIO Text
"Failed to decode file contents as UTF-8" ChatState
st
                    Right Text
t -> do
                        let tmpLines :: [Text]
tmpLines = Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text -> Text
sanitizeUserText' Text
t
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChatState
st forall a b. a -> (a -> b) -> b
& Lens' 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 forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Text] -> Maybe Int -> TextZipper Text
Z.textZipper [Text]
tmpLines forall a. Maybe a
Nothing)
            Sys.ExitFailure Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
st

handlePaste :: Lens' ChatState (EditState Name) -> BS.ByteString -> MH ()
handlePaste :: Lens' ChatState (EditState Name) -> ByteString -> MH ()
handlePaste Lens' ChatState (EditState Name)
which ByteString
bytes = do
  let pasteStr :: Text
pasteStr = String -> Text
T.pack (forall b s. UTF8Bytes b s => b -> String
UTF8.toString ByteString
bytes)
  Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany (Text -> Text
sanitizeUserText' Text
pasteStr))
  [Text]
contents <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' 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 s a. (s -> a) -> SimpleGetter s a
to forall t n. Monoid t => Editor t n -> [t]
getEditContents)
  case forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
contents forall a. Ord a => a -> a -> Bool
> Int
1 of
      Bool
True -> Lens' ChatState (EditState Name) -> MH ()
startMultilineEditing Lens' ChatState (EditState Name)
which
      Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

editingPermitted :: ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted :: ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which =
    (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall t n. Monoid t => Editor t n -> [t]
getEditContents forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) forall a. Eq a => a -> a -> Bool
== Int
1) Bool -> Bool -> Bool
||
    ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline

editingKeybindings :: Lens' ChatState (Editor T.Text Name) -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
editingKeybindings :: Lens' ChatState (Editor Text Name)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
editingKeybindings Lens' ChatState (Editor Text Name)
editor KeyConfig KeyEvent
kc = forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc forall a b. (a -> b) -> a -> b
$ Lens' ChatState (Editor Text Name) -> [MHKeyEventHandler]
editingKeyHandlers Lens' ChatState (Editor Text Name)
editor

editingKeyHandlers :: Lens' ChatState (Editor T.Text Name) -> [MHKeyEventHandler]
editingKeyHandlers :: Lens' ChatState (Editor Text Name) -> [MHKeyEventHandler]
editingKeyHandlers Lens' ChatState (Editor Text Name)
editor =
  [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorTransposeCharsEvent
    Text
"Transpose the final two characters"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.transposeChars)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorBolEvent
    Text
"Go to the start of the current line"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorEolEvent
    Text
"Go to the end of the current line"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorDeleteCharacter
    Text
"Delete the character at the cursor"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorKillToBolEvent
    Text
"Delete from the cursor to the start of the current line"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToBOL)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorNextCharEvent
    Text
"Move one character to the right"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorPrevCharEvent
    Text
"Move one character to the left"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorNextWordEvent
    Text
"Move one word to the right"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordRight)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorPrevWordEvent
    Text
"Move one word to the left"
    (Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordLeft)
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorDeletePrevWordEvent
    Text
"Delete the word to the left of the cursor" forall a b. (a -> b) -> a -> b
$ do
    Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
Z.deletePrevWord
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorDeleteNextWordEvent
    Text
"Delete the word to the right of the cursor" forall a b. (a -> b) -> a -> b
$ do
    Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.deleteWord
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorHomeEvent
    Text
"Move the cursor to the beginning of the input" forall a b. (a -> b) -> a -> b
$ do
    Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoHome
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorEndEvent
    Text
"Move the cursor to the end of the input" forall a b. (a -> b) -> a -> b
$ do
    Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorKillToEolEvent
    Text
"Kill the line to the right of the current position and copy it" forall a b. (a -> b) -> a -> b
$ do
      TextZipper Text
z <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (Editor Text Name)
editorforall 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)
      let restOfLine :: Text
restOfLine = forall a. Monoid a => TextZipper a -> a
Z.currentLine (forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToBOL TextZipper Text
z)
      Lens' ChatState GlobalEditState
csGlobalEditStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' GlobalEditState Text
gedYankBuffer forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
restOfLine
      Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToEOL
  , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EditorYankEvent
    Text
"Paste the current buffer contents at the cursor" forall a b. (a -> b) -> a -> b
$ do
        Text
buf <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState GlobalEditState
csGlobalEditStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' GlobalEditState Text
gedYankBuffer)
        Lens' ChatState (Editor Text Name)
editor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany Text
buf)
  ]

getEditorContent :: Lens' ChatState (EditState Name) -> MH Text
getEditorContent :: Lens' ChatState (EditState Name) -> MH Text
getEditorContent Lens' ChatState (EditState Name)
which = do
    Editor Text Name
cmdLine <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor)
    let (Text
line, [Text]
rest) = case forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
cmdLine of
            (Text
a:[Text]
as) -> (Text
a, [Text]
as)
            [Text]
_ -> forall a. HasCallStack => String -> a
error String
"BUG: getEditorContent: got empty edit contents"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ Text
line forall a. a -> [a] -> [a]
: [Text]
rest

-- | Handle an input submission in the message editor.
--
-- This handles the specified input text as if it were user input for
-- the specified channel. This means that if the specified input text
-- contains a command ("/...") then it is executed as normal. Otherwise
-- the text is sent as a message to the specified channel.
--
-- However, this function assumes that the message editor is the
-- *source* of the text, so it also takes care of clearing the editor,
-- resetting the edit mode, updating the input history for the specified
-- channel, etc.
handleInputSubmission :: Lens' ChatState (EditState Name)
                      -> Text
                      -> MH ()
handleInputSubmission :: Lens' ChatState (EditState Name) -> Text -> MH ()
handleInputSubmission Lens' ChatState (EditState Name)
editWhich Text
content = do
    ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)

    -- We clean up before dispatching the command or sending the message
    -- since otherwise the command could change the state and then doing
    -- cleanup afterwards could clean up the wrong things.
    Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper
    Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

    Lens' ChatState InputHistory
csInputHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> ChannelId -> InputHistory -> InputHistory
addHistoryEntry Text
content ChannelId
cId

    case Text -> Maybe (Char, Text)
T.uncons Text
content of
      Just (Char
'/', Text
cmd) -> do
          TeamId
tId <- do
              Maybe TeamId
mTid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe TeamId)
esTeamId)
              TeamId
curTid <- 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
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe TeamId
curTid Maybe TeamId
mTid
          TeamId -> Text -> MH ()
dispatchCommand TeamId
tId Text
cmd
      Maybe (Char, Text)
_ -> do
          Vector AttachmentData
attachments <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL)
          EditMode
mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
          ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage ChannelId
cId EditMode
mode Text
content forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector AttachmentData
attachments

          -- Empty the attachment list only if a mesage is
          -- actually sent, since it's possible to /attach a
          -- file before actually sending the message
          Lens' ChatState (EditState Name) -> MH ()
resetAttachmentList Lens' ChatState (EditState Name)
editWhich

    -- Reset the autocomplete UI
    forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Lens' ChatState (EditState Name)
editWhich

    -- Reset the edit mode *after* handling the input so that the input
    -- handler can tell whether we're editing, replying, etc.
    EditMode
resetEditMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esResetEditMode)
    Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
resetEditMode

closingPunctuationMarks :: String
closingPunctuationMarks :: String
closingPunctuationMarks = String
".,'\";:)]!?"

isSmartClosingPunctuation :: Event -> Bool
isSmartClosingPunctuation :: Event -> Bool
isSmartClosingPunctuation (EvKey (KChar Char
c) []) = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
closingPunctuationMarks
isSmartClosingPunctuation Event
_ = Bool
False

handleEditingInput :: Lens' ChatState (EditState Name)
                   -> Event
                   -> MH ()
handleEditingInput :: Lens' ChatState (EditState Name) -> Event -> MH ()
handleEditingInput Lens' ChatState (EditState Name)
which Event
e = do
    ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)

    -- Only handle input events to the editor if we permit editing:
    -- if multiline mode is off, or if there is only one line of text
    -- in the editor. This means we skip input this catch-all handler
    -- if we're *not* in multiline mode *and* there are multiple lines,
    -- i.e., we are showing the user the status message about the
    -- current editor state and editing is not permitted.

    -- Record the input line count before handling the editing event
    -- so we can tell whether the editing event changes the line count
    -- later.
    Int
beforeLineCount <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' 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 s a. (s -> a) -> SimpleGetter s a
to forall t n. Monoid t => Editor t n -> [t]
getEditContentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length)

    Bool
smartBacktick <- 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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configSmartBacktickL)
    let smartChars :: String
smartChars = String
"*`_"
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

    Bool
smartEditing <- 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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configSmartEditingL)
    Bool
justCompleted <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) Bool
esJustCompleted)

    Config
conf <- 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 Config
crConfiguration)
    let keyMap :: KeyDispatcher KeyEvent MH
keyMap = Lens' ChatState (Editor Text Name)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
editingKeybindings (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) (Config -> KeyConfig KeyEvent
configUserKeys Config
conf)
    case Event
e of
        EvKey Key
k [Modifier]
mods -> do
            case forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent Key
k [Modifier]
mods KeyDispatcher KeyEvent MH
keyMap of
              Just KeyHandler KeyEvent MH
kb | ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which -> (forall (m :: * -> *). Handler m -> m ()
handlerAction forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler KeyHandler KeyEvent MH
kb)
              Maybe (KeyHandler KeyEvent MH)
_ -> do
                case (Key
k, [Modifier]
mods) of
                  -- Not editing; backspace here means cancel multi-line message
                  -- composition
                  (Key
KBS, []) | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which) -> do
                    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper
                    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache

                  -- Backspace in editing mode with smart pair insertion means
                  -- smart pair removal when possible
                  (Key
KBS, []) | ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which Bool -> Bool -> Bool
&& Bool
smartBacktick ->
                      let backspace :: MH ()
backspace = Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar
                      in case forall a. String -> Editor Text a -> Maybe Char
cursorAtOneOf String
smartChars (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) of
                          Maybe Char
Nothing -> MH ()
backspace
                          Just Char
ch ->
                              -- Smart char removal:
                              if | (forall a. Char -> Editor Text a -> Bool
cursorAtChar Char
ch forall a b. (a -> b) -> a -> b
$ forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) Bool -> Bool -> Bool
&&
                                   (forall a. Editor Text a -> Bool
cursorIsAtEnd forall a b. (a -> b) -> a -> b
$ forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) ->
                                     Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar)
                                 | Bool
otherwise -> MH ()
backspace

                  (KChar Char
ch, [])
                    | ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which Bool -> Bool -> Bool
&& Bool
smartBacktick Bool -> Bool -> Bool
&& Char
ch forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
smartChars ->
                      -- Smart char insertion:
                      let doInsertChar :: MH ()
doInsertChar = do
                            Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => Char -> TextZipper a -> TextZipper a
Z.insertChar Char
ch)
                            Lens' ChatState (EditState Name) -> MH ()
sendUserTypingAction Lens' ChatState (EditState Name)
which
                          curLine :: Text
curLine = forall a. Monoid a => TextZipper a -> a
Z.currentLine forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' 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
                      -- First case: if the cursor is at the end of the current
                      -- line and it contains "``" and the user entered a third
                      -- "`", enable multi-line mode since they're likely typing
                      -- a code block.
                      in if | (forall a. Editor Text a -> Bool
cursorIsAtEnd forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) Bool -> Bool -> Bool
&&
                                 Text
curLine forall a. Eq a => a -> a -> Bool
== Text
"``" Bool -> Bool -> Bool
&&
                                 Char
ch forall a. Eq a => a -> a -> Bool
== Char
'`' -> do
                                Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany (Char -> Text
T.singleton Char
ch))
                                Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                            -- Second case: user entered some smart character
                            -- (don't care which) on an empty line or at the end
                            -- of the line after whitespace, so enter a pair of
                            -- the smart chars and put the cursor between them.
                            | (forall a. Editor Text a -> Bool
editorEmpty forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) Bool -> Bool -> Bool
||
                                 ((forall a. Char -> Editor Text a -> Bool
cursorAtChar Char
' ' (forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor)) Bool -> Bool -> Bool
&&
                                  (forall a. Editor Text a -> Bool
cursorIsAtEnd forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor)) ->
                                Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
chforall a. a -> [a] -> [a]
:Char
chforall a. a -> [a] -> [a]
:[]) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft)
                            -- Third case: the cursor is already on a smart
                            -- character and that character is the last one
                            -- on the line, so instead of inserting a new
                            -- character, just move past it.
                            | (forall a. Char -> Editor Text a -> Bool
cursorAtChar Char
ch forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) Bool -> Bool -> Bool
&&
                              (forall a. Editor Text a -> Bool
cursorIsAtEnd forall a b. (a -> b) -> a -> b
$ forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) ->
                                Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
                            -- Fall-through case: just insert one of the chars
                            -- without doing anything smart.
                            | Bool
otherwise -> MH ()
doInsertChar
                    | ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which -> do

                      -- If the most recent editing event was a tab completion,
                      -- there is a trailing space that we want to remove if the
                      -- next input character is punctuation.
                      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
smartEditing Bool -> Bool -> Bool
&& Bool
justCompleted Bool -> Bool -> Bool
&& Event -> Bool
isSmartClosingPunctuation Event
e) forall a b. (a -> b) -> a -> b
$
                          Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar

                      Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany (Text -> Text
sanitizeUserText' forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
ch))
                      Lens' ChatState (EditState Name) -> MH ()
sendUserTypingAction Lens' ChatState (EditState Name)
which
                  (Key, [Modifier])
_ | ChatState -> Lens' ChatState (EditState Name) -> Bool
editingPermitted ChatState
st Lens' ChatState (EditState Name)
which -> do
                      forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
                      Lens' ChatState (EditState Name) -> MH ()
sendUserTypingAction Lens' ChatState (EditState Name)
which
                    | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    let ctx :: AutocompleteContext
ctx = AutocompleteContext { autocompleteManual :: Bool
autocompleteManual = Bool
False
                                  , autocompleteFirstMatch :: Bool
autocompleteFirstMatch = Bool
False
                                  }
    Traversal' ChatState (EditState Name)
-> AutocompleteContext -> MH ()
checkForAutocompletion Lens' ChatState (EditState Name)
which AutocompleteContext
ctx

    -- Reset the spell check timer for this editor
    Maybe (IO ())
mReset <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (IO ()))
esSpellCheckTimerReset)
    case Maybe (IO ())
mReset of
        Maybe (IO ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just IO ()
reset -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
reset

    -- If the preview is enabled and multi-line editing is enabled and
    -- the line count changed, we need to invalidate the rendering cache
    -- entry for the channel messages because we want to redraw them to
    -- fit in the space just changed by the size of the preview area.
    Int
afterLineCount <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' 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 s a. (s -> a) -> SimpleGetter s a
to forall t n. Monoid t => Editor t n -> [t]
getEditContentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length)
    Bool
isMultiline <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline)
    Bool
isPreviewing <- 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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configShowMessagePreviewL)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
beforeLineCount forall a. Eq a => a -> a -> Bool
/= Int
afterLineCount Bool -> Bool -> Bool
&& Bool
isMultiline Bool -> Bool -> Bool
&& Bool
isPreviewing) forall a b. (a -> b) -> a -> b
$ do
        ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId

    -- Reset the recent autocompletion flag to stop smart punctuation
    -- handling.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
justCompleted forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) Bool
esJustCompleted forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

-- | Send the user_typing action to the server asynchronously, over the
-- connected websocket. If the websocket is not connected, drop the
-- action silently.
sendUserTypingAction :: Lens' ChatState (EditState Name)
                     -> MH ()
sendUserTypingAction :: Lens' ChatState (EditState Name) -> MH ()
sendUserTypingAction Lens' ChatState (EditState Name)
which = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configSendTypingNotifications (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)) forall a b. (a -> b) -> a -> b
$
      case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ConnectionStatus
csConnectionStatus of
        ConnectionStatus
Connected -> do
          let pId :: Maybe PostId
pId = case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode of
                      Replying Message
_ Post
post -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
post
                      EditMode
_               -> forall a. Maybe a
Nothing
          ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            UTCTime
now <- IO UTCTime
getCurrentTime
            let action :: WebsocketAction
action = UTCTime -> ChannelId -> Maybe PostId -> WebsocketAction
UserTyping UTCTime
now ChannelId
cId Maybe PostId
pId
            forall a. STM a -> IO a
STM.atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
STM.writeTChan (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan WebsocketAction)
crWebsocketActionChan) WebsocketAction
action
        ConnectionStatus
Disconnected -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Kick off an async request to the spell checker for the current editor
-- contents.
requestSpellCheck :: Aspell -> MessageInterfaceTarget -> MH ()
requestSpellCheck :: Aspell -> MessageInterfaceTarget -> MH ()
requestSpellCheck Aspell
checker MessageInterfaceTarget
target = do
    -- Get the editor contents.
    Maybe [Text]
mContents <- case MessageInterfaceTarget
target of
        MITeamThread TeamId
tId -> do
            Maybe ThreadInterface
mTi <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId))
            case Maybe ThreadInterface
mTi of
                Maybe ThreadInterface
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just ThreadInterface
ti -> 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
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents forall a b. (a -> b) -> a -> b
$ ThreadInterface
tiforall s a. s -> Getting a s a -> a
^.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor
        MIChannel ChannelId
cId -> do
            Maybe ChannelMessageInterface
mMi <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface(ChannelId
cId))
            case Maybe ChannelMessageInterface
mMi of
                Maybe ChannelMessageInterface
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just ChannelMessageInterface
mi -> 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
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents forall a b. (a -> b) -> a -> b
$ ChannelMessageInterface
miforall s a. s -> Getting a s a -> a
^.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor

    case Maybe [Text]
mContents of
        Maybe [Text]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [Text]
contents ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                -- For each line in the editor, submit an aspell request.
                let query :: IO [AspellResponse]
query = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Aspell -> Text -> IO [AspellResponse]
askAspell Aspell
checker) [Text]
contents
                    postMistakes :: [AspellResponse] -> MH ()
                    postMistakes :: [AspellResponse] -> MH ()
postMistakes [AspellResponse]
responses = do
                        let getMistakes :: AspellResponse -> [Text]
getMistakes AspellResponse
AllCorrect = []
                            getMistakes (Mistakes [Mistake]
ms) = Mistake -> Text
mistakeWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Mistake]
ms
                            allMistakes :: Set Text
allMistakes = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ AspellResponse -> [Text]
getMistakes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AspellResponse]
responses

                        case MessageInterfaceTarget
target of
                            MITeamThread TeamId
tId ->
                                TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall 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 i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Set Text)
esMisspellings forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Set Text
allMistakes
                            MIChannel ChannelId
cId ->
                                ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Set Text)
esMisspellings forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Set Text
allMistakes

                forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM IO [AspellResponse]
query (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AspellResponse] -> MH ()
postMistakes)

editorEmpty :: Editor Text a -> Bool
editorEmpty :: forall a. Editor Text a -> Bool
editorEmpty Editor Text a
e = forall a. Editor Text a -> Bool
cursorIsAtEnd Editor Text a
e Bool -> Bool -> Bool
&&
                forall a. Editor Text a -> Bool
cursorIsAtBeginning Editor Text a
e

cursorIsAtEnd :: Editor Text a -> Bool
cursorIsAtEnd :: forall a. Editor Text a -> Bool
cursorIsAtEnd Editor Text a
e =
    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
        z :: TextZipper Text
z = Editor Text a
eforall s a. s -> Getting a s a -> a
^.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL
    in Int
col forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
curLine

cursorIsAtBeginning :: Editor Text a -> Bool
cursorIsAtBeginning :: forall a. Editor Text a -> Bool
cursorIsAtBeginning Editor Text a
e =
    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
        z :: TextZipper Text
z = Editor Text a
eforall s a. s -> Getting a s a -> a
^.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL
    in Int
col forall a. Eq a => a -> a -> Bool
== Int
0

cursorAtOneOf :: [Char] -> Editor Text a -> Maybe Char
cursorAtOneOf :: forall a. String -> Editor Text a -> Maybe Char
cursorAtOneOf [] Editor Text a
_ = forall a. Maybe a
Nothing
cursorAtOneOf (Char
c:String
cs) Editor Text a
e =
    if forall a. Char -> Editor Text a -> Bool
cursorAtChar Char
c Editor Text a
e
    then forall a. a -> Maybe a
Just Char
c
    else forall a. String -> Editor Text a -> Maybe Char
cursorAtOneOf String
cs Editor Text a
e

cursorAtChar :: Char -> Editor Text a -> Bool
cursorAtChar :: forall a. Char -> Editor Text a -> Bool
cursorAtChar Char
ch Editor Text a
e =
    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
        z :: TextZipper Text
z = Editor Text a
eforall s a. s -> Getting a s a -> a
^.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL
    in (Char -> Text
T.singleton Char
ch) Text -> Text -> Bool
`T.isPrefixOf` Int -> Text -> Text
T.drop Int
col Text
curLine

gotoHome :: Z.TextZipper Text -> Z.TextZipper Text
gotoHome :: TextZipper Text -> TextZipper Text
gotoHome = forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursor (Int
0, Int
0)

gotoEnd :: Z.TextZipper Text -> Z.TextZipper Text
gotoEnd :: TextZipper Text -> TextZipper Text
gotoEnd TextZipper Text
z =
    let zLines :: [Text]
zLines = forall a. Monoid a => TextZipper a -> [a]
Z.getText TextZipper Text
z
        numLines :: Int
numLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
zLines
        lastLineLength :: Int
lastLineLength = Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Text]
zLines
    in if Int
numLines forall a. Ord a => a -> a -> Bool
> Int
0
       then forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursor (Int
numLines forall a. Num a => a -> a -> a
- Int
1, Int
lastLineLength) TextZipper Text
z
       else TextZipper Text
z

-- Cancels the following states in this order, as appropriate based on
-- context:
-- * Autocomplete UI display
-- * Reply
-- * Edit
-- * Close current team's thread window if open
cancelAutocompleteOrReplyOrEdit :: Lens' ChatState (EditState Name) -> MH ()
cancelAutocompleteOrReplyOrEdit :: Lens' ChatState (EditState Name) -> MH ()
cancelAutocompleteOrReplyOrEdit Lens' ChatState (EditState Name)
which = do
    ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)
    ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
    Maybe (AutocompleteState Name)
ac <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocomplete)
    case Maybe (AutocompleteState Name)
ac of
        Just AutocompleteState Name
_ -> do
            forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Lens' ChatState (EditState Name)
which
        Maybe (AutocompleteState Name)
Nothing -> do
            EditMode
resetEditMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esResetEditMode)

            let resetEditor :: MH ()
resetEditor = do
                    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
resetEditMode
                    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper
                    Lens' ChatState (EditState Name) -> MH ()
resetAttachmentList Lens' ChatState (EditState Name)
which

            EditMode
curEditMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
            case EditMode
curEditMode of
                EditMode
NewPost -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Editing {} -> MH ()
resetEditor
                Replying {} -> do
                    EditMode
prevMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
                    MH ()
resetEditor
                    EditMode
newMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EditMode
newMode forall a. Eq a => a -> a -> Bool
== EditMode
prevMode) forall a b. (a -> b) -> a -> b
$
                        (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
                            Maybe ThreadInterface
ti <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface)
                            MessageInterfaceFocus
foc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus)
                            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ThreadInterface
ti Bool -> Bool -> Bool
&& MessageInterfaceFocus
foc forall a. Eq a => a -> a -> Bool
== MessageInterfaceFocus
FocusThread) forall a b. (a -> b) -> a -> b
$
                                TeamId -> MH ()
closeThreadWindow TeamId
tId

replyToLatestMessage :: Lens' ChatState (MessageInterface n i) -> MH ()
replyToLatestMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
replyToLatestMessage Lens' ChatState (MessageInterface n i)
which = do
    Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
    ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
    case (Message -> Bool) -> Messages -> Maybe Message
findLatestUserMessage Message -> Bool
isReplyable Messages
msgs of
      Just Message
msg | Message -> Bool
isReplyable Message
msg ->
          do Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
             ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
             Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Post -> EditMode
Replying Message
rootMsg (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost)
      Maybe Message
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Direction = Forwards | Backwards

tabComplete :: Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete :: Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete Traversal' ChatState (EditState Name)
which Direction
dir = do
    Text
searchStr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (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) Text
acPreviousSearchString)

    let transform :: GenericList n t AutocompleteAlternative
-> GenericList n t AutocompleteAlternative
transform GenericList n t AutocompleteAlternative
list =
            let len :: Int
len = GenericList n t AutocompleteAlternative
listforall s a. s -> Getting a s a -> a
^.forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length
                prefixMatch :: AutocompleteAlternative -> Bool
prefixMatch AutocompleteAlternative
alt =
                    Text -> Text
T.toLower Text
searchStr Text -> Text -> Bool
`T.isPrefixOf` (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ AutocompleteAlternative -> Text
autocompleteAlternativeText AutocompleteAlternative
alt)
            in case Direction
dir of
                Direction
Forwards ->
                    if forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected GenericList n t AutocompleteAlternative
list forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Int
len forall a. Num a => a -> a -> a
- Int
1)
                       then forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveTo Int
0 GenericList n t AutocompleteAlternative
list
                       else if forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected GenericList n t AutocompleteAlternative
list forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
> Int
0
                            -- If the list has nothing selected, then
                            -- make the initial selection the best match
                            -- by prefix rather than always selecting
                            -- the first entry. If there is no match
                            -- based on prefix, then select the first
                            -- entry.
                            --
                            -- Note that we only bother with this
                            -- behavior in the Forward case because in
                            -- the Backwards case we don't want the
                            -- first selection to be based on prefix
                            -- match since that doesn't make sense.
                            then let new :: GenericList n t AutocompleteAlternative
new = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
L.listFindBy AutocompleteAlternative -> Bool
prefixMatch GenericList n t AutocompleteAlternative
list
                                 in if forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected GenericList n t AutocompleteAlternative
new forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
                                    -- If, after attempting to select
                                    -- by prefix, nothing matched, then
                                    -- there is still no autocomplete
                                    -- alternative selected, so move to
                                    -- the selection to the first entry
                                    -- in the list.
                                    then forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
1 GenericList n t AutocompleteAlternative
new
                                    else GenericList n t AutocompleteAlternative
new
                    else forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
1 GenericList n t AutocompleteAlternative
list
                Direction
Backwards ->
                    if (forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected GenericList n t AutocompleteAlternative
list forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0) Bool -> Bool -> Bool
||
                       (forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
L.listSelected GenericList n t AutocompleteAlternative
list forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
> Int
0)
                    then forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveTo (Int
len forall a. Num a => a -> a -> a
- Int
1) GenericList n t AutocompleteAlternative
list
                    else forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy (-Int
1) GenericList n t AutocompleteAlternative
list

    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 n1 n2.
Lens
  (AutocompleteState n1)
  (AutocompleteState n2)
  (List n1 AutocompleteAlternative)
  (List n2 AutocompleteAlternative)
acCompletionList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {t :: * -> *} {n}.
(Foldable t, Splittable t) =>
GenericList n t AutocompleteAlternative
-> GenericList n t AutocompleteAlternative
transform

    Maybe (AutocompleteState Name)
mac <- 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)
    case Maybe (AutocompleteState Name)
mac of
        Maybe (AutocompleteState Name)
Nothing -> do
            let ctx :: AutocompleteContext
ctx = AutocompleteContext { autocompleteManual :: Bool
autocompleteManual = Bool
True
                                          , autocompleteFirstMatch :: Bool
autocompleteFirstMatch = Bool
True
                                          }
            Traversal' ChatState (EditState Name)
-> AutocompleteContext -> MH ()
checkForAutocompletion Traversal' ChatState (EditState Name)
which AutocompleteContext
ctx
        Just AutocompleteState Name
ac -> do
            case AutocompleteState Name
acforall s a. s -> Getting a s a -> a
^.forall n1 n2.
Lens
  (AutocompleteState n1)
  (AutocompleteState n2)
  (List n1 AutocompleteAlternative)
  (List n2 AutocompleteAlternative)
acCompletionListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
L.listSelectedElement of
                Maybe (Int, AutocompleteAlternative)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just (Int
_, AutocompleteAlternative
alternative) -> do
                    let replacement :: Text
replacement = AutocompleteAlternative -> Text
autocompleteAlternativeReplacement AutocompleteAlternative
alternative
                        maybeEndOfWord :: TextZipper a -> TextZipper a
maybeEndOfWord TextZipper a
z =
                            if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isSpace (forall a. TextZipper a -> Maybe Char
Z.currentChar TextZipper a
z)
                            then TextZipper a
z
                            else forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordRight TextZipper a
z
                    Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
                        forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => Char -> TextZipper a -> TextZipper a
Z.insertChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany Text
replacement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
Z.deletePrevWord forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   forall a. GenericTextZipper a => TextZipper a -> TextZipper a
maybeEndOfWord)
                    Traversal' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) Bool
esJustCompleted forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

                    -- If there was only one completion alternative,
                    -- hide the autocomplete listing now that we've
                    -- completed the only completion.
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutocompleteState Name
acforall s a. s -> Getting a s a -> a
^.forall n1 n2.
Lens
  (AutocompleteState n1)
  (AutocompleteState n2)
  (List n1 AutocompleteAlternative)
  (List n2 AutocompleteAlternative)
acCompletionListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall n (t :: * -> *) e. GenericList n t e -> t e
L.listElementsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a. Eq a => a -> a -> Bool
== Int
1) (forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Traversal' ChatState (EditState Name)
which)

resetAttachmentList :: Lens' ChatState (EditState Name) -> MH ()
resetAttachmentList :: Lens' ChatState (EditState Name) -> MH ()
resetAttachmentList Lens' ChatState (EditState Name)
which = do
    Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) e n.
Monoid (t e) =>
GenericList n t e -> GenericList n t e
L.listClear