{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
module Brick.Widgets.Edit
( Editor(editContents, editorName)
, editor
, editorText
, getEditContents
, handleEditorEvent
, applyEdit
, editContentsL
, renderEditor
, editAttr
, editFocusedAttr
, 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
data Editor t n =
Editor { editContents :: Z.TextZipper t
, editorName :: n
}
suffixLenses ''Editor
instance (Show t, Show n) => Show (Editor t n) where
show e =
concat [ "Editor { "
, "editContents = " <> show (editContents e)
, ", editorName = " <> show (editorName e)
, "}"
]
instance Named (Editor t n) n where
getName = editorName
class DecodeUtf8 t where
decodeUtf8 :: BS.ByteString -> Either String t
instance DecodeUtf8 T.Text where
decodeUtf8 bs = case T.decodeUtf8' bs of
Left e -> Left $ show e
Right t -> Right t
instance DecodeUtf8 String where
decodeUtf8 bs = T.unpack <$> decodeUtf8 bs
handleEditorEvent :: (DecodeUtf8 t, Eq t, Monoid t) => Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent e ed =
let f = case e of
EvPaste bs -> case decodeUtf8 bs of
Left _ -> id
Right t -> Z.insertMany t
EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL
EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL
EvKey (KChar 'd') [MCtrl] -> Z.deleteChar
EvKey (KChar 'k') [MCtrl] -> Z.killToEOL
EvKey (KChar 'u') [MCtrl] -> Z.killToBOL
EvKey KEnter [] -> Z.breakLine
EvKey KDel [] -> Z.deleteChar
EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c
EvKey KUp [] -> Z.moveUp
EvKey KDown [] -> Z.moveDown
EvKey KLeft [] -> Z.moveLeft
EvKey KRight [] -> Z.moveRight
EvKey KBS [] -> Z.deletePrevChar
_ -> id
in return $ applyEdit f ed
editorText :: n
-> Maybe Int
-> T.Text
-> Editor T.Text n
editorText = editor
editor :: Z.GenericTextZipper a
=> n
-> Maybe Int
-> a
-> Editor a n
editor name limit s = Editor (Z.textZipper (Z.lines s) limit) name
applyEdit :: (Z.TextZipper t -> Z.TextZipper t)
-> Editor t n
-> Editor t n
applyEdit f e = e & editContentsL %~ f
editAttr :: AttrName
editAttr = "edit"
editFocusedAttr :: AttrName
editFocusedAttr = editAttr <> "focused"
getEditContents :: Monoid t => Editor t n -> [t]
getEditContents e = Z.getText $ e^.editContentsL
renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t)
=> ([t] -> Widget n)
-> Bool
-> Editor t n
-> Widget n
renderEditor draw foc e =
let cp = Z.cursorPosition z
z = e^.editContentsL
toLeft = Z.take (cp^._2) (Z.currentLine z)
cursorLoc = Location (textWidth toLeft, cp^._1)
limit = case e^.editContentsL.to Z.getLineLimit of
Nothing -> id
Just lim -> vLimit lim
atChar = charAtCursor $ e^.editContentsL
atCharWidth = maybe 1 textWidth atChar
in withAttr (if foc then editFocusedAttr else editAttr) $
limit $
viewport (e^.editorNameL) Both $
(if foc then showCursor (e^.editorNameL) cursorLoc else id) $
visibleRegion cursorLoc (atCharWidth, 1) $
draw $
getEditContents e
charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t
charAtCursor z =
let col = snd $ Z.cursorPosition z
curLine = Z.currentLine z
toRight = Z.drop col curLine
in if Z.length toRight > 0
then Just $ Z.take 1 toRight
else Nothing