{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
-- | This module provides a basic text editor widget. You'll need to
-- embed an 'Editor' in your application state and transform it with
-- 'handleEditorEvent' when relevant events arrive. To get the contents
-- of the editor, just use 'getEditContents'. To modify it, use the
-- 'Z.TextZipper' interface with 'applyEdit'.
--
-- The editor's 'handleEditorEvent' function handles a set of basic
-- input events that should suffice for most purposes; see the source
-- for a complete list.
--
-- Bear in mind that the editor provided by this module is intended to
-- provide basic input support for brick applications but it is not
-- intended to be a replacement for your favorite editor such as Vim or
-- Emacs. It is also not suitable for building sophisticated editors. If
-- you want to build your own editor, I suggest starting from scratch.
module Brick.Widgets.Edit
  ( Editor(editContents, editorName)
  -- * Constructing an editor
  , editor
  , editorText
  -- * Reading editor contents
  , getEditContents
  , getCursorPosition
  -- * Handling events
  , handleEditorEvent
  -- * Editing text
  , applyEdit
  -- * Lenses for working with editors
  , editContentsL
  -- * Rendering editors
  , renderEditor
  -- * Attributes
  , editAttr
  , editFocusedAttr
  -- * UTF-8 decoding of editor pastes
  , DecodeUtf8(..)
  )
where

#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Lens.Micro
import Graphics.Vty (Event(..), Key(..), Modifier(..))

import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Zipper as Z hiding ( textZipper )
import qualified Data.Text.Zipper.Generic as Z
import qualified Data.Text.Zipper.Generic.Words as Z
import Data.Tuple (swap)

import Brick.Types
import Brick.Widgets.Core
import Brick.AttrMap

-- | Editor state.  Editors support the following events by default:
--
-- * Mouse clicks: change cursor position
-- * Meta-<: go to beginning of file
-- * Meta->: go to end of file
-- * Ctrl-a, Home: go to beginning of line
-- * Ctrl-e, End: go to end of line
-- * Ctrl-d, Del: delete character at cursor position
-- * Meta-d: delete word at cursor position
-- * Backspace: delete character prior to cursor position
-- * Ctrl-k: delete all from cursor to end of line
-- * Ctrl-u: delete all from cursor to beginning of line
-- * Ctrl-t: transpose character before cursor with the one at cursor position
-- * Meta-b: move one word to the left
-- * Ctrl-b: move one character to the left
-- * Meta-f: move one word to the right
-- * Ctrl-f: move one character to the right
-- * Arrow keys: move cursor
-- * Enter: break the current line at the cursor position
-- * Paste: Bracketed Pastes from the terminal will be pasted, provided
--   the incoming data is UTF-8-encoded.
data Editor t n =
    Editor { forall t n. Editor t n -> TextZipper t
editContents :: Z.TextZipper t
           -- ^ The contents of the editor
           , forall t n. Editor t n -> n
editorName :: n
           -- ^ The name of the editor
           }

suffixLenses ''Editor

instance (Show t, Show n) => Show (Editor t n) where
    show :: Editor t n -> String
show Editor t n
e =
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Editor { "
               , String
"editContents = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall t n. Editor t n -> TextZipper t
editContents Editor t n
e)
               , String
", editorName = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall t n. Editor t n -> n
editorName Editor t n
e)
               , String
"}"
               ]

instance Named (Editor t n) n where
    getName :: Editor t n -> n
getName = forall t n. Editor t n -> n
editorName

-- | Values that can be constructed by decoding bytestrings in UTF-8
-- encoding.
class DecodeUtf8 t where
    -- | Decode a bytestring assumed to be text in UTF-8 encoding. If
    -- the decoding fails, return 'Left'. This must not raise
    -- exceptions.
    decodeUtf8 :: BS.ByteString -> Either String t

instance DecodeUtf8 T.Text where
    decodeUtf8 :: ByteString -> Either String Text
decodeUtf8 ByteString
bs = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
        Left UnicodeException
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UnicodeException
e
        Right Text
t -> forall a b. b -> Either a b
Right Text
t

instance DecodeUtf8 String where
    decodeUtf8 :: ByteString -> Either String String
decodeUtf8 ByteString
bs = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs

