module Cursor.Brick.TextField where

import Brick.Types as Brick
import Brick.Widgets.Core as Brick
import Cursor.Brick.Text
import Cursor.List.NonEmpty
import Cursor.TextField

-- | Make a textfield cursor widget with a blink-y box.
--
-- This function does not wrap lines.
-- Otherwise, because of the way indexes work, there would be rendering errors for text that crosses the side of the terminal.
selectedTextFieldCursorWidget :: n -> TextFieldCursor -> Widget n
selectedTextFieldCursorWidget :: n -> TextFieldCursor -> Widget n
selectedTextFieldCursorWidget n
n (TextFieldCursor NonEmptyCursor TextCursor Text
tfc) =
  (([Text] -> TextCursor -> [Text] -> Widget n)
 -> NonEmptyCursor TextCursor Text -> Widget n)
-> NonEmptyCursor TextCursor Text
-> ([Text] -> TextCursor -> [Text] -> Widget n)
-> Widget n
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Text] -> TextCursor -> [Text] -> Widget n)
-> NonEmptyCursor TextCursor Text -> Widget n
forall b a c. ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor NonEmptyCursor TextCursor Text
tfc (([Text] -> TextCursor -> [Text] -> Widget n) -> Widget n)
-> ([Text] -> TextCursor -> [Text] -> Widget n) -> Widget n
forall a b. (a -> b) -> a -> b
$ \[Text]
befores TextCursor
current [Text]
afters ->
    [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
      [[Widget n]] -> [Widget n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
textWidget [Text]
befores,
          [n -> TextCursor -> Widget n
forall n. n -> TextCursor -> Widget n
selectedTextCursorWidget n
n TextCursor
current],
          (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
textWidget [Text]
afters
        ]

-- | Make a textfield cursor widget without a blink-y box.
--
-- This function does not wrap lines .
textFieldCursorWidget :: TextFieldCursor -> Widget n
textFieldCursorWidget :: TextFieldCursor -> Widget n
textFieldCursorWidget (TextFieldCursor NonEmptyCursor TextCursor Text
tfc) =
  (([Text] -> TextCursor -> [Text] -> Widget n)
 -> NonEmptyCursor TextCursor Text -> Widget n)
-> NonEmptyCursor TextCursor Text
-> ([Text] -> TextCursor -> [Text] -> Widget n)
-> Widget n
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Text] -> TextCursor -> [Text] -> Widget n)
-> NonEmptyCursor TextCursor Text -> Widget n
forall b a c. ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor NonEmptyCursor TextCursor Text
tfc (([Text] -> TextCursor -> [Text] -> Widget n) -> Widget n)
-> ([Text] -> TextCursor -> [Text] -> Widget n) -> Widget n
forall a b. (a -> b) -> a -> b
$ \[Text]
befores TextCursor
current [Text]
afters ->
    [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
      [[Widget n]] -> [Widget n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
textWidget [Text]
befores,
          [TextCursor -> Widget n
forall n. TextCursor -> Widget n
textCursorWidget TextCursor
current],
          (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
textWidget [Text]
afters
        ]