-- WIP
module Potato.Data.Text.Zipper2 where

import           Prelude

import Control.Exception (assert)
import Control.Monad.State (evalState, get, put)
import Data.Char (isSpace)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.String
import Data.Text (Text)
import Data.Text.Internal (Text(..), text)
import Data.Text.Internal.Fusion (stream)
import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))
import Data.Text.Unsafe
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Text as T

import Graphics.Text.Width (wcwidth)

import qualified Data.List.NonEmpty as NE

-- | Get the display width of a 'Char'. "Full width" and "wide" characters
-- take two columns and everything else takes a single column. See
-- <https://www.unicode.org/reports/tr11/> for more information
-- This is implemented using wcwidth from Vty such that it matches what will
-- be displayed on the terminal. Note that this method can change depending
-- on how vty is configed. Please see vty documentation for details.
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth = Char -> Int
wcwidth

-- TERMINOLOGY
-- selection: the portion of the TextZipper that is selected
-- cursor: the cursor is defined as the begining and end of the selection
-- word: a word is defined as a contiguous set of non-whitespace characters in the TextZipper
--   the position one word to the left/right of the cursor is the position after all non-white space to the left/right of the cursor until it hits non-whitespace character followde by all contiguous non-whitespace characters in that direction
-- logical lines: logical lines of the TextZipper are lines created by explicit new line characters
-- display lines: display lines of a TextZipper ar the lines rendered to screen
--   display lines are bound by some width
--

data TextZipper = TextZipper
  { TextZipper -> [Text]
_textZipper_linesBefore :: [Text] -- reversed
  , TextZipper -> Text
_textZipper_before :: Text
  , TextZipper -> [Text]
_textZipper_selected :: [Text]
  , TextZipper -> Text
_textZipper_after :: Text
  , TextZipper -> [Text]
_textZipper_linesAfter :: [Text]
  }
  deriving (Int -> TextZipper -> ShowS
[TextZipper] -> ShowS
TextZipper -> String
(Int -> TextZipper -> ShowS)
-> (TextZipper -> String)
-> ([TextZipper] -> ShowS)
-> Show TextZipper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextZipper -> ShowS
showsPrec :: Int -> TextZipper -> ShowS
$cshow :: TextZipper -> String
show :: TextZipper -> String
$cshowList :: [TextZipper] -> ShowS
showList :: [TextZipper] -> ShowS
Show, TextZipper -> TextZipper -> Bool
(TextZipper -> TextZipper -> Bool)
-> (TextZipper -> TextZipper -> Bool) -> Eq TextZipper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextZipper -> TextZipper -> Bool
== :: TextZipper -> TextZipper -> Bool
$c/= :: TextZipper -> TextZipper -> Bool
/= :: TextZipper -> TextZipper -> Bool
Eq)

-- example:
--
-- this is an example content of
-- a text zipper
-- the capital TEXT IS THE SELECTED
-- PORTION of the
-- text zipper
--
-- _textZipper_linesBefore = ["this is an example content of", "a text zipper"]
-- _textZipper_before = "the capital "
-- _textZipper_selected = ["TEXT IS THE SELECTED", "PORTION"]
-- _textZipper_after = " of the"
-- _textZipper_linesAfter = ["text zipper"]

instance IsString TextZipper where
  fromString :: String -> TextZipper
fromString = Text -> TextZipper
fromText (Text -> TextZipper) -> (String -> Text) -> String -> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Map a replacement function over the characters in a 'TextZipper'
mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
mapZipper Char -> Char
f (TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper
  { _textZipper_linesBefore :: [Text]
_textZipper_linesBefore = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> Text -> Text
T.map Char -> Char
f) [Text]
lb
  , _textZipper_before :: Text
_textZipper_before = (Char -> Char) -> Text -> Text
T.map Char -> Char
f Text
b
  , _textZipper_selected :: [Text]
_textZipper_selected = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> Text -> Text
T.map Char -> Char
f) [Text]
s
  , _textZipper_after :: Text
