{-# OPTIONS_GHC -Wno-name-shadowing #-}
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
, TextZipper -> Text
afterCursor :: !Text
, TextZipper -> Position
cursor :: !Position
}
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)
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)
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}
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
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
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
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
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
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
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
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 -> 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)
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
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
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
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
moveStart :: TextZipper -> TextZipper
moveStart :: TextZipper -> TextZipper
moveStart = Position -> TextZipper -> TextZipper
setCursor Position
forall a. Bounded a => a
minBound
moveEnd :: TextZipper -> TextZipper
moveEnd :: TextZipper -> TextZipper
moveEnd = Position -> TextZipper -> TextZipper
setCursor Position
forall a. Bounded a => a
maxBound