{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- TODO: explicit export list for Data.Text.Lazy.Zipper
module Data.Text.Lazy.Zipper where

import Data.Int (Int64)
import Data.String (IsString (fromString))
import Data.Text.Lazy (Text)
import Data.Text.Lazy qualified as Text
import GHC.Generics (Generic)
import Util
import Prelude

type Position = Word

data TextZipper = TextZipper
    { TextZipper -> Text
beforeCursor :: !Text
    -- ^ The text appearing before the cursor
    , TextZipper -> Text
afterCursor :: !Text
    -- ^ The text appearing after the cursor
    , TextZipper -> Position
cursor :: !Position
    -- ^ The cursor's position in the line of text, i.e. the length of 'beforeCursor'
    }
    deriving stock ((forall x. TextZipper -> Rep TextZipper x)
-> (forall x. Rep TextZipper x -> TextZipper) -> Generic TextZipper
forall x. Rep TextZipper x -> TextZipper
forall x. TextZipper -> Rep TextZipper x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextZipper -> Rep TextZipper x
from :: forall x. TextZipper -> Rep TextZipper x
$cto :: forall x. Rep TextZipper x -> TextZipper
to :: forall x. Rep TextZipper x -> TextZipper
Generic, 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, 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)

-- | Modify the cursor position, updating the 'TextZipper' according to the
-- change.
moveCursor :: (Position -> Position) -> TextZipper -> TextZipper
moveCursor :: (Position -> Position) -> TextZipper -> TextZipper
moveCursor Position -> Position
f TextZipper
t = case Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
newCursor TextZipper
t.cursor of
    Ordering
GT ->
        let (Text
before, Text
after)
                | Position
absDelta Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 Int64
forall a. Bounded a => a
maxBound = (TextZipper
t.afterCursor, Text
"")
                | Bool
otherwise = Int64 -> Text -> (Text, Text)
Text.splitAt (Position -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
absDelta) TextZipper
t.afterCursor
         in TextZipper
                { $sel:beforeCursor:TextZipper :: Text
beforeCursor = TextZipper
t.beforeCursor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
before
                , $sel:afterCursor:TextZipper :: Text
afterCursor = Text
after
                , $sel:cursor:TextZipper :: Position
cursor = TextZipper
t.cursor Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int64 -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
Text.length Text
before)
                }
    Ordering
LT ->
        let (Text
before, Text
after)
                | Position
absDelta Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 Int64
forall a. Bounded a => a
maxBound = (Text
"", TextZipper
t.beforeCursor)
                | Bool
otherwise = Int64 -> Text -> (Text, Text)
splitAtEnd (Position -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
absDelta) TextZipper
t.beforeCursor
         in TextZipper
                { $sel:beforeCursor:TextZipper :: Text
beforeCursor = Text
before
                , $sel:afterCursor:TextZipper :: Text
afterCursor = Text
after Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TextZipper
t.afterCursor
                , $sel:cursor:TextZipper :: Position
cursor = TextZipper
t.cursor Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int64 -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
Text.length Text
after)
                }
    Ordering
EQ -> TextZipper
t
  where
    newCursor :: Position
newCursor = Position -> Position
f TextZipper
t.cursor
    absDelta :: Position
absDelta
        | Position
newCursor Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> TextZipper
t.cursor = Position
newCursor Position -> Position -> Position
forall a. Num a => a -> a -> a
- TextZipper
t.cursor
        | Bool
otherwise = TextZipper
t.cursor Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
newCursor
    splitAtEnd :: Int64 -> Text -> (Text, Text)
splitAtEnd Int64
len Text
t = (Int64 -> Text -> Text
Text.dropEnd Int64
len Text
t, Int64 -> Text -> Text
Text.takeEnd Int64
len Text
t)

-- | Set the position of the Cursor to a specific value. The state of the TextZipper
-- will be updated to match the new position.
setCursor :: Position -> TextZipper -> TextZipper
setCursor :: Position -> TextZipper -> TextZipper
setCursor Position
i = (Position -> Position) -> TextZipper -> TextZipper
moveCursor ((Position -> Position) -> TextZipper -> TextZipper)
-> (Position -> Position) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Position
forall a b. a -> b -> a
const Position
i

instance Monoid TextZipper where
    mempty :: TextZipper
