{-# 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
  -- * 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 Brick.Types
import Brick.Widgets.Core
import Brick.AttrMap

-- | Editor state.  Editors support the following events by default:
--
-- * Ctrl-a: go to beginning of line
-- * Ctrl-e: go to end of line
-- * Ctrl-d, Del: delete character 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
-- * 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 { Editor t n -> TextZipper t
editContents :: Z.TextZipper t
           -- ^ The contents of the editor
           , 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 =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Editor { "
               , String
"editContents = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextZipper t -> String
forall a. Show a => a -> String
show (Editor t n -> TextZipper t
forall t n. Editor t n -> TextZipper t
editContents Editor t n
e)
               , String
", editorName = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show (Editor t n -> n
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 = Editor t n -> n
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 -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e
        Right Text
t -> Text -> Either String Text
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 (Text -> String) -> Either String Text -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Text
forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs

handleEditorEvent :: (DecodeUtf8 t, Eq t, Monoid t) => Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent :: Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent Event
e Editor t n
ed =
        let f :: TextZipper t -> TextZipper t
f = case Event
e of
                  EvPaste ByteString
bs -> case ByteString -> Either String t
forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs of
                      Left String
_ -> TextZipper t -> TextZipper t
forall a. a -> a
id
                      Right t
t -> t -> TextZipper t -> TextZipper t
forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany t
t
                  EvKey (KChar Char
'a') [Modifier
MCtrl] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
                  EvKey (KChar Char
'e') [Modifier
MCtrl] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
                  EvKey (KChar Char
'd') [Modifier
MCtrl] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
                  EvKey (KChar Char
'k') [Modifier
MCtrl] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToEOL
                  EvKey (KChar Char
'u') [Modifier
MCtrl] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToBOL
                  EvKey Key
KEnter [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.breakLine
                  EvKey Key
KDel [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
                  EvKey (KChar Char
c) [] | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t' -> Char -> TextZipper t -> TextZipper t
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
Z.insertChar Char
c
                  EvKey Key
KUp [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveUp
                  EvKey Key
KDown [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveDown
                  EvKey Key
KLeft [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft
                  EvKey Key
KRight [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
                  EvKey Key
KBS [] -> TextZipper t -> TextZipper t
forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar
                  EvKey Key
KHome [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
                  EvKey Key
KEnd [] -> TextZipper t -> TextZipper t
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
                  Event
_ -> TextZipper t -> TextZipper t
forall a. a -> a
id
        in Editor t n -> EventM n (Editor t n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor t n -> EventM n (Editor t n))
-> Editor t n -> EventM n (Editor t n)
forall a b. (a -> b) -> a -> b
$ (TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
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 :: n -> Maybe Int -> Text -> Editor Text n
editorText = n -> Maybe Int -> Text -> Editor Text n
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 :: n -> Maybe Int -> a -> Editor a n
editor n
name Maybe Int
limit a
s = TextZipper a -> n -> Editor a n
forall t n. TextZipper t -> n -> Editor t n
Editor ([a] -> Maybe Int -> TextZipper a
forall a. GenericTextZipper a => [a] -> Maybe Int -> TextZipper a
Z.textZipper (a -> [a]
forall a. GenericTextZipper a => a -> [a]
Z.lines a
s) Maybe Int
limit) n
name

-- | Apply an editing operation to the editor's contents. Bear in mind
-- that you should only apply zipper operations that operate on the
-- current line; the editor will only ever render the first line of
-- text.
applyEdit :: (Z.TextZipper t -> Z.TextZipper t)
          -- ^ The 'Data.Text.Zipper' editing transformation to apply
          -> Editor t n
          -> Editor t n
applyEdit :: (TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper t -> TextZipper t
f Editor t n
e = Editor t n
e Editor t n -> (Editor t n -> Editor t n) -> Editor t n
forall a b. a -> (a -> b) -> b
& (TextZipper t -> Identity (TextZipper t))
-> Editor t n -> Identity (Editor t n)
forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL ((TextZipper t -> Identity (TextZipper t))
 -> Editor t n -> Identity (Editor t n))
-> (TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
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 = AttrName
"edit"

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

-- | Get the contents of the editor.
getEditContents :: Monoid t => Editor t n -> [t]
getEditContents :: Editor t n -> [t]
getEditContents Editor t n
e = TextZipper t -> [t]
forall a. Monoid a => TextZipper a -> [a]
Z.getText (TextZipper t -> [t]) -> TextZipper t -> [t]
forall a b. (a -> b) -> a -> b
$ Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
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 :: ([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 = TextZipper t -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper t
z
        z :: TextZipper t
z = Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL
        toLeft :: t
toLeft = Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.take ((Int, Int)
cp(Int, Int) -> Getting Int (Int, Int) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Int, Int) Int
forall s t a b. Field2 s t a b => Lens s t a b
_2) (TextZipper t -> t
forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z)
        cursorLoc :: Location
cursorLoc = (Int, Int) -> Location
Location (t -> Int
forall a. TextWidth a => a -> Int
textWidth t
toLeft, (Int, Int)
cp(Int, Int) -> Getting Int (Int, Int) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Int, Int) Int
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
eEditor t n
-> Getting (Maybe Int) (Editor t n) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(TextZipper t -> Const (Maybe Int) (TextZipper t))
-> Editor t n -> Const (Maybe Int) (Editor t n)
forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL((TextZipper t -> Const (Maybe Int) (TextZipper t))
 -> Editor t n -> Const (Maybe Int) (Editor t n))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> TextZipper t -> Const (Maybe Int) (TextZipper t))
-> Getting (Maybe Int) (Editor t n) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper t -> Maybe Int)
-> SimpleGetter (TextZipper t) (Maybe Int)
forall s a. (s -> a) -> SimpleGetter s a
to TextZipper t -> Maybe Int
forall a. TextZipper a -> Maybe Int
Z.getLineLimit of
            Maybe Int
Nothing -> Widget n -> Widget n
forall a. a -> a
id
            Just Int
lim -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
lim
        atChar :: Maybe t
atChar = TextZipper t -> Maybe t
forall t. GenericTextZipper t => TextZipper t -> Maybe t
charAtCursor (TextZipper t -> Maybe t) -> TextZipper t -> Maybe t
forall a b. (a -> b) -> a -> b
$ Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t.
Lens (Editor t n) (Editor t n) (TextZipper t) (TextZipper t)
editContentsL
        atCharWidth :: Int
atCharWidth = Int -> (t -> Int) -> Maybe t -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 t -> Int
forall a. TextWidth a => a -> Int
textWidth Maybe t
atChar
    in AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (if Bool
foc then AttrName
editFocusedAttr else AttrName
editAttr) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       Widget n -> Widget n
forall n. Widget n -> Widget n
limit (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (Editor t n
eEditor t n -> Getting n (Editor t n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (Editor t n) n
forall t n n. Lens (Editor t n) (Editor t n) n n
editorNameL) ViewportType
Both (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       (if Bool
foc then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor (Editor t n
eEditor t n -> Getting n (Editor t n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (Editor t n) n
forall t n n. Lens (Editor t n) (Editor t n) n n
editorNameL) Location
cursorLoc else Widget n -> Widget n
forall a. a -> a
id) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       Location -> (Int, Int) -> Widget n -> Widget n
forall n. Location -> (Int, Int) -> Widget n -> Widget n
visibleRegion Location
cursorLoc (Int
atCharWidth, Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       [t] -> Widget n
draw ([t] -> Widget n) -> [t] -> Widget n
forall a b. (a -> b) -> a -> b
$
       Editor t n -> [t]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor t n
e

charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t
charAtCursor :: TextZipper t -> Maybe t
charAtCursor TextZipper t
z =
    let col :: Int
col = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ TextZipper t -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper t
z
        curLine :: t
curLine = TextZipper t -> t
forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z
        toRight :: t
toRight = Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.drop Int
col t
curLine
    in if t -> Int
forall a. GenericTextZipper a => a -> Int
Z.length t
toRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       then t -> Maybe t
forall a. a -> Maybe a
Just (t -> Maybe t) -> t -> Maybe t
forall a b. (a -> b) -> a -> b
$ Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.take Int
1 t
toRight
       else Maybe t
forall a. Maybe a
Nothing