{-|
Module: Reflex.Vty.Widget.Input.Text
Description: Widgets for accepting text input from users and manipulating text within those inputs
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Reflex.Vty.Widget.Input.Text
  ( module Reflex.Vty.Widget.Input.Text
  , def
  ) where

import Control.Monad (join)
import Control.Monad.Fix (MonadFix)
import Control.Monad.NodeId (MonadNodeId)
import Data.Default (Default(..))
import Data.Text (Text)
import Data.Text.Zipper
import qualified Graphics.Vty as V
import Reflex

import Reflex.Vty.Widget
import Reflex.Vty.Widget.Layout

-- | Configuration options for a 'textInput'. For more information on
-- 'TextZipper', see 'Data.Text.Zipper'.
data TextInputConfig t = TextInputConfig
  { TextInputConfig t -> TextZipper
_textInputConfig_initialValue :: TextZipper
  , TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify :: Event t (TextZipper -> TextZipper)
  , TextInputConfig t -> Int
_textInputConfig_tabWidth :: Int
  , TextInputConfig t -> Dynamic t (Char -> Char)
_textInputConfig_display :: Dynamic t (Char -> Char)
  -- ^ Transform the characters in a text input before displaying them. This is useful, e.g., for
  -- masking characters when entering passwords.
  }

instance Reflex t => Default (TextInputConfig t) where
  def :: TextInputConfig t
def = TextZipper
-> Event t (TextZipper -> TextZipper)
-> Int
-> Dynamic t (Char -> Char)
-> TextInputConfig t
forall t.
TextZipper
-> Event t (TextZipper -> TextZipper)
-> Int
-> Dynamic t (Char -> Char)
-> TextInputConfig t
TextInputConfig TextZipper
empty Event t (TextZipper -> TextZipper)
forall k (t :: k) a. Reflex t => Event t a
never 4 ((Char -> Char) -> Dynamic t (Char -> Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char -> Char
forall a. a -> a
id)

-- | The output produced by text input widgets, including the text
-- value and the number of display lines (post-wrapping). Note that some
-- display lines may not be visible due to scrolling.
data TextInput t = TextInput
  { TextInput t -> Dynamic t Text
_textInput_value :: Dynamic t Text
  , TextInput t -> Dynamic t Int
_textInput_lines :: Dynamic t Int
  }

-- | A widget that allows text input
textInput
  :: (Reflex t, MonadHold t m, MonadFix m)
  => TextInputConfig t
  -> VtyWidget t m (TextInput t)
textInput :: TextInputConfig t -> VtyWidget t m (TextInput t)
textInput cfg :: TextInputConfig t
cfg = do
  Event t VtyEvent
i <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  Dynamic t Bool
f <- VtyWidget t m (Dynamic t Bool)
forall t (m :: * -> *). HasFocus t m => m (Dynamic t Bool)
focus
  Dynamic t Int
dh <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayHeight
  Dynamic t Int
dw <- VtyWidget t m (Dynamic t Int)
forall t (m :: * -> *). HasDisplaySize t m => m (Dynamic t Int)
displayWidth
  rec Dynamic t TextZipper
v <- ((TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> TextZipper
-> Event t (TextZipper -> TextZipper)
-> VtyWidget t m (Dynamic t TextZipper)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
($) (TextInputConfig t -> TextZipper
forall t. TextInputConfig t -> TextZipper
_textInputConfig_initialValue TextInputConfig t
cfg) (Event t (TextZipper -> TextZipper)
 -> VtyWidget t m (Dynamic t TextZipper))
-> Event t (TextZipper -> TextZipper)
-> VtyWidget t m (Dynamic t TextZipper)
forall a b. (a -> b) -> a -> b
$ ((TextZipper -> TextZipper)
 -> (TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> [Event t (TextZipper -> TextZipper)]
-> Event t (TextZipper -> TextZipper)
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
        [ (Int -> VtyEvent -> TextZipper -> TextZipper)
-> (Int, VtyEvent) -> TextZipper -> TextZipper
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> VtyEvent -> TextZipper -> TextZipper
updateTextZipper (TextInputConfig t -> Int
forall t. TextInputConfig t -> Int
_textInputConfig_tabWidth TextInputConfig t
cfg)) ((Int, VtyEvent) -> TextZipper -> TextZipper)
-> Event t (Int, VtyEvent) -> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Int -> Event t VtyEvent -> Event t (Int, VtyEvent)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh) Event t VtyEvent
i
        , TextInputConfig t -> Event t (TextZipper -> TextZipper)
forall t. TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify TextInputConfig t
cfg
        , let displayInfo :: Behavior t (DisplayLines Attr, Int)
displayInfo = (,) (DisplayLines Attr -> Int -> (DisplayLines Attr, Int))
-> Behavior t (DisplayLines Attr)
-> Behavior t (Int -> (DisplayLines Attr, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr) -> Behavior t (DisplayLines Attr)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DisplayLines Attr)
rows Behavior t (Int -> (DisplayLines Attr, Int))
-> Behavior t Int -> Behavior t (DisplayLines Attr, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Int
scrollTop
          in Event t ((DisplayLines Attr, Int), MouseDown)
-> (((DisplayLines Attr, Int), MouseDown)
    -> TextZipper -> TextZipper)
-> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Behavior t (DisplayLines Attr, Int)
-> Event t MouseDown
-> Event t ((DisplayLines Attr, Int), MouseDown)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach Behavior t (DisplayLines Attr, Int)
displayInfo Event t MouseDown
click) ((((DisplayLines Attr, Int), MouseDown)
  -> TextZipper -> TextZipper)
 -> Event t (TextZipper -> TextZipper))
-> (((DisplayLines Attr, Int), MouseDown)
    -> TextZipper -> TextZipper)
-> Event t (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ \((dl :: DisplayLines Attr
dl, st :: Int
st), MouseDown _ (mx :: Int
mx, my :: Int
my) _) ->
            Int -> Int -> DisplayLines Attr -> TextZipper -> TextZipper
forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
goToDisplayLinePosition Int
mx (Int
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
my) DisplayLines Attr
dl
        ]
      Event t MouseDown
click <- Button -> VtyWidget t m (Event t MouseDown)
forall t (m :: * -> *).
(Reflex t, Monad m) =>
Button -> VtyWidget t m (Event t MouseDown)
mouseDown Button
V.BLeft
      let cursorAttrs :: Dynamic t Attr
cursorAttrs = Dynamic t Bool -> (Bool -> Attr) -> Dynamic t Attr
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Bool
f ((Bool -> Attr) -> Dynamic t Attr)
-> (Bool -> Attr) -> Dynamic t Attr
forall a b. (a -> b) -> a -> b
$ \x :: Bool
x -> if Bool
x then Attr
cursorAttributes else Attr
V.defAttr
      let rows :: Dynamic t (DisplayLines Attr)
rows = (\w :: Int
w s :: TextZipper
s c :: Attr
c -> Int -> Attr -> Attr -> TextZipper -> DisplayLines Attr
forall tag. Int -> tag -> tag -> TextZipper -> DisplayLines tag
displayLines Int
w Attr
V.defAttr Attr
c TextZipper
s)
            (Int -> TextZipper -> Attr -> DisplayLines Attr)
-> Dynamic t Int
-> Dynamic t (TextZipper -> Attr -> DisplayLines Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw
            Dynamic t (TextZipper -> Attr -> DisplayLines Attr)
-> Dynamic t TextZipper -> Dynamic t (Attr -> DisplayLines Attr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> Char) -> TextZipper -> TextZipper
mapZipper ((Char -> Char) -> TextZipper -> TextZipper)
-> Dynamic t (Char -> Char) -> Dynamic t (TextZipper -> TextZipper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextInputConfig t -> Dynamic t (Char -> Char)
forall t. TextInputConfig t -> Dynamic t (Char -> Char)
_textInputConfig_display TextInputConfig t
cfg Dynamic t (TextZipper -> TextZipper)
-> Dynamic t TextZipper -> Dynamic t TextZipper
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t TextZipper
v)
            Dynamic t (Attr -> DisplayLines Attr)
-> Dynamic t Attr -> Dynamic t (DisplayLines Attr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Attr
cursorAttrs
          img :: Dynamic t [Image]
img = [[Span Attr]] -> [Image]
images ([[Span Attr]] -> [Image])
-> (DisplayLines Attr -> [[Span Attr]])
-> DisplayLines Attr
-> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayLines Attr -> [[Span Attr]]
forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans (DisplayLines Attr -> [Image])
-> Dynamic t (DisplayLines Attr) -> Dynamic t [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
      Dynamic t Int
y <- Dynamic t Int -> VtyWidget t m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Int -> VtyWidget t m (Dynamic t Int))
-> Dynamic t Int -> VtyWidget t m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ DisplayLines Attr -> Int
forall tag. DisplayLines tag -> Int
_displayLines_cursorY (DisplayLines Attr -> Int)
-> Dynamic t (DisplayLines Attr) -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
      let newScrollTop :: Int -> (Int, Int) -> Int
          newScrollTop :: Int -> (Int, Int) -> Int
newScrollTop st :: Int
st (h :: Int
h, cursorY :: Int
cursorY)
            | Int
cursorY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
st = Int
cursorY
            | Int
cursorY Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h = Int
cursorY Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
            | Bool
otherwise = Int
st
      let hy :: Event t Int
hy = (Int -> (Int, Int) -> Int)
-> Behavior t Int -> Event t (Int, Int) -> Event t Int
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith Int -> (Int, Int) -> Int
newScrollTop Behavior t Int
scrollTop (Event t (Int, Int) -> Event t Int)
-> Event t (Int, Int) -> Event t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t (Int, Int) -> Event t (Int, Int)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated (Dynamic t (Int, Int) -> Event t (Int, Int))
-> Dynamic t (Int, Int) -> Event t (Int, Int)
forall a b. (a -> b) -> a -> b
$ Dynamic t Int -> Dynamic t Int -> Dynamic t (Int, Int)
forall k (t :: k) a b.
Reflex t =>
Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
zipDyn Dynamic t Int
dh Dynamic t Int
y
      Behavior t Int
scrollTop <- Int -> Event t Int -> VtyWidget t m (Behavior t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold 0 Event t Int
hy
      Behavior t [Image] -> VtyWidget t m ()
forall t (m :: * -> *).
ImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t [Image] -> VtyWidget t m ())
-> Behavior t [Image] -> VtyWidget t m ()
forall a b. (a -> b) -> a -> b
$ (\imgs :: [Image]
imgs st :: Int
st -> (Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
:[]) (Image -> [Image]) -> ([Image] -> Image) -> [Image] -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
V.vertCat ([Image] -> [Image]) -> [Image] -> [Image]
forall a b. (a -> b) -> a -> b
$ Int -> [Image] -> [Image]
forall a. Int -> [a] -> [a]
drop Int
st [Image]
imgs) ([Image] -> Int -> [Image])
-> Behavior t [Image] -> Behavior t (Int -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t [Image] -> Behavior t [Image]
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t [Image]
img Behavior t (Int -> [Image]) -> Behavior t Int -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Int
scrollTop
  TextInput t -> VtyWidget t m (TextInput t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextInput t -> VtyWidget t m (TextInput t))
-> TextInput t -> VtyWidget t m (TextInput t)
forall a b. (a -> b) -> a -> b
$ TextInput :: forall t. Dynamic t Text -> Dynamic t Int -> TextInput t
TextInput
    { _textInput_value :: Dynamic t Text
_textInput_value = TextZipper -> Text
value (TextZipper -> Text) -> Dynamic t TextZipper -> Dynamic t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t TextZipper
v
    , _textInput_lines :: Dynamic t Int
_textInput_lines = [[Span Attr]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Span Attr]] -> Int)
-> (DisplayLines Attr -> [[Span Attr]]) -> DisplayLines Attr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayLines Attr -> [[Span Attr]]
forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans (DisplayLines Attr -> Int)
-> Dynamic t (DisplayLines Attr) -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
rows
    }

-- | A widget that allows multiline text input
multilineTextInput
  :: (Reflex t, MonadHold t m, MonadFix m)
  => TextInputConfig t
  -> VtyWidget t m (TextInput t)
multilineTextInput :: TextInputConfig t -> VtyWidget t m (TextInput t)
multilineTextInput cfg :: TextInputConfig t
cfg = do
  Event t VtyEvent
i <- VtyWidget t m (Event t VtyEvent)
forall t (m :: * -> *). HasVtyInput t m => m (Event t VtyEvent)
input
  TextInputConfig t -> VtyWidget t m (TextInput t)
forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m) =>
TextInputConfig t -> VtyWidget t m (TextInput t)
textInput (TextInputConfig t -> VtyWidget t m (TextInput t))
-> TextInputConfig t -> VtyWidget t m (TextInput t)
forall a b. (a -> b) -> a -> b
$ TextInputConfig t
cfg
    { _textInputConfig_modify :: Event t (TextZipper -> TextZipper)
_textInputConfig_modify = ((TextZipper -> TextZipper)
 -> (TextZipper -> TextZipper) -> TextZipper -> TextZipper)
-> [Event t (TextZipper -> TextZipper)]
-> Event t (TextZipper -> TextZipper)
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (TextZipper -> TextZipper)
-> (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
      [ Event t VtyEvent
-> (VtyEvent -> Maybe (TextZipper -> TextZipper))
-> Event t (TextZipper -> TextZipper)
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i ((VtyEvent -> Maybe (TextZipper -> TextZipper))
 -> Event t (TextZipper -> TextZipper))
-> (VtyEvent -> Maybe (TextZipper -> TextZipper))
-> Event t (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ \case
          V.EvKey V.KEnter [] -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ Text -> TextZipper -> TextZipper
insert "\n"
          _ -> Maybe (TextZipper -> TextZipper)
forall a. Maybe a
Nothing
      , TextInputConfig t -> Event t (TextZipper -> TextZipper)
forall t. TextInputConfig t -> Event t (TextZipper -> TextZipper)
_textInputConfig_modify TextInputConfig t
cfg
      ]
    }

-- | Wraps a 'textInput' or 'multilineTextInput' in a tile. Uses
-- the computed line count to greedily size the tile when vertically
-- oriented, and uses the fallback width when horizontally oriented.
textInputTile
  :: (Reflex t, MonadHold t m, MonadFix m, MonadNodeId m)
  => VtyWidget t m (TextInput t)
  -> Dynamic t Int
  -> Layout t m (TextInput t)
textInputTile :: VtyWidget t m (TextInput t)
-> Dynamic t Int -> Layout t m (TextInput t)
textInputTile txt :: VtyWidget t m (TextInput t)
txt width :: Dynamic t Int
width = do
  Dynamic t Orientation
o <- Layout t m (Dynamic t Orientation)
forall (m :: * -> *) t.
Monad m =>
Layout t m (Dynamic t Orientation)
askOrientation
  rec TextInput t
t <- Dynamic t Int
-> VtyWidget t m (TextInput t) -> Layout t m (TextInput t)
forall t (m :: * -> *) a.
(Reflex t, Monad m, MonadNodeId m) =>
Dynamic t Int -> VtyWidget t m a -> Layout t m a
fixed Dynamic t Int
sz VtyWidget t m (TextInput t)
txt
      let sz :: Dynamic t Int
sz = Dynamic t (Dynamic t Int) -> Dynamic t Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Dynamic t (Dynamic t Int) -> Dynamic t Int)
-> Dynamic t (Dynamic t Int) -> Dynamic t Int
forall a b. (a -> b) -> a -> b
$ Dynamic t Orientation
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Orientation
o ((Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int))
-> (Orientation -> Dynamic t Int) -> Dynamic t (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ \case
            Orientation_Column -> TextInput t -> Dynamic t Int
forall t. TextInput t -> Dynamic t Int
_textInput_lines TextInput t
t
            Orientation_Row -> Dynamic t Int
width
  TextInput t -> Layout t m (TextInput t)
forall (m :: * -> *) a. Monad m => a -> m a
return TextInput t
t

-- | Default attributes for the text cursor
cursorAttributes :: V.Attr
cursorAttributes :: Attr
cursorAttributes = Attr -> Style -> Attr
V.withStyle Attr
V.defAttr Style
V.reverseVideo

-- | Turn a set of display line rows into a list of images (one per line)
images :: [[Span V.Attr]] -> [V.Image]
images :: [[Span Attr]] -> [Image]
images = ([Span Attr] -> Image) -> [[Span Attr]] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map ([Image] -> Image
V.horizCat ([Image] -> Image)
-> ([Span Attr] -> [Image]) -> [Span Attr] -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span Attr -> Image) -> [Span Attr] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map Span Attr -> Image
spanToImage)

-- | Turn a set of display line rows into a single image
image :: [[Span V.Attr]] -> V.Image
image :: [[Span Attr]] -> Image
image = [Image] -> Image
V.vertCat ([Image] -> Image)
-> ([[Span Attr]] -> [Image]) -> [[Span Attr]] -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Span Attr]] -> [Image]
images

-- | Turn a 'Span' into an 'Graphics.Vty.Image'
spanToImage :: Span V.Attr -> V.Image
spanToImage :: Span Attr -> Image
spanToImage (Span attrs :: Attr
attrs t :: Text
t) = Attr -> Text -> Image
V.text' Attr
attrs Text
t

-- | Default vty event handler for text inputs
updateTextZipper
  :: Int -- ^ Tab width
  -> Int -- ^ Page size
  -> V.Event -- ^ The vty event to handle
  -> TextZipper -- ^ The zipper to modify
  -> TextZipper
updateTextZipper :: Int -> Int -> VtyEvent -> TextZipper -> TextZipper
updateTextZipper tabWidth :: Int
tabWidth pageSize :: Int
pageSize ev :: VtyEvent
ev = case VtyEvent
ev of
  -- Special characters
  V.EvKey (V.KChar '\t') [] -> Int -> TextZipper -> TextZipper
tab Int
tabWidth
  -- Regular characters
  V.EvKey (V.KChar k :: Char
k) [] -> Char -> TextZipper -> TextZipper
insertChar Char
k
  -- Deletion buttons
  V.EvKey V.KBS [] -> TextZipper -> TextZipper
deleteLeft
  V.EvKey V.KDel [] -> TextZipper -> TextZipper
deleteRight
  -- Key combinations
  V.EvKey (V.KChar 'u') [V.MCtrl] -> TextZipper -> TextZipper -> TextZipper
forall a b. a -> b -> a
const TextZipper
empty
  V.EvKey (V.KChar 'w') [V.MCtrl] -> TextZipper -> TextZipper
deleteLeftWord
  -- Arrow keys
  V.EvKey V.KLeft [] -> TextZipper -> TextZipper
left
  V.EvKey V.KRight [] -> TextZipper -> TextZipper
right
  V.EvKey V.KUp [] -> TextZipper -> TextZipper
up
  V.EvKey V.KDown [] -> TextZipper -> TextZipper
down
  V.EvKey V.KHome [] -> TextZipper -> TextZipper
home
  V.EvKey V.KEnd [] -> TextZipper -> TextZipper
end
  V.EvKey V.KPageUp [] -> Int -> TextZipper -> TextZipper
pageUp Int
pageSize
  V.EvKey V.KPageDown [] -> Int -> TextZipper -> TextZipper
pageDown Int
pageSize
  _ -> TextZipper -> TextZipper
forall a. a -> a
id