{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
module WEditorBrick.WrappingEditor (
WrappingEditor,
WrappingEditorAction,
WrappingEditorDoer,
doEditor,
dumpEditor,
genericEditor,
handleEditor,
mapEditor,
newEditor,
renderEditor,
updateEditorExtent,
) where
import Brick.Main
import Brick.Types
import Brick.Widgets.Core
import Graphics.Vty.Input
import Lens.Micro
import WEditor.Base
import WEditor.Document
newEditor :: FixedFontParser p c => p -> n -> [[c]] -> WrappingEditor c n
newEditor b n cs = genericEditor n $ editDocument b $ map UnparsedPara cs
genericEditor :: (FixedFontViewer e c, FixedFontEditor e c) => n -> e -> WrappingEditor c n
genericEditor = WrappingEditor
type WrappingEditorAction c = forall e. (FixedFontViewer e c, FixedFontEditor e c) => e -> e
mapEditor :: WrappingEditorAction c -> WrappingEditor c n -> WrappingEditor c n
mapEditor f (WrappingEditor name editor) = WrappingEditor name (f editor)
type WrappingEditorDoer c b = forall e. (FixedFontViewer e c, FixedFontEditor e c) => e -> b
doEditor :: WrappingEditorDoer c b -> WrappingEditor c n -> b
doEditor f (WrappingEditor _ editor) = f editor
dumpEditor :: WrappingEditor c n -> [[c]]
dumpEditor = map upText . doEditor exportData
renderEditor :: (Ord n, Show n) => Bool -> WrappingEditor Char n -> Widget n
renderEditor focus editor = doEditor view editor where
view e = Widget Greedy Greedy $ do
ctx <- getContext
let width = ctx^.availWidthL
let height = ctx^.availHeightL
let e' = if height > 0
then viewerResizeAction (width,height) e
else e
render $ viewport (getName editor) Vertical $ setCursor e' $ textArea width height e' where
setCursor
| focus = showCursor (getName editor) . Location . getCursor
| otherwise = const id
textArea w h = vBox . lineFill w h . map (strFill w) . getVisible
strFill w cs = str $ take w $ cs ++ repeat ' '
lineFill w h ls = take h $ ls ++ repeat (strFill w "")
updateEditorExtent :: Eq n => WrappingEditor c n -> (EventM n (WrappingEditor c n))
updateEditorExtent editor = do
extent <- lookupExtent (getName editor)
return $ mapEditor (resize extent) editor where
resize (Just ext) | snd (extentSize ext) > 0 = viewerResizeAction (extentSize ext)
resize _ = id
handleEditor :: Eq n => WrappingEditor Char n -> Event -> EventM n (WrappingEditor Char n)
handleEditor editor event = do
extent <- lookupExtent (getName editor)
updateEditorExtent editor >>= return . mapEditor action where
action :: WrappingEditorAction Char
action =
case event of
EvKey KBS [] -> editorBackspaceAction
EvKey KDel [] -> editorDeleteAction
EvKey KDown [] -> editorDownAction
EvKey KEnd [] -> editorEndAction
EvKey KEnter [] -> editorEnterAction
EvKey KHome [] -> editorHomeAction
EvKey KLeft [] -> editorLeftAction
EvKey KPageDown [] -> editorPageDownAction
EvKey KPageUp [] -> editorPageUpAction
EvKey KRight [] -> editorRightAction
EvKey KUp [] -> editorUpAction
EvKey KDown [MMeta] -> viewerShiftDownAction 1
EvKey KUp [MMeta] -> viewerShiftUpAction 1
EvKey KHome [MMeta] -> viewerFillAction
EvKey (KChar c) [] | not (c `elem` "\t\r\n") -> editorAppendAction [c]
_ -> id
data WrappingEditor c n =
forall e. (FixedFontViewer e c, FixedFontEditor e c) => WrappingEditor {
weName :: n,
weEditor :: e
}
instance Show n => Show (WrappingEditor c n) where
show (WrappingEditor name editor) =
"WrappingEditor { name: " ++ show name ++
", size: " ++ show (getViewSize editor) ++
", cursor: " ++ show (getCursor editor) ++
", point: " ++ show (getEditPoint editor) ++ " }"
instance Named (WrappingEditor c n) n where
getName = weName