matterhorn-30802.1.0: src/State/Editing.hs
{-# LANGUAGE MultiWayIf #-}
module State.Editing where
import Prelude ()
import Prelude.Compat
import Brick.Widgets.Edit (Editor, handleEditorEvent, getEditContents, editContentsL)
import Brick.Widgets.Edit (applyEdit)
import qualified Codec.Binary.UTF8.Generic as UTF8
import Control.Arrow
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import Data.Monoid ((<>))
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 Graphics.Vty (Event(..), Key(..), Modifier(..))
import Lens.Micro.Platform
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 Network.Mattermost
import Network.Mattermost.Lenses
import Config
import Types
import State.Common
startMultilineEditing :: MH ()
startMultilineEditing = csEditState.cedMultiline .= True
toggleMultilineEditing :: MH ()
toggleMultilineEditing = csEditState.cedMultiline %= not
invokeExternalEditor :: MH ()
invokeExternalEditor = 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'.
mEnv <- liftIO $ Sys.lookupEnv "EDITOR"
let editorProgram = maybe "vi" id mEnv
mhSuspendAndResume $ \ st -> do
Sys.withSystemTempFile "matterhorn_editor.tmp" $ \tmpFileName tmpFileHandle -> do
-- Write the current message to the temp file
Sys.hPutStr tmpFileHandle $ T.unpack $ T.intercalate "\n" $
getEditContents $ st^.csCmdLine
Sys.hClose tmpFileHandle
-- Run the editor
status <- Sys.system (editorProgram <> " " <> tmpFileName)
-- On editor exit, if exited with zero status, read temp file.
-- If non-zero status, skip temp file read.
case status of
Sys.ExitSuccess -> do
tmpBytes <- BS.readFile tmpFileName
case T.decodeUtf8' tmpBytes of
Left _ -> do
postErrorMessageIO "Failed to decode file contents as UTF-8" st
Right t -> do
let tmpLines = T.lines t
return $ st & csCmdLine.editContentsL .~ (Z.textZipper tmpLines Nothing)
& csEditState.cedMultiline .~ (length tmpLines > 1)
Sys.ExitFailure _ -> return st
toggleMessagePreview :: MH ()
toggleMessagePreview = csShowMessagePreview %= not
addUserToCurrentChannel :: T.Text -> MH ()
addUserToCurrentChannel uname = do
-- First: is this a valid username?
usrs <- use usrMap
let results = filter ((== uname) . _uiName . snd) $ HM.toList usrs
case results of
[(uid, _)] -> do
cId <- use csCurrentChannelId
session <- use csSession
myTeamId <- use (csMyTeam.teamIdL)
doAsyncWith Normal $ do
tryMM (void $ mmChannelAddUser session myTeamId cId uid)
(const $ return (return ()))
_ -> do
postErrorMessage ("No such user: " <> uname)
handlePaste :: BS.ByteString -> MH ()
handlePaste bytes = do
let pasteStr = T.pack (UTF8.toString bytes)
csCmdLine %= applyEdit (Z.insertMany pasteStr)
contents <- use (csCmdLine.to getEditContents)
case length contents > 1 of
True -> startMultilineEditing
False -> return ()
editingPermitted :: ChatState -> Bool
editingPermitted st =
(length (getEditContents $ st^.csCmdLine) == 1) ||
st^.csEditState.cedMultiline
editingKeybindings :: [Keybinding]
editingKeybindings =
[ KB "Transpose the final two characters"
(EvKey (KChar 't') [MCtrl]) $ do
csCmdLine %= applyEdit Z.transposeChars
, KB "Move one character to the right"
(EvKey (KChar 'f') [MCtrl]) $ do
csCmdLine %= applyEdit Z.moveRight
, KB "Move one character to the left"
(EvKey (KChar 'b') [MCtrl]) $ do
csCmdLine %= applyEdit Z.moveLeft
, KB "Move one word to the right"
(EvKey (KChar 'f') [MMeta]) $ do
csCmdLine %= applyEdit Z.moveWordRight
, KB "Move one word to the left"
(EvKey (KChar 'b') [MMeta]) $ do
csCmdLine %= applyEdit Z.moveWordLeft
, KB "Delete the word to the left of the cursor"
(EvKey (KBS) [MMeta]) $ do
csCmdLine %= applyEdit Z.deletePrevWord
, KB "Delete the word to the left of the cursor"
(EvKey (KChar 'w') [MCtrl]) $ do
csCmdLine %= applyEdit Z.deletePrevWord
, KB "Delete the word to the right of the cursor"
(EvKey (KChar 'd') [MMeta]) $ do
csCmdLine %= applyEdit Z.deleteWord
, KB "Kill the line to the right of the current position and copy it"
(EvKey (KChar 'k') [MCtrl]) $ do
z <- use (csCmdLine.editContentsL)
let restOfLine = Z.currentLine (Z.killToBOL z)
csEditState.cedYankBuffer .= restOfLine
csCmdLine %= applyEdit Z.killToEOL
, KB "Paste the current buffer contents at the cursor"
(EvKey (KChar 'y') [MCtrl]) $ do
buf <- use (csEditState.cedYankBuffer)
csCmdLine %= applyEdit (Z.insertMany buf)
]
handleEditingInput :: Event -> MH ()
handleEditingInput e = do
-- 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.
smartBacktick <- use (csResources.crConfiguration.to configSmartBacktick)
let smartChars = "*`_"
st <- use id
case lookupKeybinding e editingKeybindings of
Just kb | editingPermitted st -> kbAction kb
_ -> do
case e of
-- Not editing; backspace here means cancel multi-line message
-- composition
EvKey KBS [] | (not $ editingPermitted st) ->
csCmdLine %= applyEdit Z.clearZipper
-- Backspace in editing mode with smart pair insertion means
-- smart pair removal when possible
EvKey KBS [] | editingPermitted st && smartBacktick ->
let backspace = csCmdLine %= applyEdit Z.deletePrevChar
in case cursorAtOneOf smartChars (st^.csCmdLine) of
Nothing -> backspace
Just ch ->
-- Smart char removal:
if | (cursorAtChar ch $ applyEdit Z.moveLeft $ st^.csCmdLine) &&
(cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csCmdLine) ->
csCmdLine %= applyEdit (Z.deleteChar >>> Z.deletePrevChar)
| otherwise -> backspace
EvKey (KChar ch) [] | editingPermitted st && smartBacktick && ch `elem` smartChars ->
-- Smart char insertion:
let doInsertChar = csCmdLine %= applyEdit (Z.insertChar ch)
in if | (editorEmpty $ st^.csCmdLine) ||
((cursorAtChar ' ' (applyEdit Z.moveLeft $ st^.csCmdLine)) &&
(cursorIsAtEnd $ st^.csCmdLine)) ->
csCmdLine %= applyEdit (Z.insertMany (T.pack $ ch:ch:[]) >>> Z.moveLeft)
| (cursorAtChar ch $ st^.csCmdLine) &&
(cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csCmdLine) ->
csCmdLine %= applyEdit Z.moveRight
| otherwise -> doInsertChar
_ | editingPermitted st -> mhHandleEventLensed csCmdLine handleEditorEvent e
| otherwise -> return ()
csCurrentCompletion .= Nothing
editorEmpty :: Editor T.Text a -> Bool
editorEmpty e = cursorIsAtEnd e &&
cursorIsAtBeginning e
cursorIsAtEnd :: Editor T.Text a -> Bool
cursorIsAtEnd e =
let col = snd $ Z.cursorPosition z
curLine = Z.currentLine z
z = e^.editContentsL
in col == T.length curLine
cursorIsAtBeginning :: Editor T.Text a -> Bool
cursorIsAtBeginning e =
let col = snd $ Z.cursorPosition z
z = e^.editContentsL
in col == 0
cursorAtOneOf :: [Char] -> Editor T.Text a -> Maybe Char
cursorAtOneOf [] _ = Nothing
cursorAtOneOf (c:cs) e =
if cursorAtChar c e
then Just c
else cursorAtOneOf cs e
cursorAtChar :: Char -> Editor T.Text a -> Bool
cursorAtChar ch e =
let col = snd $ Z.cursorPosition z
curLine = Z.currentLine z
z = e^.editContentsL
in (T.singleton ch) `T.isPrefixOf` T.drop col curLine