_textZipper_after = (Char -> Char) -> Text -> Text
T.map Char -> Char
f Text
a
  , _textZipper_linesAfter :: [Text]
_textZipper_linesAfter = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> Text -> Text
T.map Char -> Char
f) [Text]
la
  }

appendEnd :: [Text] -> Text -> [Text]
appendEnd :: [Text] -> Text -> [Text]
appendEnd [Text]
stuff Text
addme = case [Text]
stuff of
  [] -> [Text
addme]
  (Text
x:[]) -> [Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addme]
  (Text
x:[Text]
xs) -> Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> Text -> [Text]
appendEnd [Text]
xs Text
addme

-- | Move the cursor left one character (clearing the selection)
left :: TextZipper -> TextZipper
left :: TextZipper -> TextZipper
left = Int -> TextZipper -> TextZipper
leftN Int
1

-- UNTESTED
-- | Move the cursor left by the given number of characters (clearing the selection)
leftN :: Int -> TextZipper -> TextZipper
leftN :: Int -> TextZipper -> TextZipper
leftN Int
n z :: TextZipper
z@(TextZipper [Text]
lb Text
b [] Text
a [Text]
la) =
  if Text -> Int
T.length Text
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
    then
      let n' :: Int
n' = Text -> Int
T.length Text
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
      in  [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Int -> Text -> Text
T.take Int
n' Text
b) [] (Int -> Text -> Text
T.drop Int
n' Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [Text]
la
    else case [Text]
lb of
           [] -> TextZipper -> TextZipper
home TextZipper
z
           (Text
l:[Text]
ls) -> Int -> TextZipper -> TextZipper
leftN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
ls Text
l [] Text
"" ((Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
la)
leftN Int
n (TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = Int -> TextZipper -> TextZipper
leftN Int
n (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
b [] Text
newa [Text]
newla  where
  (Text
newa, [Text]
newla') = case [Text]
s of
    [] -> (Text
a, [Text]
la)
    (Text
x:[]) -> (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a, [Text]
la)
    (Text
x:[Text]
xs) -> (Text
x, [Text] -> Text -> [Text]
appendEnd [Text]
xs Text
a)
  newla :: [Text]
newla = [Text]
newla' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
la


-- | expand the selection to the left the given number of characters
shiftLeftN :: TextZipper -> TextZipper
shiftLeftN :: TextZipper -> TextZipper
shiftLeftN = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Move the cursor to the left one word (clearing the selection)
leftWord :: TextZipper -> TextZipper
leftWord :: TextZipper -> TextZipper
leftWord = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Expand the selection to the left by one word
shiftLeftWord :: TextZipper -> TextZipper
shiftLeftWord :: TextZipper -> TextZipper
shiftLeftWord = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined


-- | Move the cursor right one character (clearing the selection)
right :: TextZipper -> TextZipper
right :: TextZipper -> TextZipper
right = Int -> TextZipper -> TextZipper
rightN Int
1

-- | Move the character right by the given number of characters (clearing the selection)
rightN :: Int -> TextZipper -> TextZipper
rightN :: Int -> TextZipper -> TextZipper
rightN Int
n z :: TextZipper
z@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper
forall a. HasCallStack => a
undefined

-- | expand the selection to the right the given number of characters
shiftRightN :: TextZipper -> TextZipper
shiftRightN :: TextZipper -> TextZipper
shiftRightN = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Move the cursor to the right one word (clearing the selection)
rightWord :: TextZipper -> TextZipper
rightWord :: TextZipper -> TextZipper
rightWord = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Expand the selection to the right by one word
rightLeftWord :: TextZipper -> TextZipper
rightLeftWord :: TextZipper -> TextZipper
rightLeftWord = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Clear the selection and move the cursor to the end of selection
deselect :: TextZipper -> TextZipper
deselect :: TextZipper -> TextZipper
deselect tz :: TextZipper
tz@(TextZipper [Text]
lb Text
b []           Text
a [Text]
la) = TextZipper
tz
deselect    (TextZipper [Text]
lb Text
b [Text
x]          Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) [] Text
a [Text]
la
deselect    (TextZipper [Text]
lb Text
b (Text
x:(Text
xs:[Text]
xss)) Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper (([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Text
xs') [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
lb) (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.last NonEmpty Text
xs') [] Text
a [Text]
la where
                xs' :: NonEmpty Text
xs' = Text
xs Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NE.:| [Text]
xss

-- | Move the cursor up one logical line (clearing the selection)
up ::  TextZipper -> TextZipper
up :: TextZipper -> TextZipper
up    (TextZipper [] Text
b [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" [] (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [Text]
la
up    (TextZipper (Text
x:[Text]
xs) Text
b [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
xs Text
b' [] Text
a' ([Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
la) where
        (Text
b', Text
a') = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
b) Text
x
up tz :: TextZipper
tz@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper -> TextZipper
up (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
deselect TextZipper
tz

-- | Move the cursor down one logical line (clearing the selection)
down :: TextZipper -> TextZipper
down :: TextZipper -> TextZipper
down    (TextZipper [Text]
lb Text
b []  Text
a []) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [] Text
"" []
down    (TextZipper [Text]
lb Text
b [] Text
a (Text
x:[Text]
xs)) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper ([Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
lb) Text
b' [] Text
a' [Text]
xs where
          (Text
b', Text
a') = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
b) Text
x
down tz :: TextZipper
tz@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper -> TextZipper
down (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
deselect TextZipper
tz

-- | Move the cursor up by the given number of lines (clearing the selection)
pageUp :: Int -> TextZipper -> TextZipper
pageUp :: Int -> TextZipper -> TextZipper
pageUp Int
pageSize TextZipper
z = TextZipper
forall a. HasCallStack => a
undefined

-- | Move the cursor down by the given number of lines (clearing the selection)
pageDown :: Int -> TextZipper -> TextZipper
pageDown :: Int -> TextZipper -> TextZipper
pageDown Int
pageSize TextZipper
z = TextZipper
forall a. HasCallStack => a
undefined

-- | Move the cursor to the beginning of the current logical line (clearing the selection)
home :: TextZipper -> TextZipper
home :: TextZipper -> TextZipper
home (TextZipper [Text]
lb Text
b [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
"" [] (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [Text]
la
home (TextZipper [Text]
lb Text
b (Text
x:[]) Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
"" [] (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [Text]
la
home (TextZipper [Text]
lb Text
b (Text
x:(Text
xs:[Text]
xss)) Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
"" [] (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Text
xs' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.last NonEmpty Text
xs' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
la) where
   xs' :: NonEmpty Text
xs' = Text
xs Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NE.:| [Text]
xss

-- | Move the cursor to the end of the current logical line (clearing the selection)
end :: TextZipper -> TextZipper
end :: TextZipper -> TextZipper
end (TextZipper [Text]
lb Text
b [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [] Text
"" [Text]
la
end (TextZipper [Text]
lb Text
b (Text
x:[]) Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [] Text
"" [Text]
la
end (TextZipper [Text]
lb Text
b (Text
x:(Text
xs:[Text]
xss)) Text
a [Text]
la) =[Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper ([Text]
lb [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ([Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Text
xs')) (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.last NonEmpty Text
xs' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [] Text
"" [Text]
la where
   xs' :: NonEmpty Text
xs' = Text
xs Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NE.:| [Text]
xss

-- | Move the cursor to the top of the document (clearing the selection)
top :: TextZipper -> TextZipper
top :: TextZipper -> TextZipper
top tz :: TextZipper
tz@(TextZipper [] Text
"" [] Text
_ [Text]
_) = TextZipper
tz
top (TextZipper [Text
x]    Text
"" [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" [] Text
x (Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
la)
top (TextZipper (Text
x:[Text]
xs) Text
"" [] Text
a [Text]
la) = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" [] (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.last NonEmpty Text
xs') (([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Text
xs') [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text
aText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
la)) where
    xs' :: NonEmpty Text
xs' = Text
x Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NE.:| [Text]
xs
top TextZipper
tz = TextZipper -> TextZipper
top (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
home TextZipper
tz

-- | Insert a character at the current cursor position (overwriting the selection)
insertChar :: Char -> TextZipper -> TextZipper
insertChar :: Char -> TextZipper -> TextZipper
insertChar Char
i = Text -> TextZipper -> TextZipper
insert (Char -> Text
T.singleton Char
i)

-- | Insert text at the current cursor position (overwriting the selection)
insert :: Text -> TextZipper -> TextZipper
insert :: Text -> TextZipper -> TextZipper
insert Text
i z :: TextZipper
z@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
i of
  [] -> TextZipper
z
  (Text
x:[Text]
xs) -> TextZipper
forall a. HasCallStack => a
undefined

-- | Delete the selection
deleteSelection :: TextZipper -> TextZipper
deleteSelection :: TextZipper -> TextZipper
deleteSelection = TextZipper -> TextZipper
forall a. HasCallStack => a
undefined

-- | Delete the selection or the character to the left of the cursor if there was no selection
deleteLeft :: TextZipper-> TextZipper
deleteLeft :: TextZipper -> TextZipper
deleteLeft z :: TextZipper
z@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper
forall a. HasCallStack => a
undefined

-- | Delete the selection to the character to the right of the cursor if there was no selection
deleteRight :: TextZipper -> TextZipper
deleteRight :: TextZipper -> TextZipper
deleteRight z :: TextZipper
z@(TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper
forall a. HasCallStack => a
undefined

-- | Delete the selection and the word to the left of the cursor and the selection.
-- When deleting the word to the left of the selection, deletes all whitespace until it finds a non-whitespace character, and then deletes contiguous non-whitespace characters.
deleteLeftWord :: TextZipper -> TextZipper
deleteLeftWord :: TextZipper -> TextZipper
deleteLeftWord (TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = TextZipper
forall a. HasCallStack => a
undefined

-- | Insert up to n spaces to get to the next logical column that is a multiple of n
tab :: Int -> TextZipper -> TextZipper
tab :: Int -> TextZipper -> TextZipper
tab Int
n (TextZipper [Text]
_ Text
b [Text]
s Text
_ [Text]
_) = TextZipper
forall a. HasCallStack => a
undefined

-- | The plain text contents of the zipper
value :: TextZipper -> Text
value :: TextZipper -> Text
value (TextZipper [Text]
lb Text
b [Text]
s Text
a [Text]
la) = Text
forall a. HasCallStack => a
undefined


-- | The empty zipper
empty :: TextZipper
empty :: TextZipper
empty = [Text] -> Text -> [Text] -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" [] Text
"" []

-- | Constructs a zipper with the given contents. The cursor is placed after the contents.
fromText :: Text -> TextZipper
fromText :: Text -> TextZipper
fromText = (Text -> TextZipper -> TextZipper)
-> TextZipper -> Text -> TextZipper
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> TextZipper -> TextZipper
insert TextZipper
empty


-- | Text alignment type
data TextAlignment =
  TextAlignment_Left
  | TextAlignment_Right
  | TextAlignment_Center
  deriving (TextAlignment -> TextAlignment -> Bool
(TextAlignment -> TextAlignment -> Bool)
-> (TextAlignment -> TextAlignment -> Bool) -> Eq TextAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAlignment -> TextAlignment -> Bool
== :: TextAlignment -> TextAlignment -> Bool
$c/= :: TextAlignment -> TextAlignment -> Bool
/= :: TextAlignment -> TextAlignment -> Bool
Eq, Int -> TextAlignment -> ShowS
[TextAlignment] -> ShowS
TextAlignment -> String
(Int -> TextAlignment -> ShowS)
-> (TextAlignment -> String)
-> ([TextAlignment] -> ShowS)
-> Show TextAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAlignment -> ShowS
showsPrec :: Int -> TextAlignment -> ShowS
$cshow :: TextAlignment -> String
show :: TextAlignment -> String
$cshowList :: [TextAlignment] -> ShowS
showList :: [TextAlignment] -> ShowS
Show)



-- A map from the row index of display line to a tuple (fst,snd) where
--   fst: leading empty spaces from left (may be negative) to adjust for alignment
--   snd: the text offset from the beginning of the document
type OffsetMapWithAlignment = Map Int (Int, Int)


-- | Information about the document as it is displayed (i.e., post-wrapping)
data DisplayLines = DisplayLines
  { DisplayLines -> [[Text]]
_displayLines_text :: [[Text]] -- outer is logical lines, inner list is display lines created due to wrapping logical lines to display width
  , DisplayLines -> OffsetMapWithAlignment
_displayLines_offsetMap :: OffsetMapWithAlignment -- note that the row index (key) of OffsetMapWithAlignment counts display lines which includes logical lines
  , DisplayLines -> (Int, Int)
_displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
  , DisplayLines -> Int
_displayLines_selectionCount :: Int
  }
  deriving (DisplayLines -> DisplayLines -> Bool
(DisplayLines -> DisplayLines -> Bool)
-> (DisplayLines -> DisplayLines -> Bool) -> Eq DisplayLines
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplayLines -> DisplayLines -> Bool
== :: DisplayLines -> DisplayLines -> Bool
$c/= :: DisplayLines -> DisplayLines -> Bool
/= :: DisplayLines -> DisplayLines -> Bool
Eq, Int -> DisplayLines -> ShowS
[DisplayLines] -> ShowS
DisplayLines -> String
(Int -> DisplayLines -> ShowS)
-> (DisplayLines -> String)
-> ([DisplayLines] -> ShowS)
-> Show DisplayLines
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayLines -> ShowS
showsPrec :: Int -> DisplayLines -> ShowS
$cshow :: DisplayLines -> String
show :: DisplayLines -> String
$cshowList :: [DisplayLines] -> ShowS
showList :: [DisplayLines] -> ShowS
Show)

-- TODO helper function to convert DisplayLines into lines before selection, selection lines, lines after selection

-- | Adjust the cursor and/or selection of the 'TextZipper' by the given display line coordinates
-- If the x coordinate is beyond the start/end of a line, the cursor is moved to the start/end of that line respectively
-- if `add` is true, the selection is expanded to the given position
-- if `add` is false, the selection is cleared and the cursor is moved to the given position
goToDisplayLinePosition :: Bool -> Int -> Int -> DisplayLines -> TextZipper -> TextZipper
goToDisplayLinePosition :: Bool -> Int -> Int -> DisplayLines -> TextZipper -> TextZipper
goToDisplayLinePosition Bool
add Int
x Int
y DisplayLines
dl TextZipper
tz = TextZipper
forall a. HasCallStack => a
undefined


-- | Given a `TextAlignment`, a width and a 'TextZipper', produce a `DisplayLines`
-- wrapping happens at word boundaries such that the most possible words fit into each display line
-- if a line can not be wrapped (i.e. it contains a word longer than the display width) then the line is cropped in the middle of the word as necessary
displayLinesWithAlignment
  :: TextAlignment
  -> Int -- ^ Width, used for wrapping
  -> TextZipper -- ^ The text input contents and cursor state
  -> DisplayLines
displayLinesWithAlignment :: TextAlignment -> Int -> TextZipper -> DisplayLines
displayLinesWithAlignment = TextAlignment -> Int -> TextZipper -> DisplayLines
forall a. HasCallStack => a
undefined