handleEditorEvent :: (Eq n, DecodeUtf8 t, Eq t, Z.GenericTextZipper t)
                  => BrickEvent n e
                  -> EventM n (Editor t n) ()
handleEditorEvent :: forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent n e
e = do
    Editor t n
ed <- forall s (m :: * -> *). MonadState s m => m s
get
    let f :: TextZipper t -> TextZipper t
f = case BrickEvent n e
e of
              VtyEvent Event
ev ->
                  forall {a}.
(DecodeUtf8 a, GenericTextZipper a, Eq a) =>
Event -> TextZipper a -> TextZipper a
handleVtyEvent Event
ev
              MouseDown n
n Button
_ [Modifier]
_ (Location (Int, Int)
pos) | n
n forall a. Eq a => a -> a -> Bool
== forall a n. Named a n => a -> n
getName Editor t n
ed ->
                  forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursorClosest (forall a b. (a, b) -> (b, a)
swap (Int, Int)
pos)
              BrickEvent n e
_ -> forall a. a -> a
id
        handleVtyEvent :: Event -> TextZipper a -> TextZipper a
handleVtyEvent Event
ev = case Event
ev of
            EvPaste ByteString
bs -> case forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs of
                Left String
_ -> forall a. a -> a
id
                Right a
t -> forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany a
t
            EvKey (KChar Char
'a') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
            EvKey (KChar Char
'e') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
            EvKey (KChar Char
'd') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
            EvKey (KChar Char
'd') [Modifier
MMeta] -> forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.deleteWord
            EvKey (KChar Char
'k') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToEOL
            EvKey (KChar Char
'u') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToBOL
            EvKey Key
