Zipper.hs

{-# 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
    { beforeCursor :: !Text
    -- ^ The text appearing before the cursor
    , afterCursor :: !Text
    -- ^ The text appearing after the cursor
    , cursor :: !Position
    -- ^ The cursor's position in the line of text, i.e. the length of 'beforeCursor'
    }
    deriving stock (Generic, Eq, Show)

-- | Modify the cursor position, updating the 'TextZipper' according to the
-- change.
moveCursor :: (Position -> Position) -> TextZipper -> TextZipper
moveCursor f t = case compare newCursor t.cursor of
    GT ->
        let (before, after)
                | absDelta > fromIntegral @Int64 maxBound = (t.afterCursor, "")
                | otherwise = Text.splitAt (fromIntegral absDelta) t.afterCursor
         in TextZipper
                { beforeCursor = t.beforeCursor <> before
                , afterCursor = after
                , cursor = t.cursor + fromIntegral (Text.length before)
                }
    LT ->
        let (before, after)
                | absDelta > fromIntegral @Int64 maxBound = ("", t.beforeCursor)
                | otherwise = splitAtEnd (fromIntegral absDelta) t.beforeCursor
         in TextZipper
                { beforeCursor = before
                , afterCursor = after <> t.afterCursor
                , cursor = t.cursor - fromIntegral (Text.length after)
                }
    EQ -> t
  where
    newCursor = f t.cursor
    absDelta
        | newCursor > t.cursor = newCursor - t.cursor
        | otherwise = t.cursor - newCursor
    splitAtEnd len t = (Text.dropEnd len t, Text.takeEnd len 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 i = moveCursor $ const i

instance Monoid TextZipper where
    mempty = TextZipper{beforeCursor = mempty, afterCursor = mempty, cursor = 0}

instance Semigroup TextZipper where
    a <> b = a{afterCursor = a.afterCursor <> toText 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{..} = has afterCursor || Text.null afterCursor && has beforeCursor
  where
    has (Text.unsnoc -> Just (_, '\n')) = True
    has _ = False

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

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

-- | The length of the entire 'TextZipper' structure.
length :: TextZipper -> Int64
length TextZipper{..} = Text.length beforeCursor + Text.length afterCursor

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

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

instance IsString TextZipper where
    fromString = fromText . fromString

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

-- | Create a 'TextZipper' by concatenating two 'Text' components, with the cursor between them.
fromParts :: Text -> Text -> TextZipper
fromParts beforeCursor afterCursor =
    TextZipper
        { cursor = fromIntegral $ Text.length beforeCursor
        , ..
        }

-- | Insert 'Text' before the current Cursor position, updating its position
-- according to the provided 'Text'\'s length.
insert :: Text -> TextZipper -> TextZipper
insert t TextZipper{..} =
    TextZipper
        { beforeCursor = beforeCursor <> t
        , cursor = cursor + fromIntegral (Text.length t)
        , ..
        }

splitBefore :: TextZipper -> (TextZipper, Maybe Char)
splitBefore t@TextZipper{..} =
    case Text.unsnoc beforeCursor of
        Nothing -> (t, Nothing)
        Just (beforeCursor, c) -> (TextZipper{cursor = cursor - 1, ..}, Just c)

splitAfter :: TextZipper -> (TextZipper, Maybe Char)
splitAfter t@TextZipper{..} =
    case Text.uncons afterCursor of
        Nothing -> (t, Nothing)
        Just (c, afterCursor) -> (TextZipper{..}, Just c)

-- | Delete the first character before the cursor, if any.
deleteBefore :: TextZipper -> TextZipper
deleteBefore = fst . splitBefore

-- | Delete the first character after the cursor, if any.
deleteAfter :: TextZipper -> TextZipper
deleteAfter = fst . splitAfter

-- | Decrement the cursor.
moveBackward :: TextZipper -> TextZipper
moveBackward = moveCursor boundedPred

-- | Increment the cursor.
moveForward :: TextZipper -> TextZipper
moveForward = moveCursor boundedSucc

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

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