-- extends methods Text.Input
-- TODO belongs in Potato because depends on HasPotato
-- alternatively, drop the HasPotato requirement by passing in Behavior t V.Attr into these methods

{-# 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 -- ^ The vty event to handle
  -> TZ.TextZipper -- ^ The zipper to modify
  -> 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


-- remember that input dyn can't update the same time the output updates or you will have infinite loop
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)
  --tDyn <- fmap _textInput_value $ textInput (def { _textInputConfig_initialValue = (toText 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
  -- TODO you need to do more filtering here
  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


-- UNTESTED
-- prob don't need this version
filenameInputFireEventOnLoseFocus
  :: (MonadWidget t m, HasPotato t m, HasFocus t m)
  => Text -- ^ initial
  -> Event t Text -- ^ override input event
  -> m (Event t Text) -- ^ event that fires when text input loses focus
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

-- UNTESTED
filenameInput
  :: (MonadWidget t m, HasPotato t m)
  => Text -- ^ initial
  -> Event t Text -- ^ override input event
  -> 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

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

images :: [[Span V.Attr]] -> [V.Image]
images = map (V.horizCat . map spanToImage)
-}

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

  -- TODO do this without sampling (I think this will not update if you change style without recreating these widgets)
  -- (you could do this easily by using localTheme)
  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)

  -- TODO this will still render trailing cursor when we aren't focused... please fix
  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

-- TODO rename to singelLineTextInputCustom or something
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)