KEnter [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.breakLine
            EvKey Key
KDel [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
            EvKey (KChar Char
c) [] | Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\t' -> forall a. Monoid a => Char -> TextZipper a -> TextZipper a
Z.insertChar Char
c
            EvKey Key
KUp [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveUp
            EvKey Key
KDown [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveDown
            EvKey Key
KLeft [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft
            EvKey Key
KRight [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
            EvKey (KChar Char
'b') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft
            EvKey (KChar Char
'f') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
            EvKey (KChar Char
'b') [Modifier
MMeta] -> forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordLeft
            EvKey (KChar Char
'f') [Modifier
MMeta] -> forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordRight
            EvKey Key
KBS [] -> forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar
            EvKey (KChar Char
't') [Modifier
MCtrl] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.transposeChars
            EvKey Key
KHome [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
            EvKey Key
KEnd [] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
            EvKey (KChar Char
'<') [Modifier
MMeta] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOF
            EvKey (KChar Char
'>') [Modifier
MMeta] -> forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOF
            Event
_ -> forall a. a -> a
id
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper t -> TextZipper t
f Editor t n
ed

-- | Construct an editor over 'Text' values
editorText :: n
           -- ^ The editor's name (must be unique)
           -> Maybe Int
           -- ^ The limit on the number of lines in the editor ('Nothing'
           -- means no limit)
           -> T.Text
           -- ^ The initial content
           -> Editor T.Text n
editorText :: forall n. n -> Maybe Int -> Text -> Editor Text n
editorText = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor

-- | Construct an editor over 'String' values
editor :: Z.GenericTextZipper a
       => n
       -- ^ The editor's name (must be unique)
       -> Maybe Int
       -- ^ The limit on the number of lines in the editor ('Nothing'
       -- means no limit)
       -> a
       -- ^ The initial content
       -> Editor a n
editor :: forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor n
name Maybe Int
limit a
s = forall t n. TextZipper t -> n -> Editor t n
Editor (forall a. GenericTextZipper a => [a] -> Maybe Int -> TextZipper a
Z.textZipper (forall a. GenericTextZipper a => a -> [a]
Z.lines a
s) Maybe Int
limit) n
name

-- | Apply an editing operation to the editor's contents.
--
-- This is subject to the restrictions of the underlying text zipper;
-- for example, if the underlying zipper has a line limit configured,
-- any edits applied here will be ignored if they edit text outside
-- the line limit.
applyEdit :: (Z.TextZipper t -> Z.TextZipper t)
          -- ^ The 'Z.TextZipper' editing transformation to apply
          -> Editor t n
          -> Editor t n
applyEdit :: forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper t -> TextZipper t
f Editor t n
e = Editor t n
e forall a b. a -> (a -> b) -> b
& forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextZipper t -> TextZipper t
f

-- | The attribute assigned to the editor when it does not have focus.
editAttr :: AttrName
editAttr :: AttrName
editAttr = String -> AttrName
attrName String
"edit"

-- | The attribute assigned to the editor when it has focus. Extends
-- 'editAttr'.
editFocusedAttr :: AttrName
editFocusedAttr :: AttrName
editFocusedAttr = AttrName
editAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"focused"

-- | Get the contents of the editor.
getEditContents :: Monoid t => Editor t n -> [t]
getEditContents :: forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor t n
e = forall a. Monoid a => TextZipper a -> [a]
Z.getText forall a b. (a -> b) -> a -> b
$ Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL

-- | Get the cursor position of the editor (row, column).
getCursorPosition :: Editor t n -> (Int, Int)
getCursorPosition :: forall t n. Editor t n -> (Int, Int)
getCursorPosition Editor t n
e = forall a. TextZipper a -> (Int, Int)
Z.cursorPosition forall a b. (a -> b) -> a -> b
$ Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL

-- | Turn an editor state value into a widget. This uses the editor's
-- name for its scrollable viewport handle and the name is also used to
-- report mouse events.
renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t)
             => ([t] -> Widget n)
             -- ^ The content drawing function
             -> Bool
             -- ^ Whether the editor has focus. It will report a cursor
             -- position if and only if it has focus.
             -> Editor t n
             -- ^ The editor.
             -> Widget n
renderEditor :: forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor [t] -> Widget n
draw Bool
foc Editor t n
e =
    let cp :: (Int, Int)
cp = forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper t
z
        z :: TextZipper t
z = Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL
        toLeft :: t
toLeft = forall a. GenericTextZipper a => Int -> a -> a
Z.take ((Int, Int)
cpforall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2) (forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z)
        cursorLoc :: Location
cursorLoc = (Int, Int) -> Location
Location (forall a. TextWidth a => a -> Int
textWidth t
toLeft, (Int, Int)
cpforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1)
        limit :: Widget n -> Widget n
limit = case Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall a. TextZipper a -> Maybe Int
Z.getLineLimit of
            Maybe Int
Nothing -> forall a. a -> a
id
            Just Int
lim -> forall n. Int -> Widget n -> Widget n
vLimit Int
lim
        atChar :: Maybe t
atChar = forall t. GenericTextZipper t => TextZipper t -> Maybe t
charAtCursor forall a b. (a -> b) -> a -> b
$ Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL
        atCharWidth :: Int
atCharWidth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 forall a. TextWidth a => a -> Int
textWidth Maybe t
atChar
    in forall n. AttrName -> Widget n -> Widget n
withAttr (if Bool
foc then AttrName
editFocusedAttr else AttrName
editAttr) forall a b. (a -> b) -> a -> b
$
       forall {n}. Widget n -> Widget n
limit forall a b. (a -> b) -> a -> b
$
       forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n n. Lens (Editor t n) (Editor t n) n n
editorNameL) ViewportType
Both forall a b. (a -> b) -> a -> b
$
       (if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
showCursor (Editor t n
eforall s a. s -> Getting a s a -> a
^.forall t n n. Lens (Editor t n) (Editor t n) n n
editorNameL) Location
cursorLoc else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
       forall n. Location -> (Int, Int) -> Widget n -> Widget n
visibleRegion Location
cursorLoc (Int
atCharWidth, Int
1) forall a b. (a -> b) -> a -> b
$
       [t] -> Widget n
draw forall a b. (a -> b) -> a -> b
$
       forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor t n
e

charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t
charAtCursor :: forall t. GenericTextZipper t => TextZipper t -> Maybe t
charAtCursor TextZipper t
z =
    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 t
z
        curLine :: t
curLine = forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z
        toRight :: t
toRight = forall a. GenericTextZipper a => Int -> a -> a
Z.drop Int
col t
curLine
    in if forall a. GenericTextZipper a => a -> Int
Z.length t
toRight forall a. Ord a => a -> a -> Bool
> Int
0
       then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. GenericTextZipper a => Int -> a -> a
Z.take Int
1 t
toRight
       else forall a. Maybe a
Nothing