{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Reflex.Vty.Widget.TextInputHelpers where
import Relude
import Potato.Flow
import Potato.Flow.Vty.Attrs
import Potato.Reflex.Vty.Helpers
import Potato.Reflex.Vty.Widget
import Potato.Flow.Vty.PotatoReader
import Control.Monad.Fix
import Control.Monad.NodeId
import Data.Align
import Data.Char (isNumber)
import Data.Dependent.Sum (DSum ((:=>)))
import qualified Data.IntMap as IM
import qualified Data.List.Extra as L
import qualified Data.Maybe
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Zipper as TZ
import Data.These
import Data.Tuple.Extra
import qualified Graphics.Vty as V
import Reflex
import Reflex.Network
import Reflex.Potato.Helpers
import Reflex.Vty
infiniteWidthDyn :: (Reflex t) => Dynamic t Int
infiniteWidthDyn :: forall t. Reflex t => Dynamic t Int
infiniteWidthDyn = forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Int
99999
type UpdateTextZipperMethod = V.Event -> Maybe (TZ.TextZipper -> TZ.TextZipper)
makeCaptureFromUpdateTextZipperMethod :: (Reflex t, MonadFix m, MonadNodeId m, HasInput t m) => UpdateTextZipperMethod -> m (Event t())
makeCaptureFromUpdateTextZipperMethod :: forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadNodeId m, HasInput t m) =>
UpdateTextZipperMethod -> m (Event t ())
makeCaptureFromUpdateTextZipperMethod UpdateTextZipperMethod
f = do
Event t VtyEvent
inp <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
return $ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp UpdateTextZipperMethod
f
makeModifyEventFromUpdateTextZipperMethod ::
UpdateTextZipperMethod
-> V.Event
-> TZ.TextZipper
-> TZ.TextZipper
makeModifyEventFromUpdateTextZipperMethod :: UpdateTextZipperMethod -> VtyEvent -> TextZipper -> TextZipper
makeModifyEventFromUpdateTextZipperMethod UpdateTextZipperMethod
f = \VtyEvent
ev -> forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id (UpdateTextZipperMethod
f VtyEvent
ev)
updateTextZipperForSingleCharacter :: UpdateTextZipperMethod
updateTextZipperForSingleCharacter :: UpdateTextZipperMethod
updateTextZipperForSingleCharacter VtyEvent
ev = case VtyEvent
ev of
V.EvKey (V.KChar Char
'\t') [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a
id
V.EvKey (V.KChar Char
k) [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.top forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
k TextZipper
TZ.empty
V.EvKey Key
V.KBS [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const TextZipper
TZ.empty
V.EvKey Key
V.KDel [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const TextZipper
TZ.empty
V.EvKey (V.KChar Char
'u') [Modifier
V.MCtrl] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const TextZipper
TZ.empty
VtyEvent
_ -> forall a. Maybe a
Nothing
updateTextZipperForNumberInput
:: UpdateTextZipperMethod
updateTextZipperForNumberInput :: UpdateTextZipperMethod
updateTextZipperForNumberInput VtyEvent
ev = case VtyEvent
ev of
V.EvKey (V.KChar Char
k) [] | Char -> Bool
isNumber Char
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
k
V.EvKey Key
V.KBS [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteLeft
V.EvKey Key
V.KDel [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteRight
V.EvKey Key
V.KLeft [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.left
V.EvKey Key
V.KRight [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.right
V.EvKey Key
V.KHome [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.home
V.EvKey Key
V.KEnd [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.end
V.EvKey (V.KChar Char
'u') [Modifier
V.MCtrl] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const TextZipper
TZ.empty
VtyEvent
_ -> forall a. Maybe a
Nothing
singleCellTextInput
:: (MonadWidget t m, HasPotato t m)
=> Event t (TZ.TextZipper -> TZ.TextZipper)
-> TZ.TextZipper
-> m (Dynamic t Text)
singleCellTextInput :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
singleCellTextInput Event t (TextZipper -> TextZipper)
modifyEv TextZipper
c0 = do
Event t VtyEvent
i <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
textInputCustom (forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpdateTextZipperMethod -> VtyEvent -> TextZipper -> TextZipper
makeModifyEventFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForSingleCharacter) Event t VtyEvent
i, Event t (TextZipper -> TextZipper)
modifyEv]) TextZipper
c0
dimensionInput
:: (MonadWidget t m, HasPotato t m)
=> Dynamic t Int
-> m (Dynamic t Int)
dimensionInput :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int -> m (Dynamic t Int)
dimensionInput Dynamic t Int
valueDyn = do
let
toText :: Int -> TextZipper
toText = Text -> TextZipper
TZ.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show
modifyEv :: Event t (TextZipper -> TextZipper)
modifyEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
v -> forall a b. a -> b -> a
const (Int -> TextZipper
toText Int
v)) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Int
valueDyn)
Int
v0 <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Int
valueDyn
Event t VtyEvent
i <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
Dynamic t Text
tDyn <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
textInputCustom (forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpdateTextZipperMethod -> VtyEvent -> TextZipper -> TextZipper
makeModifyEventFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForNumberInput) Event t VtyEvent
i, Event t (TextZipper -> TextZipper)
modifyEv]) (Int -> TextZipper
toText Int
v0)
return $ forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
valueDyn Dynamic t Text
tDyn forall a b. (a -> b) -> a -> b
$ \Int
v Text
t -> forall a. a -> Maybe a -> a
fromMaybe Int
v (forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t))
updateTextZipperForFilenameCharacters :: UpdateTextZipperMethod
updateTextZipperForFilenameCharacters :: UpdateTextZipperMethod
updateTextZipperForFilenameCharacters VtyEvent
ev = case VtyEvent
ev of
V.EvKey (V.KChar Char
k) [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
k
V.EvKey Key
V.KBS [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteLeft
V.EvKey Key
V.KDel [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteRight
V.EvKey Key
V.KLeft [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.left
V.EvKey Key
V.KRight [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.right
V.EvKey Key
V.KHome [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.home
V.EvKey Key
V.KEnd [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.end
V.EvKey (V.KChar Char
'u') [Modifier
V.MCtrl] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const TextZipper
TZ.empty
VtyEvent
_ -> forall a. Maybe a
Nothing
filenameInputFireEventOnLoseFocus
:: (MonadWidget t m, HasPotato t m, HasFocus t m)
=> Text
-> Event t Text
-> m (Event t Text)
filenameInputFireEventOnLoseFocus :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m, HasFocus t m) =>
Text -> Event t Text -> m (Event t Text)
filenameInputFireEventOnLoseFocus Text
t0 Event t Text
overrideEv' = mdo
Dynamic t Int
dw <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Event t VtyEvent
i <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
let
overrideEv :: Event t (TextZipper -> TextZipper)
overrideEv = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
overrideEv' forall a b. (a -> b) -> a -> b
$ \Text
t -> forall a b. a -> b -> a
const (Text -> TextZipper
TZ.fromText Text
t)
offsetx :: Dynamic t Int
offsetx = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
dw Dynamic t Text
dt forall a b. (a -> b) -> a -> b
$ \Int
w Text
fn -> forall a. Ord a => a -> a -> a
max Int
0 (Text -> Int
T.length Text
fn forall a. Num a => a -> a -> a
- Int
w forall a. Num a => a -> a -> a
+ Int
4)
Dynamic t Text
dt <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Event t (TextZipper -> TextZipper)
-> TextZipper
-> m (Dynamic t Text)
textInputCustom' forall t. Reflex t => Dynamic t Int
infiniteWidthDyn Dynamic t Int
offsetx (forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpdateTextZipperMethod -> VtyEvent -> TextZipper -> TextZipper
makeModifyEventFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForFilenameCharacters) Event t VtyEvent
i, Event t (TextZipper -> TextZipper)
overrideEv]) (Text -> TextZipper
TZ.fromText Text
t0)
Dynamic t (Maybe FocusId)
focusDyn <- forall {k} (t :: k) (m :: * -> *).
HasFocus t m =>
m (Dynamic t (Maybe FocusId))
focusedId
Dynamic t Text
lastTextDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
t0 Event t Text
updatedtextev
let
updatedtextev :: Event t Text
updatedtextev = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe FocusId)
focusDyn) forall a b. (a -> b) -> a -> b
$ \()
_ -> do
Text
t <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Text
dt
Text
told <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Text
lastTextDyn
if Text
t forall a. Eq a => a -> a -> Bool
== Text
told
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
t
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
updatedtextev
filenameInput
:: (MonadWidget t m, HasPotato t m)
=> Text
-> Event t Text
-> m (Dynamic t Text)
filenameInput :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Text -> Event t Text -> m (Dynamic t Text)
filenameInput Text
t0 Event t Text
overrideEv' = mdo
Dynamic t Int
dw <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Event t VtyEvent
i <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
let
overrideEv :: Event t (TextZipper -> TextZipper)
overrideEv = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
overrideEv' forall a b. (a -> b) -> a -> b
$ \Text
t -> forall a b. a -> b -> a
const (Text -> TextZipper
TZ.fromText Text
t)
offsetx :: Dynamic t Int
offsetx = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
dw Dynamic t Text
dt forall a b. (a -> b) -> a -> b
$ \Int
w Text
fn -> forall a. Ord a => a -> a -> a
max Int
0 (Text -> Int
T.length Text
fn forall a. Num a => a -> a -> a
- Int
w forall a. Num a => a -> a -> a
+ Int
4)
Dynamic t Text
dt <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Event t (TextZipper -> TextZipper)
-> TextZipper
-> m (Dynamic t Text)
textInputCustom' forall t. Reflex t => Dynamic t Int
infiniteWidthDyn Dynamic t Int
offsetx (forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpdateTextZipperMethod -> VtyEvent -> TextZipper -> TextZipper
makeModifyEventFromUpdateTextZipperMethod UpdateTextZipperMethod
updateTextZipperForFilenameCharacters) Event t VtyEvent
i, Event t (TextZipper -> TextZipper)
overrideEv]) (Text -> TextZipper
TZ.fromText Text
t0)
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamic t Text
dt
dropSpan :: Int -> [TZ.Span V.Attr] -> [TZ.Span V.Attr]
dropSpan :: Int -> [Span Attr] -> [Span Attr]
dropSpan Int
_ [] = []
dropSpan Int
n ((TZ.Span Attr
tag Text
text):[Span Attr]
xs) = forall tag. tag -> Text -> Span tag
TZ.Span Attr
tag (Int -> Text -> Text
T.drop Int
n Text
text) forall a. a -> [a] -> [a]
: Int -> [Span Attr] -> [Span Attr]
dropSpan (forall a. Ord a => a -> a -> a
max Int
0 (Int
n forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
text)) [Span Attr]
xs
renderTextZipper :: (MonadWidget t m, HasPotato t m) => Dynamic t Int -> Dynamic t Int -> Dynamic t TZ.TextZipper -> m (Dynamic t (TZ.DisplayLines V.Attr))
renderTextZipper :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Dynamic t TextZipper
-> m (Dynamic t (DisplayLines Attr))
renderTextZipper Dynamic t Int
offsetDyn Dynamic t Int
dw Dynamic t TextZipper
tz = do
Dynamic t Bool
f <- forall {k} (t :: k) (m :: * -> *).
HasFocusReader t m =>
m (Dynamic t Bool)
focus
PotatoStyle
potatostyle <- forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style
let
cursorAttributes :: Attr
cursorAttributes = PotatoStyle -> Attr
_potatoStyle_textfield_cursor PotatoStyle
potatostyle
normalAttributes :: Attr
normalAttributes = PotatoStyle -> Attr
_potatoStyle_textfield_modifying PotatoStyle
potatostyle
nofocusAttributes :: Attr
nofocusAttributes = PotatoStyle -> Attr
_potatoStyle_textfield_normal PotatoStyle
potatostyle
attrsDyn :: Dynamic t (Attr, Attr)
attrsDyn = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Bool
f forall a b. (a -> b) -> a -> b
$ \Bool
x -> if Bool
x then (Attr
normalAttributes, Attr
cursorAttributes) else (Attr
nofocusAttributes, Attr
nofocusAttributes)
let rows :: Dynamic t (DisplayLines Attr)
rows = (\Int
w TextZipper
s (Attr
nattr, Attr
cattr) -> forall tag. Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLines Int
w Attr
nattr Attr
cattr TextZipper
s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t TextZipper
tz
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (Attr, Attr)
attrsDyn
img :: Dynamic t [Image]
img = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t (DisplayLines Attr)
rows Dynamic t Int
offsetDyn forall a b. (a -> b) -> a -> b
$ \DisplayLines Attr
rows' Int
ox -> [[Span Attr]] -> [Image]
images forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Span Attr] -> [Span Attr]
dropSpan Int
ox) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tag. DisplayLines tag -> [[Span tag]]
TZ._displayLines_spans forall a b. (a -> b) -> a -> b
$ DisplayLines Attr
rows'
forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages forall a b. (a -> b) -> a -> b
$ (\[Image]
imgs -> (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
V.vertCat forall a b. (a -> b) -> a -> b
$ [Image]
imgs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t [Image]
img
return Dynamic t (DisplayLines Attr)
rows
textInputCustom'
:: (MonadWidget t m, HasPotato t m)
=> Dynamic t Int
-> Dynamic t Int
-> Event t (TZ.TextZipper -> TZ.TextZipper)
-> TZ.TextZipper
-> m (Dynamic t Text)
textInputCustom' :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Event t (TextZipper -> TextZipper)
-> TextZipper
-> m (Dynamic t Text)
textInputCustom' Dynamic t Int
widthDyn Dynamic t Int
offsetDyn Event t (TextZipper -> TextZipper)
modifyEv TextZipper
c0 = mdo
rec Dynamic t TextZipper
v <- 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 forall a b. (a -> b) -> a -> b
($) TextZipper
c0 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
[ Event t (TextZipper -> TextZipper)
modifyEv
, let displayInfo :: Behavior t (DisplayLines Attr, Int)
displayInfo = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (DisplayLines Attr)
dls forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
offsetDyn)
in forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (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) forall a b. (a -> b) -> a -> b
$ \((DisplayLines Attr
dl,Int
ox), MouseDown Button
_ (Int
mx, Int
my) [Modifier]
_) ->
forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
TZ.goToDisplayLinePosition (Int
oxforall a. Num a => a -> a -> a
+Int
mx) Int
my DisplayLines Attr
dl
]
Event t MouseDown
click <- forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
Dynamic t (DisplayLines Attr)
dls <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Dynamic t TextZipper
-> m (Dynamic t (DisplayLines Attr))
renderTextZipper Dynamic t Int
offsetDyn Dynamic t Int
widthDyn Dynamic t TextZipper
v
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TextZipper -> Text
TZ.value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t TextZipper
v
textInputCustom
:: (MonadWidget t m, HasPotato t m)
=> Event t (TZ.TextZipper -> TZ.TextZipper)
-> TZ.TextZipper
-> m (Dynamic t Text)
textInputCustom :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t (TextZipper -> TextZipper)
-> TextZipper -> m (Dynamic t Text)
textInputCustom = forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Dynamic t Int
-> Dynamic t Int
-> Event t (TextZipper -> TextZipper)
-> TextZipper
-> m (Dynamic t Text)
textInputCustom' forall t. Reflex t => Dynamic t Int
infiniteWidthDyn (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Int
0)