{-# LANGUAGE TemplateHaskell, CPP #-}

-- | Widget like "Brick.Widgets.Edit", but with more emacs style keybindings.
--
-- This is also a complete wrapper around the "Brick.Widgets.Edit" API to retain
-- compatability with older brick versions.
--
-- See 'handleEditorEvent' for a list of added keybindings.
module Brick.Widgets.Edit.EmacsBindings
  ( Editor
  , editorText
  , getEditContents
  , applyEdit
  , editContentsL
  , handleEditorEvent
  , renderEditor
  ) where

import           Brick
import           Graphics.Vty
import qualified Brick.Widgets.Edit as E
import           Data.Text.Zipper
import           Data.Text (Text)
import           Lens.Micro.TH
import           Lens.Micro

import           Data.Text.Zipper.Generic.Words

-- | Wrapper around 'E.Editor', but specialized to 'Text'
data Editor n = Editor {
  Editor n -> Editor Text n
_origEditor :: E.Editor Text n,
  Editor n -> [Text] -> Widget n
_drawingFunction :: [Text] -> Widget n
}

makeLenses ''Editor

-- | Wrapper for 'E.editorText' specialized to 'Text'
editorText :: n -> ([Text] -> Widget n)-> Maybe Int -> Text -> Editor n
editorText :: n -> ([Text] -> Widget n) -> Maybe Int -> Text -> Editor n
editorText n
name [Text] -> Widget n
draw Maybe Int
linum Text
content =
#if MIN_VERSION_brick(0,19,0)
  Editor Text n -> ([Text] -> Widget n) -> Editor n
forall n. Editor Text n -> ([Text] -> Widget n) -> Editor n
Editor (n -> Maybe Int -> Text -> Editor Text n
forall n. n -> Maybe Int -> Text -> Editor Text n
E.editorText n
name Maybe Int
linum Text
content) [Text] -> Widget n
draw
#else
  Editor (E.editorText name draw linum content) draw
#endif

-- | Wrapper for 'E.getEditContents' specialized to 'Text'
getEditContents :: Editor n -> [Text]
getEditContents :: Editor n -> [Text]
getEditContents Editor n
edit = Editor n
edit Editor n -> Getting [Text] (Editor n) [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. (Editor Text n -> Const [Text] (Editor Text n))
-> Editor n -> Const [Text] (Editor n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor ((Editor Text n -> Const [Text] (Editor Text n))
 -> Editor n -> Const [Text] (Editor n))
-> (([Text] -> Const [Text] [Text])
    -> Editor Text n -> Const [Text] (Editor Text n))
-> Getting [Text] (Editor n) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text n -> [Text]) -> SimpleGetter (Editor Text n) [Text]
forall s a. (s -> a) -> SimpleGetter s a
to Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
E.getEditContents

-- | Wrapper for 'E.applyEdit' specialized to 'Text'
applyEdit :: (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit :: (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
f = ASetter (Editor n) (Editor n) (Editor Text n) (Editor Text n)
-> (Editor Text n -> Editor Text n) -> Editor n -> Editor n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Editor n) (Editor n) (Editor Text n) (Editor Text n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor ((TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
E.applyEdit TextZipper Text -> TextZipper Text
f)

-- | Wrapper for 'E.editContentsL' specialized to 'Text'
editContentsL :: Lens (Editor n) (Editor n) (TextZipper Text) (TextZipper Text)
editContentsL :: (TextZipper Text -> f (TextZipper Text))
-> Editor n -> f (Editor n)
editContentsL = (Editor Text n -> f (Editor Text n)) -> Editor n -> f (Editor n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor ((Editor Text n -> f (Editor Text n)) -> Editor n -> f (Editor n))
-> ((TextZipper Text -> f (TextZipper Text))
    -> Editor Text n -> f (Editor Text n))
-> (TextZipper Text -> f (TextZipper Text))
-> Editor n
-> f (Editor n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextZipper Text -> f (TextZipper Text))
-> Editor Text n -> f (Editor Text n)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
E.editContentsL

-- | Same as 'E.handleEditorEvent', but with more emacs-style keybindings and
-- specialized to 'Text'
--
-- Specifically:
--
--  - Ctrl-f: Move forward one character
--  - Ctrl-b: Move backward one character
--  - Alt-f: Move forward one word
--  - Alt-b: Move backward one word
--  - Alt-Backspace: Delete the previous word
--  - Ctrl-w: Delete the previous word
--  - Alt-d: Delete the next word
handleEditorEvent :: Event -> Editor n -> EventM n (Editor n)
handleEditorEvent :: Event -> Editor n -> EventM n (Editor n)
handleEditorEvent Event
event Editor n
edit = case Event
event of
  EvKey (KChar Char
'f') [Modifier
MCtrl] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
moveRight Editor n
edit
  EvKey (KChar Char
'b') [Modifier
MCtrl] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
moveLeft Editor n
edit

  EvKey (KChar Char
'f') [Modifier
MMeta] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
moveWordRight Editor n
edit
  EvKey (KChar Char
'b') [Modifier
MMeta] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
moveWordLeft Editor n
edit

  EvKey Key
KBS         [Modifier
MMeta] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
deletePrevWord Editor n
edit
  EvKey (KChar Char
'w') [Modifier
MCtrl] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
deletePrevWord Editor n
edit
  EvKey (KChar Char
'd') [Modifier
MMeta] -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
deleteWord Editor n
edit

  EvKey Key
KHome       []      -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
gotoBOL Editor n
edit
  EvKey Key
KEnd        []      -> Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL Editor n
edit

  Event
_ -> do
    Editor Text n
newOrig <- Event -> Editor Text n -> EventM n (Editor Text n)
forall t n.
(DecodeUtf8 t, Eq t, GenericTextZipper t) =>
Event -> Editor t n -> EventM n (Editor t n)
E.handleEditorEvent Event
event (Editor n
editEditor n
-> Getting (Editor Text n) (Editor n) (Editor Text n)
-> Editor Text n
forall s a. s -> Getting a s a -> a
^.Getting (Editor Text n) (Editor n) (Editor Text n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor)
    Editor n -> EventM n (Editor n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor n -> EventM n (Editor n))
-> Editor n -> EventM n (Editor n)
forall a b. (a -> b) -> a -> b
$ Editor n
edit Editor n -> (Editor n -> Editor n) -> Editor n
forall a b. a -> (a -> b) -> b
& (Editor Text n -> Identity (Editor Text n))
-> Editor n -> Identity (Editor n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor ((Editor Text n -> Identity (Editor Text n))
 -> Editor n -> Identity (Editor n))
-> Editor Text n -> Editor n -> Editor n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Editor Text n
newOrig


-- | Wrapper for 'E.renderEditor' specialized to 'Text'
renderEditor :: (Ord n, Show n) => Bool -> Editor n -> Widget n
renderEditor :: Bool -> Editor n -> Widget n
renderEditor Bool
focus Editor n
edit =
#if MIN_VERSION_brick(0,19,0)
  ([Text] -> Widget n) -> Bool -> Editor Text n -> Widget n
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
E.renderEditor (Editor n
editEditor n
-> Getting ([Text] -> Widget n) (Editor n) ([Text] -> Widget n)
-> [Text]
-> Widget n
forall s a. s -> Getting a s a -> a
^.Getting ([Text] -> Widget n) (Editor n) ([Text] -> Widget n)
forall n. Lens' (Editor n) ([Text] -> Widget n)
drawingFunction) Bool
focus (Editor n
editEditor n
-> Getting (Editor Text n) (Editor n) (Editor Text n)
-> Editor Text n
forall s a. s -> Getting a s a -> a
^.Getting (Editor Text n) (Editor n) (Editor Text n)
forall n. Lens' (Editor n) (Editor Text n)
origEditor)
#else
  E.renderEditor focus (edit^.origEditor)
#endif