Event.hs

{- HLINT ignore "Use tuple-section" -}
module Editor.Event where

import Brick hiding (on)
import Brick.Keybindings
import Editor.Core
import Editor.Cursor
import Editor.Diagnostic (diagnoseEvent)
import Editor.Eval
import Editor.File
import Editor.Insertion
import Editor.Keymap (EditorAction (..))
import Editor.Line
import Editor.Popup
import Editor.Selection
import Editor.Undo
import Editor.Util
import qualified Graphics.Vty as V
import Keymap (kEditor)
import Lens.Micro
import Lens.Micro.Extras (view)
import UI.Core hiding (Copy)

editorToAppEvent :: Name -> EditorState -> BrickEvent Name AppEvent -> EventM Name AppState EditorState
editorToAppEvent name es ev = do
  env <- gets asEnvironment
  chan <- gets asChan
  vtyOut <- gets asVtyOutput
  kc <- gets asKeyConfig
  (EditorEventEnv _ _ _ _ env' es') <- nestEventM' (EditorEventEnv chan name kc vtyOut env es) (handleEditorEvent ev)
  modify (\as -> as {asEnvironment = env'})
  return es'

handleEditorEvent :: BrickEvent Name AppEvent -> EventM Name EditorEventEnv ()
handleEditorEvent (VtyEvent (V.EvKey key mods)) = do
  withEditorEvent clearPopup
  handleEditorKeyEvent key mods
  diagnoseEvent
handleEditorEvent (MouseDown (EditorViewport i) V.BScrollUp _ _) = vScrollBy (viewportScroll (EditorViewport i)) (-1)
handleEditorEvent (MouseDown (Editor i) V.BScrollUp _ _) = vScrollBy (viewportScroll (EditorViewport i)) (-1)
handleEditorEvent (MouseDown (EditorViewport i) V.BScrollDown _ _) = vScrollBy (viewportScroll (EditorViewport i)) 1
handleEditorEvent (MouseDown (Editor i) V.BScrollDown _ _) = vScrollBy (viewportScroll (EditorViewport i)) 1
handleEditorEvent (VtyEvent (V.EvPaste x)) = diagnoseEvent >> withEditorEvent (pasteContent x)
handleEditorEvent (AppEvent ClearFlash) = withEditorEvent clearFlashBlock
handleEditorEvent (AppEvent (FileSelected Nothing)) = return ()
handleEditorEvent (AppEvent (FileSelected (Just path))) = loadEvent path
handleEditorEvent _ = return ()

handleEditorKeyEvent :: V.Key -> [V.Modifier] -> EventM Name EditorEventEnv ()
handleEditorKeyEvent key mods = do
  kc <- gets (view envKeyConfig)
  handled <- handleKey (editorKeyDispatcher $ kEditor kc) key mods
  if handled
    then return ()
    else case (key, mods) of
      (V.KChar c, []) -> modify $ envEditorState %~ insertChar c . clearMessage
      _ -> return ()

withEditorEvent :: (EditorState -> EditorState) -> EventM Name EditorEventEnv ()
withEditorEvent f = modify $ envEditorState %~ f

editorKeyEventHandler :: [KeyEventHandler EditorAction (EventM Name EditorEventEnv)]
editorKeyEventHandler =
  [ onEvent Save "save file" saveEvent,
    onEvent Eval "evaluate block" evalEvent,
    onEvent Open "open file" openEvent,
    onEvent Copy "copy selection" copyEvent,
    onEvent Hint "show hint popup" hintEvent,
    onEvent ExitHint "close hint popup" (withEditorEvent clearPopup),
    onEvent Undo "undo" (withEditorEvent undo),
    onEvent Redo "redo" (withEditorEvent redo),
    onEvent CommentLine "toggle comment" (withEditorEvent $ toggleCommentCurrentLine "--"),
    onEvent SwapLineUp "swap line up" (withEditorEvent swapLineUp),
    onEvent SwapLineDown "swap line down" (withEditorEvent swapLineDown),
    onEvent DuplicateLine "duplicate line" (withEditorEvent duplicateCurrentLine),
    onEvent DeleteLine "delete line" (withEditorEvent deleteCurrentLine),
    onEvent DeleteChar "delete character" (withEditorEvent deleteCharForward),
    onEvent DeleteCharBack "delete character" (withEditorEvent deleteCharBack),
    onEvent SelectAll "select all" (withEditorEvent selectAll),
    onEvent MoveUp "move cursor up" (withEditorEvent moveCursorUp),
    onEvent MoveDown "move cursor down" (withEditorEvent moveCursorDown),
    onEvent MoveLeft "move cursor left" (withEditorEvent moveCursorLeft),
    onEvent MoveRight "move cursor right" (withEditorEvent moveCursorRight),
    onEvent MoveLineStart "move cursor line start" (withEditorEvent moveCursorLineStart),
    onEvent MoveLineEnd "move cursor line end" (withEditorEvent moveCursorLineEnd),
    onEvent MoveFileStart "move cursor file start" (withEditorEvent moveCursorFileStart),
    onEvent MoveFileEnd "move cursor file end" (withEditorEvent moveCursorFileEnd),
    onEvent MoveWordLeft "move cursor word left" (withEditorEvent moveCursorWordLeft),
    onEvent MoveWordRight "move cursor word left" (withEditorEvent moveCursorWordRight),
    onEvent NewLine "new line" (withEditorEvent insertNewline),
    onEvent ExtendSelectionUp "extend selection up" (withEditorEvent extendSelectionUp),
    onEvent ExtendSelectionDown "extend selection down" (withEditorEvent extendSelectionDown),
    onEvent ExtendSelectionLeft "extend selection left" (withEditorEvent extendSelectionLeft),
    onEvent ExtendSelectionRight "extend selection right" (withEditorEvent extendSelectionRight)
  ]

editorKeyDispatcher :: KeyConfig EditorAction -> KeyDispatcher EditorAction (EventM Name EditorEventEnv)
editorKeyDispatcher conf = case keyDispatcher conf editorKeyEventHandler of
  Left kb -> error $ "conflicting keybindings: " <> show (map fst kb)
  Right dis -> dis