-- 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 -- 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 = 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_linesBefore :: [Text] -- reversed , _textZipper_before :: Text , _textZipper_selected :: [Text] , _textZipper_after :: Text , _textZipper_linesAfter :: [Text] } deriving (Show, 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 = fromText . T.pack -- | Map a replacement function over the characters in a 'TextZipper' mapZipper :: (Char -> Char) -> TextZipper -> TextZipper mapZipper f (TextZipper lb b s a la) = TextZipper { _textZipper_linesBefore = fmap (T.map f) lb , _textZipper_before = T.map f b , _textZipper_selected = fmap (T.map f) s , _textZipper_after = T.map f a , _textZipper_linesAfter = fmap (T.map f) la } appendEnd :: [Text] -> Text -> [Text] appendEnd stuff addme = case stuff of [] -> [addme] (x:[]) -> [x <> addme] (x:xs) -> x : appendEnd xs addme -- | Move the cursor left one character (clearing the selection) left :: TextZipper -> TextZipper left = leftN 1 -- UNTESTED -- | Move the cursor left by the given number of characters (clearing the selection) leftN :: Int -> TextZipper -> TextZipper leftN n z@(TextZipper lb b [] a la) = if T.length b >= n then let n' = T.length b - n in TextZipper lb (T.take n' b) [] (T.drop n' b <> a) la else case lb of [] -> home z (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l [] "" ((b <> a) : la) leftN n (TextZipper lb b s a la) = leftN n $ TextZipper lb b [] newa newla where (newa, newla') = case s of [] -> (a, la) (x:[]) -> (x <> a, la) (x:xs) -> (x, appendEnd xs a) newla = newla' <> la -- | expand the selection to the left the given number of characters shiftLeftN :: TextZipper -> TextZipper shiftLeftN = undefined -- | Move the cursor to the left one word (clearing the selection) leftWord :: TextZipper -> TextZipper leftWord = undefined -- | Expand the selection to the left by one word shiftLeftWord :: TextZipper -> TextZipper shiftLeftWord = undefined -- | Move the cursor right one character (clearing the selection) right :: TextZipper -> TextZipper right = rightN 1 -- | Move the character right by the given number of characters (clearing the selection) rightN :: Int -> TextZipper -> TextZipper rightN n z@(TextZipper lb b s a la) = undefined -- | expand the selection to the right the given number of characters shiftRightN :: TextZipper -> TextZipper shiftRightN = undefined -- | Move the cursor to the right one word (clearing the selection) rightWord :: TextZipper -> TextZipper rightWord = undefined -- | Expand the selection to the right by one word rightLeftWord :: TextZipper -> TextZipper rightLeftWord = undefined -- | Clear the selection and move the cursor to the end of selection deselect :: TextZipper -> TextZipper deselect tz@(TextZipper lb b [] a la) = tz deselect (TextZipper lb b [x] a la) = TextZipper lb (b <> x) [] a la deselect (TextZipper lb b (x:(xs:xss)) a la) = TextZipper ((reverse $ NE.init xs') <> [b <> x] <> lb) (NE.last xs') [] a la where xs' = xs NE.:| xss -- | Move the cursor up one logical line (clearing the selection) up :: TextZipper -> TextZipper up (TextZipper [] b [] a la) = TextZipper [] "" [] (b <> a) la up (TextZipper (x:xs) b [] a la) = TextZipper xs b' [] a' ([b <> a] <> la) where (b', a') = T.splitAt (T.length b) x up tz@(TextZipper lb b s a la) = up $ deselect tz -- | Move the cursor down one logical line (clearing the selection) down :: TextZipper -> TextZipper down (TextZipper lb b [] a []) = TextZipper lb (b <> a) [] "" [] down (TextZipper lb b [] a (x:xs)) = TextZipper ([b <> a] <> lb) b' [] a' xs where (b', a') = T.splitAt (T.length b) x down tz@(TextZipper lb b s a la) = down $ deselect tz -- | Move the cursor up by the given number of lines (clearing the selection) pageUp :: Int -> TextZipper -> TextZipper pageUp pageSize z = undefined -- | Move the cursor down by the given number of lines (clearing the selection) pageDown :: Int -> TextZipper -> TextZipper pageDown pageSize z = undefined -- | Move the cursor to the beginning of the current logical line (clearing the selection) home :: TextZipper -> TextZipper home (TextZipper lb b [] a la) = TextZipper lb "" [] (b <> a) la home (TextZipper lb b (x:[]) a la) = TextZipper lb "" [] (b <> x <> a) la home (TextZipper lb b (x:(xs:xss)) a la) = TextZipper lb "" [] (b <> x) (NE.init xs' <> [NE.last xs' <> a] <> la) where xs' = xs NE.:| xss -- | Move the cursor to the end of the current logical line (clearing the selection) end :: TextZipper -> TextZipper end (TextZipper lb b [] a la) = TextZipper lb (b <> a) [] "" la end (TextZipper lb b (x:[]) a la) = TextZipper lb (b <> x <> a) [] "" la end (TextZipper lb b (x:(xs:xss)) a la) =TextZipper (lb <> ([b <> x] <> NE.init xs')) (NE.last xs' <> a) [] "" la where xs' = xs NE.:| xss -- | Move the cursor to the top of the document (clearing the selection) top :: TextZipper -> TextZipper top tz@(TextZipper [] "" [] _ _) = tz top (TextZipper [x] "" [] a la) = TextZipper [] "" [] x (a:la) top (TextZipper (x:xs) "" [] a la) = TextZipper [] "" [] (NE.last xs') ((reverse $ NE.init xs') <> (a:la)) where xs' = x NE.:| xs top tz = top $ home tz -- | Insert a character at the current cursor position (overwriting the selection) insertChar :: Char -> TextZipper -> TextZipper insertChar i = insert (T.singleton i) -- | Insert text at the current cursor position (overwriting the selection) insert :: Text -> TextZipper -> TextZipper insert i z@(TextZipper lb b s a la) = case T.split (=='\n') i of [] -> z (x:xs) -> undefined -- | Delete the selection deleteSelection :: TextZipper -> TextZipper deleteSelection = undefined -- | Delete the selection or the character to the left of the cursor if there was no selection deleteLeft :: TextZipper-> TextZipper deleteLeft z@(TextZipper lb b s a la) = undefined -- | Delete the selection to the character to the right of the cursor if there was no selection deleteRight :: TextZipper -> TextZipper deleteRight z@(TextZipper lb b s a la) = 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 lb b s a la) = undefined -- | Insert up to n spaces to get to the next logical column that is a multiple of n tab :: Int -> TextZipper -> TextZipper tab n (TextZipper _ b s _ _) = undefined -- | The plain text contents of the zipper value :: TextZipper -> Text value (TextZipper lb b s a la) = undefined -- | The empty zipper empty :: TextZipper empty = TextZipper [] "" [] "" [] -- | Constructs a zipper with the given contents. The cursor is placed after the contents. fromText :: Text -> TextZipper fromText = flip insert empty -- | Text alignment type data TextAlignment = TextAlignment_Left | TextAlignment_Right | TextAlignment_Center deriving (Eq, 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 :: [[Text]] -- outer is logical lines, inner list is display lines created due to wrapping logical lines to display width , _displayLines_offsetMap :: OffsetMapWithAlignment -- note that the row index (key) of OffsetMapWithAlignment counts display lines which includes logical lines , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner , _displayLines_selectionCount :: Int } deriving (Eq, 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 add x y dl tz = 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 = undefined