mempty = TextZipper{$sel:beforeCursor:TextZipper :: Text
beforeCursor = Text
forall a. Monoid a => a
mempty, $sel:afterCursor:TextZipper :: Text
afterCursor = Text
forall a. Monoid a => a
mempty, $sel:cursor:TextZipper :: Position
cursor = Position
0}

instance Semigroup TextZipper where
    TextZipper
a <> :: TextZipper -> TextZipper -> TextZipper
<> TextZipper
b = TextZipper
a{$sel:afterCursor:TextZipper :: Text
afterCursor = TextZipper
a.afterCursor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TextZipper -> Text
toText TextZipper
b}

-- | Whether the 'TextZipper' has a trailing newline. A trailing newline is
-- present if the last character of the line is a '\\n' character.
hasTrailingNewline :: TextZipper -> Bool
hasTrailingNewline :: TextZipper -> Bool
hasTrailingNewline TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} = Text -> Bool
has Text
afterCursor Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
afterCursor Bool -> Bool -> Bool
&& Text -> Bool
has Text
beforeCursor
  where
    has :: Text -> Bool
has (Text -> Maybe (Text, Char)
Text.unsnoc -> Just (Text
_, Char
'\n')) = Bool
True
    has Text
_ = Bool
False

-- | Helper function to remove the last character of the provided text iff it is
-- a trailing newline.
removeTrailingNewline :: Text -> Text
removeTrailingNewline :: Text -> Text
removeTrailingNewline (Text -> Maybe (Text, Char)
Text.unsnoc -> Just (Text
t, Char
'\n')) = Text
t
removeTrailingNewline Text
t = Text
t

-- | Whether the provided 'TextZipper' is empty.
null :: TextZipper -> Bool
null :: TextZipper -> Bool
null TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} = Text -> Bool
Text.null Text
beforeCursor Bool -> Bool -> Bool
&& Text -> Bool
Text.null Text
afterCursor

-- | The length of the entire 'TextZipper' structure.
length :: TextZipper -> Int64
length :: TextZipper -> Int64
length TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} = Text -> Int64
Text.length Text
beforeCursor Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Text -> Int64
Text.length Text
afterCursor

-- | Convert a 'TextZipper' to 'Text'. Effectively 'beforeCursor <> afterCursor', but slightly more efficient in edge cases.
toText :: TextZipper -> Text
toText :: TextZipper -> Text
toText TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..}
    | Text -> Bool
Text.null Text
afterCursor = Text
beforeCursor
    | Bool
otherwise = Text
beforeCursor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
afterCursor

-- | Create a 'TextZipper' from a 'Text' source, with the cursor at the end of it.
fromText :: Text -> TextZipper
fromText :: Text -> TextZipper
fromText = (Text -> Text -> TextZipper) -> Text -> Text -> TextZipper
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> TextZipper
fromParts Text
forall a. Monoid a => a
mempty

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
forall a. IsString a => String -> a
fromString

-- | Create a 'TextZipper' from a 'Text' source, with the cursor at the specified position.
fromTextAt :: Text -> Position -> TextZipper
fromTextAt :: Text -> Position -> TextZipper
fromTextAt Text
t (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
0 -> Position -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int64
i) = (Text -> Text -> TextZipper) -> (Text, Text) -> TextZipper
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> TextZipper
fromParts ((Text, Text) -> TextZipper) -> (Text, Text) -> TextZipper
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> (Text, Text)
Text.splitAt Int64
i Text
t

-- | Create a 'TextZipper' by concatenating two 'Text' components, with the cursor between them.
fromParts :: Text -> Text -> TextZipper
fromParts :: Text -> Text -> TextZipper
fromParts Text
beforeCursor Text
afterCursor =
    TextZipper
        { $sel:cursor:TextZipper :: Position
cursor = Int64 -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Position) -> Int64 -> Position
forall a b. (a -> b) -> a -> b
$ Text -> Int64
Text.length Text
beforeCursor
        , Text
$sel:beforeCursor:TextZipper :: Text
$sel:afterCursor:TextZipper :: Text
beforeCursor :: Text
afterCursor :: Text
..
        }

