{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2018 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE TemplateHaskell #-}

module Simple.UI.Widgets.Edit (
    Edit,
    EditClass,
    castToEdit,
    editNew,
    text
) where

import           Control.Lens                  (makeLensesFor, (.=))
import           Control.Monad
import qualified Graphics.Vty                  as Vty

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.Draw
import           Simple.UI.Core.Internal.UIApp
import           Simple.UI.Core.ListenerList
import           Simple.UI.Utils
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data Edit = Edit
    { Edit -> Text
_editParent    :: Text
    , Edit -> Attribute Int
_editCursorPos :: Attribute Int
    , Edit -> Attribute Int
_editXOffset   :: Attribute Int
    , Edit -> Attribute Int
_editWidth     :: Attribute Int
    }

makeLensesFor [("_editParent", "editParent")] ''Edit

class TextClass w => EditClass w where
    castToEdit :: w -> Edit

instance EditClass Edit where
    castToEdit :: Edit -> Edit
castToEdit = Edit -> Edit
forall a. a -> a
id

instance TextClass Edit where
    castToText :: Edit -> Text
castToText = Edit -> Text
_editParent

instance WidgetClass Edit where
    castToWidget :: Edit -> Widget
castToWidget = Text -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget (Text -> Widget) -> (Edit -> Text) -> Edit -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit -> Text
_editParent

    overrideWidget :: Edit -> State VirtualWidget () -> Edit
overrideWidget = Lens' Edit Text -> Edit -> State VirtualWidget () -> Edit
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper Lens' Edit Text
editParent

editNew :: Maybe String -> UIApp u Edit
editNew :: Maybe String -> UIApp u Edit
editNew Maybe String
s = do
    Edit
edit <- Maybe String -> UIApp u Edit
forall u. Maybe String -> UIApp u Edit
editNewOverride Maybe String
s

    Edit
-> (Edit -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing -> Int -> Int -> UIApp' ())
-> UIApp u ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ Edit
edit Edit -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw ((Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ())
-> (Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ Edit -> Drawing -> Int -> Int -> UIApp' ()
forall u. Edit -> Drawing -> Int -> Int -> UIApp u ()
editDraw Edit
edit
    Edit
-> (Edit -> ListenerList (Key -> [Modifier] -> UIApp' ()))
-> (Key -> [Modifier] -> UIApp' ())
-> UIApp u ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ Edit
edit Edit -> ListenerList (Key -> [Modifier] -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Key -> [Modifier] -> UIApp' ())
keyPressed ((Key -> [Modifier] -> UIApp' ()) -> UIApp u ())
-> (Key -> [Modifier] -> UIApp' ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ \Key
key [Modifier]
_ ->
        case Key
key of
            Vty.KChar Char
c -> do
                Int
pos <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
                Int
offset <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset
                Edit
-> (Edit -> Attribute (Maybe String))
-> (Maybe String -> Maybe String)
-> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text ((Maybe String -> Maybe String) -> UIApp' ())
-> (Maybe String -> Maybe String) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ \case
                    Maybe String
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just [Char
c]
                    Just String
x  -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String -> Char -> String
forall a. Int -> [a] -> a -> [a]
insertAt (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) String
x Char
c
                Edit -> UIApp' ()
forall (m :: * -> *). MonadIO m => Edit -> m ()
cursorGoRight Edit
edit

            Key
Vty.KBS -> do
                Int
pos <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
                Int
offset <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset
                Edit
-> (Edit -> Attribute (Maybe String))
-> (Maybe String -> Maybe String)
-> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text ((Maybe String -> Maybe String) -> UIApp' ())
-> (Maybe String -> Maybe String) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ \case
                    Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
                    Just String
x  -> do
                        let x' :: String
x' = Int -> String -> String
forall a. Int -> [a] -> [a]
removeAt (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
x
                        if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x' then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
x'
                Edit -> UIApp' ()
forall (m :: * -> *). MonadIO m => Edit -> m ()
cursorGoLeft Edit
edit

            Key
Vty.KDel -> do
                Int
pos <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
                Int
offset <- Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset
                Edit
-> (Edit -> Attribute (Maybe String))
-> (Maybe String -> Maybe String)
-> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text ((Maybe String -> Maybe String) -> UIApp' ())
-> (Maybe String -> Maybe String) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ \case
                    Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
                    Just String
x  -> do
                        let x' :: String
x' = Int -> String -> String
forall a. Int -> [a] -> [a]
removeAt (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) String
x
                        if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x' then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
x'

            Key
Vty.KHome -> do
                Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editCursorPos ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const Int
0
                Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editXOffset ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const Int
0

            Key
Vty.KEnd -> do
                Maybe String
_text <- Edit
-> (Edit -> Attribute (Maybe String))
-> ReaderT (AppConfig ()) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
                Maybe String -> (String -> UIApp' ()) -> UIApp' ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
_text ((String -> UIApp' ()) -> UIApp' ())
-> (String -> UIApp' ()) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ \String
x -> do
                    Int
width <- Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Edit
-> (Edit -> Attribute Int)
-> ReaderT (AppConfig ()) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editWidth
                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
                        then do
                            Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editCursorPos ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const Int
width
                            Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editXOffset ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width)
                        else do
                            Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editCursorPos ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x)
                            Edit -> (Edit -> Attribute Int) -> (Int -> Int) -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> (a -> a) -> m ()
modify Edit
edit Edit -> Attribute Int
_editXOffset ((Int -> Int) -> UIApp' ()) -> (Int -> Int) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a b. a -> b -> a
const Int
0

            Key
Vty.KLeft ->
                Edit -> UIApp' ()
forall (m :: * -> *). MonadIO m => Edit -> m ()
cursorGoLeft Edit
edit

            Key
Vty.KRight ->
                Edit -> UIApp' ()
forall (m :: * -> *). MonadIO m => Edit -> m ()
cursorGoRight Edit
edit

            Key
_  ->
                () -> UIApp' ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Edit -> UIApp u Edit
forall (m :: * -> *) a. Monad m => a -> m a
return Edit
edit
  where
    cursorGoRight :: Edit -> m ()
cursorGoRight Edit
edit = do
        Maybe String
_text <- Edit -> (Edit -> Attribute (Maybe String)) -> m (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
        Maybe String -> (String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
_text ((String -> m ()) -> m ()) -> (String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \String
x -> do
            Int
width  <- Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Edit -> (Edit -> Attribute Int) -> m Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editWidth
            Int
pos    <- Edit -> (Edit -> Attribute Int) -> m Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
            Int
offset <- Edit -> (Edit -> Attribute Int) -> m Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset

            let (Int
newPos, Int
newOffset) =
                    if Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
                        then
                            if Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x
                                then
                                    (Int
pos, Int
offset)
                                else
                                    (Int
pos, Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        else
                            (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
offset)

            Edit -> (Edit -> Attribute Int) -> Int -> m ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Edit
edit Edit -> Attribute Int
_editCursorPos Int
newPos
            Edit -> (Edit -> Attribute Int) -> Int -> m ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Edit
edit Edit -> Attribute Int
_editXOffset Int
newOffset

    cursorGoLeft :: Edit -> m ()
cursorGoLeft Edit
edit = do
        Maybe String
_text <- Edit -> (Edit -> Attribute (Maybe String)) -> m (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
        Maybe String -> (String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
_text ((String -> m ()) -> m ()) -> (String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
            Int
pos    <- Edit -> (Edit -> Attribute Int) -> m Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
            Int
offset <- Edit -> (Edit -> Attribute Int) -> m Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset

            let (Int
newPos, Int
newOffset) =
                    if Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                        then
                            if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                then
                                    (Int
0, Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                else
                                    (Int
0, Int
0)
                        else
                            (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
offset)

            Edit -> (Edit -> Attribute Int) -> Int -> m ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Edit
edit Edit -> Attribute Int
_editCursorPos Int
newPos
            Edit -> (Edit -> Attribute Int) -> Int -> m ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Edit
edit Edit -> Attribute Int
_editXOffset Int
newOffset

editNewOverride :: Maybe String -> UIApp u Edit
editNewOverride :: Maybe String -> UIApp u Edit
editNewOverride Maybe String
s = Edit -> Edit
forall w. TextClass w => w -> w
override (Edit -> Edit) -> UIApp u Edit -> UIApp u Edit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> UIApp u Edit
forall u. Maybe String -> UIApp u Edit
editNewDefault Maybe String
s
  where
    editComputeSize :: w -> m (Int, b)
editComputeSize w
edit = do
        Maybe String
maybeText <- w -> (w -> Attribute (Maybe String)) -> m (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get w
edit w -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
        case Maybe String
maybeText of
            Maybe String
Nothing    -> (Int, b) -> m (Int, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, b
1)
            Just String
_text -> do
                let width :: Int
width = if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
_text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then Int
2 else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
_text
                (Int, b) -> m (Int, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
width ,b
1)

    override :: w -> w
override w
edit = w -> State VirtualWidget () -> w
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget w
edit (State VirtualWidget () -> w) -> State VirtualWidget () -> w
forall a b. (a -> b) -> a -> b
$ do
        (String -> Identity String)
-> VirtualWidget -> Identity VirtualWidget
Lens' VirtualWidget String
virtualWidgetName ((String -> Identity String)
 -> VirtualWidget -> Identity VirtualWidget)
-> String -> State VirtualWidget ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
"edit"
        (UIApp' (Int, Int) -> Identity (UIApp' (Int, Int)))
-> VirtualWidget -> Identity VirtualWidget
Lens' VirtualWidget (UIApp' (Int, Int))
virtualWidgetComputeSize ((UIApp' (Int, Int) -> Identity (UIApp' (Int, Int)))
 -> VirtualWidget -> Identity VirtualWidget)
-> UIApp' (Int, Int) -> State VirtualWidget ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= w -> UIApp' (Int, Int)
forall (m :: * -> *) w b.
(MonadIO m, TextClass w, Num b) =>
w -> m (Int, b)
editComputeSize w
edit

editNewDefault :: Maybe String -> UIApp u Edit
editNewDefault :: Maybe String -> UIApp u Edit
editNewDefault Maybe String
s = do
    Text
parent <- Maybe String -> UIApp u Text
forall u. Maybe String -> UIApp u Text
textNew Maybe String
s
    Attribute Int
pos <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew (Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int))
-> Int
-> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe String
s
    Attribute Int
offset <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Int
0
    Attribute Int
width <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Int
1

    Edit -> UIApp u Edit
forall (m :: * -> *) a. Monad m => a -> m a
return Edit :: Text -> Attribute Int -> Attribute Int -> Attribute Int -> Edit
Edit
        { _editParent :: Text
_editParent = Text
parent
        , _editCursorPos :: Attribute Int
_editCursorPos = Attribute Int
pos
        , _editXOffset :: Attribute Int
_editXOffset = Attribute Int
offset
        , _editWidth :: Attribute Int
_editWidth = Attribute Int
width
        }

editDraw :: Edit -> Drawing -> Int -> Int -> UIApp u ()
editDraw :: Edit -> Drawing -> Int -> Int -> UIApp u ()
editDraw Edit
edit Drawing
drawing Int
width Int
_ = do
    Edit -> (Edit -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Edit
edit Edit -> Attribute Int
_editWidth Int
width

    Maybe String
maybeText <- Edit
-> (Edit -> Attribute (Maybe String))
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text

    Color
fg <- Edit
-> (Edit -> Attribute Color)
-> ReaderT (AppConfig u) (StateT AppState IO) Color
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorForeground
    Color
bg <- Edit
-> (Edit -> Attribute Color)
-> ReaderT (AppConfig u) (StateT AppState IO) Color
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorBackground
    DrawStyle
style <- Edit
-> (Edit -> Attribute DrawStyle)
-> ReaderT (AppConfig u) (StateT AppState IO) DrawStyle
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute DrawStyle
forall w. WidgetClass w => w -> Attribute DrawStyle
colorStyle

    Drawing -> DrawingBuilder () -> UIApp u ()
forall (m :: * -> *) a.
MonadIO m =>
Drawing -> DrawingBuilder a -> m a
drawingRun Drawing
drawing (DrawingBuilder () -> UIApp u ())
-> DrawingBuilder () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ do
        Color -> Color -> DrawStyle -> DrawingBuilder ()
drawingSetAttrs Color
fg Color
bg DrawStyle
style
        DrawingBuilder ()
drawingClear
        case Maybe String
maybeText of
            Just String
_text -> do
                Int
pos <- Edit -> (Edit -> Attribute Int) -> ReaderT Drawing IO Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editCursorPos
                Int
offset <- Edit -> (Edit -> Attribute Int) -> ReaderT Drawing IO Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Edit
edit Edit -> Attribute Int
_editXOffset

                let s :: String
s = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
offset String
_text
                [(Char, Int)]
-> ((Char, Int) -> DrawingBuilder ()) -> DrawingBuilder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") [Int
0..]) (((Char, Int) -> DrawingBuilder ()) -> DrawingBuilder ())
-> ((Char, Int) -> DrawingBuilder ()) -> DrawingBuilder ()
forall a b. (a -> b) -> a -> b
$ \(Char
c, Int
i) ->
                    if Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
                        then Color
-> Color -> DrawStyle -> Int -> Int -> Char -> DrawingBuilder ()
drawingPutCharWithAttr Color
bg Color
fg DrawStyle
style Int
i Int
0 Char
c
                        else Int -> Int -> Char -> DrawingBuilder ()
drawingPutChar Int
i Int
0 Char
c

            Maybe String
Nothing ->
                Color
-> Color -> DrawStyle -> Int -> Int -> Char -> DrawingBuilder ()
drawingPutCharWithAttr Color
bg Color
fg DrawStyle
style Int
0 Int
0 Char
' '