module Data.Text.Zipper where
import Control.Exception (assert)
import Control.Monad
import Control.Monad.State (evalState, get, put)
import Data.Char (isSpace)
import Data.Map (Map)
import Data.String
import qualified Data.List as L
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Internal (Text(..), text)
import Data.Text.Internal.Fusion (stream)
import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
import Data.Text.Unsafe
import Graphics.Text.Width (wcwidth)
data TextZipper = TextZipper
{ TextZipper -> [Text]
_textZipper_linesBefore :: [Text]
, TextZipper -> Text
_textZipper_before :: 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
showList :: [TextZipper] -> ShowS
$cshowList :: [TextZipper] -> ShowS
show :: TextZipper -> String
$cshow :: TextZipper -> String
showsPrec :: Int -> TextZipper -> ShowS
$cshowsPrec :: Int -> TextZipper -> ShowS
Show, TextZipper -> TextZipper -> Bool
(TextZipper -> TextZipper -> Bool)
-> (TextZipper -> TextZipper -> Bool) -> Eq TextZipper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextZipper -> TextZipper -> Bool
$c/= :: TextZipper -> TextZipper -> Bool
== :: TextZipper -> TextZipper -> Bool
$c== :: TextZipper -> TextZipper -> Bool
Eq)
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
mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
mapZipper Char -> Char
f (TextZipper [Text]
lb Text
b Text
a [Text]
la) = TextZipper :: [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper
{ _textZipper_linesBefore :: [Text]
_textZipper_linesBefore = (Text -> Text) -> [Text] -> [Text]
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_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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> Text -> Text
T.map Char -> Char
f) [Text]
la
}
left :: TextZipper -> TextZipper
left :: TextZipper -> TextZipper
left = Int -> TextZipper -> TextZipper
leftN Int
1
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] -> 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] -> 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)
right :: TextZipper -> TextZipper
right :: TextZipper -> TextZipper
right = Int -> TextZipper -> TextZipper
rightN Int
1
rightN :: Int -> TextZipper -> TextZipper
rightN :: Int -> TextZipper -> TextZipper
rightN Int
n z :: TextZipper
z@(TextZipper [Text]
lb Text
b Text
a [Text]
la) =
if Text -> Int
T.length Text
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
n Text
a) (Int -> Text -> Text
T.drop Int
n Text
a) [Text]
la
else case [Text]
la of
[] -> TextZipper -> TextZipper
end TextZipper
z
(Text
l:[Text]
ls) -> Int -> TextZipper -> TextZipper
rightN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
a 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] -> TextZipper
TextZipper ((Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
lb) Text
"" Text
l [Text]
ls
up :: TextZipper -> TextZipper
up :: TextZipper -> TextZipper
up z :: TextZipper
z@(TextZipper [Text]
lb Text
b Text
a [Text]
la) = case [Text]
lb of
[] -> TextZipper
z
(Text
l:[Text]
ls) ->
let (Text
b', Text
a') = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
b) Text
l
in [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
ls Text
b' Text
a' ((Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
la)
down :: TextZipper -> TextZipper
down :: TextZipper -> TextZipper
down z :: TextZipper
z@(TextZipper [Text]
lb Text
b Text
a [Text]
la) = case [Text]
la of
[] -> TextZipper
z
(Text
l:[Text]
ls) ->
let (Text
b', Text
a') = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
b) Text
l
in [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. a -> [a] -> [a]
: [Text]
lb) Text
b' Text
a' [Text]
ls
pageUp :: Int -> TextZipper -> TextZipper
pageUp :: Int -> TextZipper -> TextZipper
pageUp Int
pageSize TextZipper
z = if Int
pageSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then TextZipper
z
else Int -> TextZipper -> TextZipper
pageUp (Int
pageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
up TextZipper
z
pageDown :: Int -> TextZipper -> TextZipper
pageDown :: Int -> TextZipper -> TextZipper
pageDown Int
pageSize TextZipper
z = if Int
pageSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then TextZipper
z
else Int -> TextZipper -> TextZipper
pageDown (Int
pageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
down TextZipper
z
home :: TextZipper -> TextZipper
home :: TextZipper -> TextZipper
home (TextZipper [Text]
lb Text
b Text
a [Text]
la) = [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
end :: TextZipper -> TextZipper
end :: TextZipper -> TextZipper
end (TextZipper [Text]
lb Text
b Text
a [Text]
la) = [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
top :: TextZipper -> TextZipper
top :: TextZipper -> TextZipper
top (TextZipper [Text]
lb Text
b Text
a [Text]
la) = case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
lb of
[] -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a) [Text]
la
(Text
start:[Text]
rest) -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" Text
start ([Text]
rest [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> 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)
insertChar :: Char -> TextZipper -> TextZipper
insertChar :: Char -> TextZipper -> TextZipper
insertChar Char
i = Text -> TextZipper -> TextZipper
insert (Char -> Text
T.singleton Char
i)
insert :: Text -> TextZipper -> TextZipper
insert :: Text -> TextZipper -> TextZipper
insert Text
i z :: TextZipper
z@(TextZipper [Text]
lb Text
b 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
start:[Text]
rest) -> case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
rest of
[] -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb (Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
start) Text
a [Text]
la
(Text
l:[Text]
ls) -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper ([Text]
ls [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
start] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
lb) Text
l Text
a [Text]
la
deleteLeft :: TextZipper-> TextZipper
deleteLeft :: TextZipper -> TextZipper
deleteLeft z :: TextZipper
z@(TextZipper [Text]
lb Text
b Text
a [Text]
la) = case Text -> Maybe (Text, Char)
T.unsnoc Text
b of
Maybe (Text, Char)
Nothing -> case [Text]
lb of
[] -> TextZipper
z
(Text
l:[Text]
ls) -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
ls Text
l Text
a [Text]
la
Just (Text
b', Char
_) -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
b' Text
a [Text]
la
deleteRight :: TextZipper -> TextZipper
deleteRight :: TextZipper -> TextZipper
deleteRight z :: TextZipper
z@(TextZipper [Text]
lb Text
b Text
a [Text]
la) = case Text -> Maybe (Char, Text)
T.uncons Text
a of
Maybe (Char, Text)
Nothing -> case [Text]
la of
[] -> TextZipper
z
(Text
l:[Text]
ls) -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
b Text
l [Text]
ls
Just (Char
_, Text
a') -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb Text
b Text
a' [Text]
la
deleteLeftWord :: TextZipper -> TextZipper
deleteLeftWord :: TextZipper -> TextZipper
deleteLeftWord (TextZipper [Text]
lb Text
b Text
a [Text]
la) =
let b' :: Text
b' = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
b
in if Text -> Bool
T.null Text
b'
then case [Text]
lb of
[] -> [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [] Text
b' Text
a [Text]
la
(Text
l:[Text]
ls) -> TextZipper -> TextZipper
deleteLeftWord (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
ls Text
l Text
a [Text]
la
else [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [Text]
lb ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
b') Text
a [Text]
la
tab :: Int -> TextZipper -> TextZipper
tab :: Int -> TextZipper -> TextZipper
tab Int
n z :: TextZipper
z@(TextZipper [Text]
_ Text
b Text
_ [Text]
_) =
Text -> TextZipper -> TextZipper
insert (Int -> Text -> Text
T.replicate (Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) Text
" ") TextZipper
z
value :: TextZipper -> Text
value :: TextZipper -> Text
value (TextZipper [Text]
lb Text
b Text
a [Text]
la) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
lb
, [Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a]
, [Text]
la
]
empty :: TextZipper
empty :: TextZipper
empty = [Text] -> Text -> Text -> [Text] -> TextZipper
TextZipper [] Text
"" Text
"" []
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
data Span tag = Span tag Text
deriving (Span tag -> Span tag -> Bool
(Span tag -> Span tag -> Bool)
-> (Span tag -> Span tag -> Bool) -> Eq (Span tag)
forall tag. Eq tag => Span tag -> Span tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span tag -> Span tag -> Bool
$c/= :: forall tag. Eq tag => Span tag -> Span tag -> Bool
== :: Span tag -> Span tag -> Bool
$c== :: forall tag. Eq tag => Span tag -> Span tag -> Bool
Eq, Int -> Span tag -> ShowS
[Span tag] -> ShowS
Span tag -> String
(Int -> Span tag -> ShowS)
-> (Span tag -> String) -> ([Span tag] -> ShowS) -> Show (Span tag)
forall tag. Show tag => Int -> Span tag -> ShowS
forall tag. Show tag => [Span tag] -> ShowS
forall tag. Show tag => Span tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span tag] -> ShowS
$cshowList :: forall tag. Show tag => [Span tag] -> ShowS
show :: Span tag -> String
$cshow :: forall tag. Show tag => Span tag -> String
showsPrec :: Int -> Span tag -> ShowS
$cshowsPrec :: forall tag. Show tag => Int -> Span tag -> ShowS
Show)
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
/= :: TextAlignment -> TextAlignment -> Bool
$c/= :: TextAlignment -> TextAlignment -> Bool
== :: TextAlignment -> TextAlignment -> Bool
$c== :: 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
showList :: [TextAlignment] -> ShowS
$cshowList :: [TextAlignment] -> ShowS
show :: TextAlignment -> String
$cshow :: TextAlignment -> String
showsPrec :: Int -> TextAlignment -> ShowS
$cshowsPrec :: Int -> TextAlignment -> ShowS
Show)
type OffsetMapWithAlignment = Map Int (Int, Int)
data WrappedLine = WrappedLine
{ WrappedLine -> Text
_wrappedLines_text :: Text
, WrappedLine -> Bool
_wrappedLines_hiddenWhitespace :: Bool
, WrappedLine -> Int
_wrappedLines_offset :: Int
}
deriving (WrappedLine -> WrappedLine -> Bool
(WrappedLine -> WrappedLine -> Bool)
-> (WrappedLine -> WrappedLine -> Bool) -> Eq WrappedLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedLine -> WrappedLine -> Bool
$c/= :: WrappedLine -> WrappedLine -> Bool
== :: WrappedLine -> WrappedLine -> Bool
$c== :: WrappedLine -> WrappedLine -> Bool
Eq, Int -> WrappedLine -> ShowS
[WrappedLine] -> ShowS
WrappedLine -> String
(Int -> WrappedLine -> ShowS)
-> (WrappedLine -> String)
-> ([WrappedLine] -> ShowS)
-> Show WrappedLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrappedLine] -> ShowS
$cshowList :: [WrappedLine] -> ShowS
show :: WrappedLine -> String
$cshow :: WrappedLine -> String
showsPrec :: Int -> WrappedLine -> ShowS
$cshowsPrec :: Int -> WrappedLine -> ShowS
Show)
data DisplayLines tag = DisplayLines {
DisplayLines tag -> [[Span tag]]
_displayLines_spans :: [[Span tag]]
, DisplayLines tag -> OffsetMapWithAlignment
_displayLines_offsetMap :: OffsetMapWithAlignment
, DisplayLines tag -> (Int, Int)
_displayLines_cursorPos :: (Int, Int)
}
deriving (DisplayLines tag -> DisplayLines tag -> Bool
(DisplayLines tag -> DisplayLines tag -> Bool)
-> (DisplayLines tag -> DisplayLines tag -> Bool)
-> Eq (DisplayLines tag)
forall tag. Eq tag => DisplayLines tag -> DisplayLines tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayLines tag -> DisplayLines tag -> Bool
$c/= :: forall tag. Eq tag => DisplayLines tag -> DisplayLines tag -> Bool
== :: DisplayLines tag -> DisplayLines tag -> Bool
$c== :: forall tag. Eq tag => DisplayLines tag -> DisplayLines tag -> Bool
Eq, Int -> DisplayLines tag -> ShowS
[DisplayLines tag] -> ShowS
DisplayLines tag -> String
(Int -> DisplayLines tag -> ShowS)
-> (DisplayLines tag -> String)
-> ([DisplayLines tag] -> ShowS)
-> Show (DisplayLines tag)
forall tag. Show tag => Int -> DisplayLines tag -> ShowS
forall tag. Show tag => [DisplayLines tag] -> ShowS
forall tag. Show tag => DisplayLines tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayLines tag] -> ShowS
$cshowList :: forall tag. Show tag => [DisplayLines tag] -> ShowS
show :: DisplayLines tag -> String
$cshow :: forall tag. Show tag => DisplayLines tag -> String
showsPrec :: Int -> DisplayLines tag -> ShowS
$cshowsPrec :: forall tag. Show tag => Int -> DisplayLines tag -> ShowS
Show)
splitAtWidth :: Int -> Text -> (Text, Text)
splitAtWidth :: Int -> Text -> (Text, Text)
splitAtWidth Int
n t :: Text
t@(Text Array
arr Int
off Int
len)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text
T.empty, Text
t)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
textWidth Text
t = (Text
t, Text
T.empty)
| Bool
otherwise = let k :: Int
k = Int -> Text -> Int
characterIndexFromWidth Int
n Text
t
in (Array -> Int -> Int -> Text
text Array
arr Int
off Int
k, Array -> Int -> Int -> Text
text Array
arr (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k))
characterIndexFromWidth :: Int -> Text -> Int
characterIndexFromWidth :: Int -> Text -> Int
characterIndexFromWidth Int
n' t' :: Text
t'@(Text Array
_ Int
_ Int
len') = Int -> Int -> Int -> Int
loop Int
0 Int
0 Int
0
where
loop
:: Int
-> Int
-> Int
-> Int
loop :: Int -> Int -> Int -> Int
loop !Int
bytes !Int
li !Int
cumw
| Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len' = Int
liInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
| Int
cumw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n' = Int
li
| Bool
otherwise = Int -> Int -> Int -> Int
loop (Int
bytesInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
byteWidth) (Int
liInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
cumw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w)
where Iter Char
c Int
byteWidth = Text -> Int -> Iter
iter Text
t' Int
bytes
w :: Int
w = Char -> Int
charWidth Char
c
takeWidth :: Int -> Text -> Text
takeWidth :: Int -> Text -> Text
takeWidth Int
n = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> (Text, Text)
splitAtWidth Int
n
dropWidth :: Int -> Text -> Text
dropWidth :: Int -> Text -> Text
dropWidth Int
n = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> (Text, Text)
splitAtWidth Int
n
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth = Char -> Int
wcwidth
spansWidth :: [Span tag] -> Int
spansWidth :: [Span tag] -> Int
spansWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Span tag] -> [Int]) -> [Span tag] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span tag -> Int) -> [Span tag] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Span tag
_ Text
t) -> Text -> Int
textWidth Text
t)
spansLength :: [Span tag] -> Int
spansLength :: [Span tag] -> Int
spansLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Span tag] -> [Int]) -> [Span tag] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span tag -> Int) -> [Span tag] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Span tag
_ Text
t) -> Text -> Int
T.length Text
t)
textWidth :: Text -> Int
textWidth :: Text -> Int
textWidth Text
t = Stream Char -> Int
widthI (Text -> Stream Char
stream Text
t)
widthI :: Stream Char -> Int
widthI :: Stream Char -> Int
widthI (Stream s -> Step s Char
next s
s0 Size
_len) = Int -> s -> Int
loop_length Int
0 s
s0
where
loop_length :: Int -> s -> Int
loop_length !Int
z s
s = case s -> Step s Char
next s
s of
Step s Char
Done -> Int
z
Skip s
s' -> Int -> s -> Int
loop_length Int
z s
s'
Yield Char
c s
s' -> Int -> s -> Int
loop_length (Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
charWidth Char
c) s
s'
{-# INLINE[0] widthI #-}
charIndexAt :: Int -> Stream Char -> Int
charIndexAt :: Int -> Stream Char -> Int
charIndexAt Int
pos (Stream s -> Step s Char
next s
s0 Size
_len) = Int -> Int -> s -> Int
loop_length Int
0 Int
0 s
s0
where
loop_length :: Int -> Int -> s -> Int
loop_length Int
i !Int
z s
s = case s -> Step s Char
next s
s of
Step s Char
Done -> Int
i
Skip s
s' -> Int -> Int -> s -> Int
loop_length Int
i Int
z s
s'
Yield Char
c s
s' -> if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pos then Int
i else Int -> Int -> s -> Int
loop_length (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
w s
s' where
w :: Int
w = Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
charWidth Char
c
{-# INLINE[0] charIndexAt #-}
wordsWithWhitespace :: Text -> [Text]
wordsWithWhitespace :: Text -> [Text]
wordsWithWhitespace t :: Text
t@(Text Array
arr Int
off Int
len) = Int -> Int -> Bool -> [Text]
loop Int
0 Int
0 Bool
False
where
loop :: Int -> Int -> Bool -> [Text]
loop !Int
start !Int
n !Bool
wasSpace
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = [Array -> Int -> Int -> Text
Text Array
arr (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start) | Bool -> Bool
not (Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n)]
| Char -> Bool
isSpace Char
c = Int -> Int -> Bool -> [Text]
loop Int
start (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Bool
True
| Bool
wasSpace = Array -> Int -> Int -> Text
Text Array
arr (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> Bool -> [Text]
loop Int
n Int
n Bool
False
| Bool
otherwise = Int -> Int -> Bool -> [Text]
loop Int
start (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Bool
False
where Iter Char
c Int
d = Text -> Int -> Iter
iter Text
t Int
n
{-# INLINE wordsWithWhitespace #-}
splitWordsAtDisplayWidth :: Int -> [Text] -> [(Text, Bool)]
splitWordsAtDisplayWidth :: Int -> [Text] -> [(Text, Bool)]
splitWordsAtDisplayWidth Int
maxWidth [Text]
wwws = [(Text, Bool)] -> [(Text, Bool)]
forall a. [a] -> [a]
reverse ([(Text, Bool)] -> [(Text, Bool)])
-> [(Text, Bool)] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop [Text]
wwws Int
0 [] where
appendOut :: [(Text,Bool)] -> Text -> Bool -> [(Text,Bool)]
appendOut :: [(Text, Bool)] -> Text -> Bool -> [(Text, Bool)]
appendOut [] Text
t Bool
b = [(Text
t,Bool
b)]
appendOut ((Text
t',Bool
_):[(Text, Bool)]
ts') Text
t Bool
b = (Text
t'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
t,Bool
b) (Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
: [(Text, Bool)]
ts'
modifyOutForNewLine :: [(Text,Bool)] -> [(Text,Bool)]
modifyOutForNewLine :: [(Text, Bool)] -> [(Text, Bool)]
modifyOutForNewLine [] = String -> [(Text, Bool)]
forall a. HasCallStack => String -> a
error String
"should never happen"
modifyOutForNewLine ((Text
t',Bool
_):[(Text, Bool)]
ts) = case Text -> Maybe (Text, Char)
T.unsnoc Text
t' of
Maybe (Text, Char)
Nothing -> String -> [(Text, Bool)]
forall a. HasCallStack => String -> a
error String
"should never happen"
Just (Text
t,Char
lastChar) -> Bool -> [(Text, Bool)] -> [(Text, Bool)]
forall a. HasCallStack => Bool -> a -> a
assert (Char -> Bool
isSpace Char
lastChar) ([(Text, Bool)] -> [(Text, Bool)])
-> [(Text, Bool)] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ (Text
t,Bool
True)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:[(Text, Bool)]
ts
loop :: [Text] -> Int -> [(Text,Bool)] -> [(Text,Bool)]
loop :: [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop [] Int
_ [(Text, Bool)]
out = [(Text, Bool)]
out
loop (Text
x:[Text]
xs) Int
cumw [(Text, Bool)]
out = [(Text, Bool)]
r where
newWidth :: Int
newWidth = Text -> Int
textWidth Text
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cumw
r :: [(Text, Bool)]
r = if Int
newWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWidth
then if Char -> Bool
isSpace (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Char
T.index Text
x (Int -> Text -> Int
characterIndexFromWidth (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cumw) Text
x)
then let (Text
t1,Text
t2) = Int -> Text -> (Text, Text)
splitAtWidth (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cumw) Text
x
in [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop (Int -> Text -> Text
T.drop Int
1 Text
t2Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs) Int
0 [] [(Text, Bool)] -> [(Text, Bool)] -> [(Text, Bool)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Bool)] -> Text -> Bool -> [(Text, Bool)]
appendOut [(Text, Bool)]
out Text
t1 Bool
True
else if Int
cumw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then let (Text
t1,Text
t2) = Int -> Text -> (Text, Text)
splitAtWidth (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cumw) Text
x
in [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop (Text
t2Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs) Int
0 [] [(Text, Bool)] -> [(Text, Bool)] -> [(Text, Bool)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Bool)] -> Text -> Bool -> [(Text, Bool)]
appendOut [(Text, Bool)]
out Text
t1 Bool
False
else [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs) Int
0 [] [(Text, Bool)] -> [(Text, Bool)] -> [(Text, Bool)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Bool)] -> [(Text, Bool)]
modifyOutForNewLine [(Text, Bool)]
out
else [Text] -> Int -> [(Text, Bool)] -> [(Text, Bool)]
loop [Text]
xs Int
newWidth ([(Text, Bool)] -> [(Text, Bool)])
-> [(Text, Bool)] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ [(Text, Bool)] -> Text -> Bool -> [(Text, Bool)]
appendOut [(Text, Bool)]
out Text
x Bool
False
alignmentOffset
:: TextAlignment
-> Int
-> Text
-> Int
alignmentOffset :: TextAlignment -> Int -> Text -> Int
alignmentOffset TextAlignment
alignment Int
maxWidth Text
t = case TextAlignment
alignment of
TextAlignment
TextAlignment_Left -> Int
0
TextAlignment
TextAlignment_Right -> (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)
TextAlignment
TextAlignment_Center -> (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
where
l :: Int
l = Text -> Int
textWidth Text
t
wrapWithOffsetAndAlignment
:: TextAlignment
-> Int
-> Int
-> Text
-> [WrappedLine]
wrapWithOffsetAndAlignment :: TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
_ Int
maxWidth Int
_ Text
_ | Int
maxWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
wrapWithOffsetAndAlignment TextAlignment
alignment Int
maxWidth Int
n Text
txt = Bool -> [WrappedLine] -> [WrappedLine]
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWidth) [WrappedLine]
r where
r' :: [(Text, Bool)]
r' = if Text -> Bool
T.null Text
txt
then [(Text
"",Bool
False)]
else Int -> [Text] -> [(Text, Bool)]
splitWordsAtDisplayWidth Int
maxWidth ([Text] -> [(Text, Bool)]) -> [Text] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
wordsWithWhitespace ( Int -> Text -> Text
T.replicate Int
n Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)
fmapfn :: (Text, Bool) -> WrappedLine
fmapfn (Text
t,Bool
b) = Text -> Bool -> Int -> WrappedLine
WrappedLine Text
t Bool
b (Int -> WrappedLine) -> Int -> WrappedLine
forall a b. (a -> b) -> a -> b
$ TextAlignment -> Int -> Text -> Int
alignmentOffset TextAlignment
alignment Int
maxWidth Text
t
r'' :: [(Text, Bool)]
r'' = case [(Text, Bool)]
r' of
[] -> []
(Text
x,Bool
b):[(Text, Bool)]
xs -> (Int -> Text -> Text
T.drop Int
n Text
x,Bool
b)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:[(Text, Bool)]
xs
r :: [WrappedLine]
r = ((Text, Bool) -> WrappedLine) -> [(Text, Bool)] -> [WrappedLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Bool) -> WrappedLine
fmapfn [(Text, Bool)]
r''
eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
eolSpacesToLogicalLines = ([WrappedLine] -> [(Text, Int)])
-> [[WrappedLine]] -> [[(Text, Int)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WrappedLine -> (Text, Int)) -> [WrappedLine] -> [(Text, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WrappedLine Text
a Bool
_ Int
c) -> (Text
a,Int
c))) ([[WrappedLine]] -> [[(Text, Int)]])
-> ([[WrappedLine]] -> [[WrappedLine]])
-> [[WrappedLine]]
-> [[(Text, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((WrappedLine -> WrappedLine -> Bool)
-> [WrappedLine] -> [[WrappedLine]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\(WrappedLine Text
_ Bool
b Int
_) WrappedLine
_ -> Bool -> Bool
not Bool
b)) ([WrappedLine] -> [[WrappedLine]])
-> [[WrappedLine]] -> [[WrappedLine]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
offsetMapWithAlignment
:: [[(Text, Int)]]
-> OffsetMapWithAlignment
offsetMapWithAlignment :: [[(Text, Int)]] -> OffsetMapWithAlignment
offsetMapWithAlignment [[(Text, Int)]]
ts = State (Int, Int) OffsetMapWithAlignment
-> (Int, Int) -> OffsetMapWithAlignment
forall s a. State s a -> s -> a
evalState ([[(Text, Int)]] -> State (Int, Int) OffsetMapWithAlignment
forall k (f :: * -> *) (f :: * -> *) (f :: * -> *) a.
(Ord k, Traversable f, Traversable f, MonadState (k, Int) f,
Num k) =>
f (f (Text, a)) -> f (Map k (a, Int))
offsetMap' [[(Text, Int)]]
ts) (Int
0, Int
0)
where
offsetMap' :: f (f (Text, a)) -> f (Map k (a, Int))
offsetMap' f (f (Text, a))
xs = (f (Map k (a, Int)) -> Map k (a, Int))
-> f (f (Map k (a, Int))) -> f (Map k (a, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Map k (a, Int)) -> Map k (a, Int)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (f (f (Map k (a, Int))) -> f (Map k (a, Int)))
-> f (f (Map k (a, Int))) -> f (Map k (a, Int))
forall a b. (a -> b) -> a -> b
$ f (f (Text, a))
-> (f (Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM f (f (Text, a))
xs ((f (Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int))))
-> (f (Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int)))
forall a b. (a -> b) -> a -> b
$ \f (Text, a)
x -> do
f (Map k (a, Int))
maps <- f (Text, a)
-> ((Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM f (Text, a)
x (((Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int))))
-> ((Text, a) -> f (Map k (a, Int))) -> f (f (Map k (a, Int)))
forall a b. (a -> b) -> a -> b
$ \(Text
line,a
align) -> do
let l :: Int
l = Text -> Int
T.length Text
line
(k
dl, Int
o) <- f (k, Int)
forall s (m :: * -> *). MonadState s m => m s
get
(k, Int) -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (k
dl k -> k -> k
forall a. Num a => a -> a -> a
+ k
1, Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l)
Map k (a, Int) -> f (Map k (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (a, Int) -> f (Map k (a, Int)))
-> Map k (a, Int) -> f (Map k (a, Int))
forall a b. (a -> b) -> a -> b
$ k -> (a, Int) -> Map k (a, Int)
forall k a. k -> a -> Map k a
Map.singleton k
dl (a
align, Int
o)
(k
dl, Int
o) <- f (k, Int)
forall s (m :: * -> *). MonadState s m => m s
get
(k, Int) -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (k
dl, Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Map k (a, Int) -> f (Map k (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (a, Int) -> f (Map k (a, Int)))
-> Map k (a, Int) -> f (Map k (a, Int))
forall a b. (a -> b) -> a -> b
$ ((a, Int) -> (a, Int)) -> k -> Map k (a, Int) -> Map k (a, Int)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\(a
align,Int
_)->(a
align,Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) k
dl (Map k (a, Int) -> Map k (a, Int))
-> Map k (a, Int) -> Map k (a, Int)
forall a b. (a -> b) -> a -> b
$ f (Map k (a, Int)) -> Map k (a, Int)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions f (Map k (a, Int))
maps
offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
offsetMapWithAlignmentInternal = [[(Text, Int)]] -> OffsetMapWithAlignment
offsetMapWithAlignment ([[(Text, Int)]] -> OffsetMapWithAlignment)
-> ([[WrappedLine]] -> [[(Text, Int)]])
-> [[WrappedLine]]
-> OffsetMapWithAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[WrappedLine]] -> [[(Text, Int)]]
eolSpacesToLogicalLines
displayLinesWithAlignment
:: TextAlignment
-> Int
-> tag
-> tag
-> TextZipper
-> DisplayLines tag
displayLinesWithAlignment :: TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
displayLinesWithAlignment TextAlignment
alignment Int
width tag
tag tag
cursorTag (TextZipper [Text]
lb Text
b Text
a [Text]
la) =
let
linesBefore :: [[WrappedLine]]
linesBefore :: [[WrappedLine]]
linesBefore = (Text -> [WrappedLine]) -> [Text] -> [[WrappedLine]]
forall a b. (a -> b) -> [a] -> [b]
map (TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
alignment Int
width Int
0) ([Text] -> [[WrappedLine]]) -> [Text] -> [[WrappedLine]]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
lb
linesAfter :: [[WrappedLine]]
linesAfter :: [[WrappedLine]]
linesAfter = (Text -> [WrappedLine]) -> [Text] -> [[WrappedLine]]
forall a b. (a -> b) -> [a] -> [b]
map (TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
alignment Int
width Int
0) [Text]
la
afterWithCursor :: Text
afterWithCursor = if Text -> Bool
T.null Text
a then Text
" " else Text
a
offsets :: OffsetMapWithAlignment
offsets :: OffsetMapWithAlignment
offsets = [[WrappedLine]] -> OffsetMapWithAlignment
offsetMapWithAlignmentInternal ([[WrappedLine]] -> OffsetMapWithAlignment)
-> [[WrappedLine]] -> OffsetMapWithAlignment
forall a b. (a -> b) -> a -> b
$ [[[WrappedLine]]] -> [[WrappedLine]]
forall a. Monoid a => [a] -> a
mconcat
[ [[WrappedLine]]
linesBefore
, [TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
alignment Int
width Int
0 (Text -> [WrappedLine]) -> Text -> [WrappedLine]
forall a b. (a -> b) -> a -> b
$ Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
afterWithCursor]
, [[WrappedLine]]
linesAfter
]
flattenLines :: [[WrappedLine]] -> [Text]
flattenLines = ([WrappedLine] -> [Text]) -> [[WrappedLine]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((WrappedLine -> Text) -> [WrappedLine] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WrappedLine -> Text
_wrappedLines_text)
spansBefore :: [[Span tag]]
spansBefore = (Text -> [Span tag]) -> [Text] -> [[Span tag]]
forall a b. (a -> b) -> [a] -> [b]
map ((Span tag -> [Span tag] -> [Span tag]
forall a. a -> [a] -> [a]
:[]) (Span tag -> [Span tag])
-> (Text -> Span tag) -> Text -> [Span tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag) ([Text] -> [[Span tag]]) -> [Text] -> [[Span tag]]
forall a b. (a -> b) -> a -> b
$ [[WrappedLine]] -> [Text]
flattenLines [[WrappedLine]]
linesBefore
spansAfter :: [[Span tag]]
spansAfter = (Text -> [Span tag]) -> [Text] -> [[Span tag]]
forall a b. (a -> b) -> [a] -> [b]
map ((Span tag -> [Span tag] -> [Span tag]
forall a. a -> [a] -> [a]
:[]) (Span tag -> [Span tag])
-> (Text -> Span tag) -> Text -> [Span tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag) ([Text] -> [[Span tag]]) -> [Text] -> [[Span tag]]
forall a b. (a -> b) -> a -> b
$ [[WrappedLine]] -> [Text]
flattenLines [[WrappedLine]]
linesAfter
curlinetext :: Text
curlinetext = Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
curwrappedlines :: [WrappedLine]
curwrappedlines = (TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
alignment Int
width Int
0 Text
curlinetext)
blength :: Int
blength = Text -> Int
T.length Text
b
mapaccumlfn :: (Int, Either Int (Int, Int))
-> WrappedLine -> ((Int, Either Int (Int, Int)), [Span tag])
mapaccumlfn (Int
acclength, Either Int (Int, Int)
ecpos') (WrappedLine Text
t Bool
dwseol Int
xoff) = ((Int, Either Int (Int, Int)), [Span tag])
r where
tlength :: Int
tlength = Text -> Int
T.length Text
t
nextacclength :: Int
nextacclength = Int
acclength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool
dwseol then Int
1 else Int
0
nextacc :: (Int, Either Int (Int, Int))
nextacc = (Int
nextacclength, Either Int (Int, Int)
nextecpos)
cursoroncurspan :: Bool
cursoroncurspan = Int
nextacclength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
blength Bool -> Bool -> Bool
&& (Int
blength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
acclength)
charsbeforecursor :: Int
charsbeforecursor = Int
blengthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
acclength
ctlength :: Int
ctlength = Text -> Int
textWidth (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
charsbeforecursor Text
t
cursorx :: Int
cursorx = Int
xoff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ctlength
nextecpos :: Either Int (Int, Int)
nextecpos = case Either Int (Int, Int)
ecpos' of
Left Int
y -> if Bool
cursoroncurspan
then if Int
ctlength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
width
then (Int, Int) -> Either Int (Int, Int)
forall a b. b -> Either a b
Right (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
0)
else (Int, Int) -> Either Int (Int, Int)
forall a b. b -> Either a b
Right (Int
y, Int
cursorx)
else Int -> Either Int (Int, Int)
forall a b. a -> Either a b
Left (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Right (Int, Int)
x -> (Int, Int) -> Either Int (Int, Int)
forall a b. b -> Either a b
Right (Int, Int)
x
beforecursor :: Text
beforecursor = Int -> Text -> Text
T.take Int
charsbeforecursor Text
t
cursortext :: Text
cursortext = Int -> Text -> Text
T.take Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
charsbeforecursor Text
t
aftercursor :: Text
aftercursor = Int -> Text -> Text
T.drop (Int
charsbeforecursorInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
t
cursorspans :: [Span tag]
cursorspans = [tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag Text
beforecursor, tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
cursorTag Text
cursortext] [Span tag] -> [Span tag] -> [Span tag]
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
aftercursor then [] else [tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag Text
aftercursor]
r :: ((Int, Either Int (Int, Int)), [Span tag])
r = if Bool
cursoroncurspan
then ((Int, Either Int (Int, Int))
nextacc, [Span tag]
cursorspans)
else ((Int, Either Int (Int, Int))
nextacc, [tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag Text
t])
((Int
_, Either Int (Int, Int)
ecpos), [[Span tag]]
curlinespans) = if Text -> Bool
T.null Text
curlinetext
then ((Int
0, (Int, Int) -> Either Int (Int, Int)
forall a b. b -> Either a b
Right (Int
0, TextAlignment -> Int -> Text -> Int
alignmentOffset TextAlignment
alignment Int
width Text
"")), [[tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag Text
""]])
else ((Int, Either Int (Int, Int))
-> WrappedLine -> ((Int, Either Int (Int, Int)), [Span tag]))
-> (Int, Either Int (Int, Int))
-> [WrappedLine]
-> ((Int, Either Int (Int, Int)), [[Span tag]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL (Int, Either Int (Int, Int))
-> WrappedLine -> ((Int, Either Int (Int, Int)), [Span tag])
mapaccumlfn (Int
0, Int -> Either Int (Int, Int)
forall a b. a -> Either a b
Left Int
0) [WrappedLine]
curwrappedlines
(Int
cursorY', Int
cursorX) = case Either Int (Int, Int)
ecpos of
Right (Int
y,Int
x) -> (Int
y,Int
x)
Left Int
y -> (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, TextAlignment -> Int -> Text -> Int
alignmentOffset TextAlignment
alignment Int
width Text
"")
cursorY :: Int
cursorY = Int
cursorY' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Span tag]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Span tag]]
spansBefore
in DisplayLines :: forall tag.
[[Span tag]]
-> OffsetMapWithAlignment -> (Int, Int) -> DisplayLines tag
DisplayLines
{ _displayLines_spans :: [[Span tag]]
_displayLines_spans = [[[Span tag]]] -> [[Span tag]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[Span tag]]
spansBefore
, [[Span tag]]
curlinespans
, [[Span tag]]
spansAfter
]
, _displayLines_offsetMap :: OffsetMapWithAlignment
_displayLines_offsetMap = OffsetMapWithAlignment
offsets
, _displayLines_cursorPos :: (Int, Int)
_displayLines_cursorPos = (Int
cursorX, Int
cursorY)
}
goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
goToDisplayLinePosition Int
x Int
y DisplayLines tag
dl TextZipper
tz =
let offset :: Maybe (Int, Int)
offset = Int -> OffsetMapWithAlignment -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
y (OffsetMapWithAlignment -> Maybe (Int, Int))
-> OffsetMapWithAlignment -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ DisplayLines tag -> OffsetMapWithAlignment
forall tag. DisplayLines tag -> OffsetMapWithAlignment
_displayLines_offsetMap DisplayLines tag
dl
in case Maybe (Int, Int)
offset of
Maybe (Int, Int)
Nothing -> TextZipper
tz
Just (Int
alignOff,Int
o) ->
let
trueX :: Int
trueX = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alignOff)
moveRight :: Int
moveRight = case Int -> [[Span tag]] -> [[Span tag]]
forall a. Int -> [a] -> [a]
drop Int
y ([[Span tag]] -> [[Span tag]]) -> [[Span tag]] -> [[Span tag]]
forall a b. (a -> b) -> a -> b
$ DisplayLines tag -> [[Span tag]]
forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans DisplayLines tag
dl of
[] -> Int
0
([Span tag]
s:[[Span tag]]
_) -> Int -> Stream Char -> Int
charIndexAt Int
trueX (Stream Char -> Int)
-> ([Span tag] -> Stream Char) -> [Span tag] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream (Text -> Stream Char)
-> ([Span tag] -> Text) -> [Span tag] -> Stream Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([Span tag] -> [Text]) -> [Span tag] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span tag -> Text) -> [Span tag] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Span tag
_ Text
t) -> Text
t) ([Span tag] -> Int) -> [Span tag] -> Int
forall a b. (a -> b) -> a -> b
$ [Span tag]
s
in Int -> TextZipper -> TextZipper
rightN (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
moveRight) (TextZipper -> TextZipper) -> TextZipper -> TextZipper
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
top TextZipper
tz
displayLines
:: Int
-> tag
-> tag
-> TextZipper
-> DisplayLines tag
displayLines :: Int -> tag -> tag -> TextZipper -> DisplayLines tag
displayLines = TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
displayLinesWithAlignment TextAlignment
TextAlignment_Left
wrapWithOffset
:: Int
-> Int
-> Text
-> [Text]
wrapWithOffset :: Int -> Int -> Text -> [Text]
wrapWithOffset Int
maxWidth Int
n Text
xs = WrappedLine -> Text
_wrappedLines_text (WrappedLine -> Text) -> [WrappedLine] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextAlignment -> Int -> Int -> Text -> [WrappedLine]
wrapWithOffsetAndAlignment TextAlignment
TextAlignment_Left Int
maxWidth Int
n Text
xs