-- | Insert 'Text' before the current Cursor position, updating its position
-- according to the provided 'Text'\'s length.
insert :: Text -> TextZipper -> TextZipper
insert :: Text -> TextZipper -> TextZipper
insert Text
t TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} =
    TextZipper
        { $sel:beforeCursor:TextZipper :: Text
beforeCursor = Text
beforeCursor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
        , $sel:cursor:TextZipper :: Position
cursor = Position
cursor Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int64 -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
Text.length Text
t)
        , Text
$sel:afterCursor:TextZipper :: Text
afterCursor :: Text
..
        }

splitBefore :: TextZipper -> (TextZipper, Maybe Char)
splitBefore :: TextZipper -> (TextZipper, Maybe Char)
splitBefore t :: TextZipper
t@TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} =
    case Text -> Maybe (Text, Char)
Text.unsnoc Text
beforeCursor of
        Maybe (Text, Char)
Nothing -> (TextZipper
t, Maybe Char
forall a. Maybe a
Nothing)
        Just (Text
beforeCursor, Char
c) -> (TextZipper{$sel:cursor:TextZipper :: Position
cursor = Position
cursor Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1, Text
$sel:beforeCursor:TextZipper :: Text
$sel:afterCursor:TextZipper :: Text
afterCursor :: Text
beforeCursor :: Text
..}, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)

splitAfter :: TextZipper -> (TextZipper, Maybe Char)
splitAfter :: TextZipper -> (TextZipper, Maybe Char)
splitAfter t :: TextZipper
t@TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: TextZipper -> Text
$sel:afterCursor:TextZipper :: TextZipper -> Text
$sel:cursor:TextZipper :: TextZipper -> Position
beforeCursor :: Text
afterCursor :: Text
cursor :: Position
..} =
    case Text -> Maybe (Char, Text)
Text.uncons Text
afterCursor of
        Maybe (Char, Text)
Nothing -> (TextZipper
t, Maybe Char
forall a. Maybe a
Nothing)
        Just (Char
c, Text
afterCursor) -> (TextZipper{Position
Text
$sel:beforeCursor:TextZipper :: Text
$sel:afterCursor:TextZipper :: Text
$sel:cursor:TextZipper :: Position
beforeCursor :: Text
cursor :: Position
afterCursor :: Text
..}, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)

-- | Delete the first character before the cursor, if any.
deleteBefore :: TextZipper -> TextZipper
deleteBefore :: TextZipper -> TextZipper
deleteBefore = (TextZipper, Maybe Char) -> TextZipper
forall a b. (a, b) -> a
fst ((TextZipper, Maybe Char) -> TextZipper)
-> (TextZipper -> (TextZipper, Maybe Char))
-> TextZipper
-> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper -> (TextZipper, Maybe Char)
splitBefore

-- | Delete the first character after the cursor, if any.
deleteAfter :: TextZipper -> TextZipper
deleteAfter :: TextZipper -> TextZipper
deleteAfter = (TextZipper, Maybe Char) -> TextZipper
forall a b. (a, b) -> a
fst ((TextZipper, Maybe Char) -> TextZipper)
-> (TextZipper -> (TextZipper, Maybe Char))
-> TextZipper
-> TextZipper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper -> (TextZipper, Maybe Char)
splitAfter

-- | Decrement the cursor.
moveBackward :: TextZipper -> TextZipper
moveBackward :: TextZipper -> TextZipper
moveBackward = (Position -> Position) -> TextZipper -> TextZipper
moveCursor Position -> Position
forall a. (Eq a, Bounded a, Enum a) => a -> a
boundedPred

-- | Increment the cursor.
moveForward :: TextZipper -> TextZipper
moveForward :: TextZipper -> TextZipper
moveForward = (Position -> Position) -> TextZipper -> TextZipper
moveCursor Position -> Position
forall a. (Eq a, Bounded a, Enum a) => a -> a
boundedSucc

-- | Move the cursor to the beginning of the text.
moveStart :: TextZipper -> TextZipper
moveStart :: TextZipper -> TextZipper
moveStart = Position -> TextZipper -> TextZipper
setCursor Position
forall a. Bounded a => a
minBound

-- | Move the cursor to the end of the text.
moveEnd :: TextZipper -> TextZipper
moveEnd :: TextZipper -> TextZipper
moveEnd = Position -> TextZipper -> TextZipper
setCursor Position
forall a. Bounded a => a
maxBound