Keymap.hs

module Editor.Keymap where

import Brick.Keybindings
import Data.List (groupBy)
import qualified Graphics.Vty as V

data EditorAction
  = Save
  | Open
  | Undo
  | Redo
  | Copy
  | Hint
  | ExitHint
  | Eval
  | CommentLine
  | SwapLineUp
  | SwapLineDown
  | DuplicateLine
  | DeleteLine
  | SelectAll
  | NewLine
  | DeleteChar
  | DeleteCharBack
  | MoveUp
  | MoveDown
  | MoveLeft
  | MoveRight
  | MoveLineStart
  | MoveLineEnd
  | MoveFileStart
  | MoveFileEnd
  | MoveWordLeft
  | MoveWordRight
  | ExtendSelectionUp
  | ExtendSelectionDown
  | ExtendSelectionLeft
  | ExtendSelectionRight
  deriving (Show, Eq, Ord)

defaultEditorBindings :: [(EditorAction, [Binding])]
defaultEditorBindings =
  [ (Save, [ctrl 's']),
    (Open, [ctrl 'o']),
    (Copy, [ctrl 'c']),
    (Hint, [ctrl '@']),
    (ExitHint, [bind V.KEsc]),
    (Eval, [ctrl V.KEnter, meta V.KEnter]),
    (Undo, [ctrl 'z']),
    (Redo, [ctrl 'y']),
    (CommentLine, [ctrl '/', ctrl '_']),
    (SwapLineUp, [meta V.KUp]),
    (SwapLineDown, [meta V.KDown]),
    (DuplicateLine, [ctrl 'd']),
    (DeleteLine, [ctrl 'k']),
    (MoveUp, [bind V.KUp]),
    (MoveDown, [bind V.KDown]),
    (MoveLeft, [bind V.KLeft]),
    (MoveRight, [bind V.KRight]),
    (MoveLineStart, [bind V.KHome]),
    (MoveLineEnd, [bind V.KEnd]),
    (NewLine, [bind V.KEnter]),
    (DeleteChar, [bind V.KDel]),
    (DeleteCharBack, [bind V.KBS]),
    (MoveFileStart, [ctrl V.KHome]),
    (MoveFileEnd, [ctrl V.KEnd]),
    (MoveWordLeft, [ctrl V.KLeft]),
    (MoveWordRight, [ctrl V.KRight]),
    (ExtendSelectionUp, [shift V.KUp]),
    (ExtendSelectionDown, [shift V.KDown]),
    (ExtendSelectionLeft, [shift V.KLeft]),
    (ExtendSelectionRight, [shift V.KRight]),
    (SelectAll, [ctrl 'a'])
  ]

editorKeyEvents :: KeyEvents EditorAction
editorKeyEvents =
  keyEvents
    [ ("save", Save),
      ("open", Open),
      ("undo", Undo),
      ("redo", Redo),
      ("copy", Copy),
      ("hint", Hint),
      ("exithint", ExitHint),
      ("eval", Eval),
      ("comment", CommentLine),
      ("swapup", SwapLineUp),
      ("swapdown", SwapLineDown),
      ("duplicate", DuplicateLine),
      ("deleteline", DeleteLine),
      ("selectall", SelectAll),
      ("newline", NewLine),
      ("delete", DeleteChar),
      ("deleteback", DeleteCharBack),
      ("up", MoveUp),
      ("down", MoveDown),
      ("left", MoveLeft),
      ("right", MoveRight),
      ("linestart", MoveLineStart),
      ("lineend", MoveLineEnd),
      ("fileend", MoveFileEnd),
      ("filestart", MoveFileStart),
      ("wordleft", MoveWordLeft),
      ("wordright", MoveWordRight),
      ("extendup", ExtendSelectionUp),
      ("extenddown", ExtendSelectionDown),
      ("extendleft", ExtendSelectionLeft),
      ("extendright", ExtendSelectionRight)
    ]

editorKeyConfigWithUserConfig :: [(Binding, EditorAction)] -> KeyConfig EditorAction
editorKeyConfigWithUserConfig conf = newKeyConfig editorKeyEvents defaultEditorBindings conf'
  where
    conf' = map toBinding $ groupBy (\(_, a1) (_, a2) -> a1 == a2) conf
    toBinding [] = error "Error in toBinding"
    toBinding ((b, a) : bs) = (a, BindingList $ b : map fst bs)