module Data.Text.Zipper where
import Prelude
import Control.Exception (assert)
import Data.Char (isSpace)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.String
import Control.Monad
import Control.Monad.Fix
import Control.Monad.State (evalState, get, put)
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)
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
$cshowsPrec :: Int -> TextZipper -> ShowS
showsPrec :: Int -> TextZipper -> ShowS
$cshow :: TextZipper -> String
show :: TextZipper -> String
$cshowList :: [TextZipper] -> ShowS
showList :: [TextZipper] -> ShowS
Show)
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
{ _textZipper_linesBefore :: [Text]
_textZipper_linesBefore = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> [a] -> [b]
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 (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
$cshowsPrec :: forall tag. Show tag => Int -> Span tag -> ShowS
showsPrec :: Int -> Span tag -> ShowS
$cshow :: forall tag. Show tag => Span tag -> String
show :: Span tag -> String
$cshowList :: forall tag. Show tag => [Span tag] -> ShowS
showList :: [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
$c== :: TextAlignment -> TextAlignment -> Bool
== :: TextAlignment -> TextAlignment -> Bool
$c/= :: TextAlignment -> TextAlignment -> Bool
/= :: 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
$cshowsPrec :: Int -> TextAlignment -> ShowS
showsPrec :: Int -> TextAlignment -> ShowS
$cshow :: TextAlignment -> String
show :: TextAlignment -> String
$cshowList :: [TextAlignment] -> ShowS
showList :: [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
$c== :: WrappedLine -> WrappedLine -> Bool
== :: WrappedLine -> WrappedLine -> Bool
$c/= :: WrappedLine -> WrappedLine -> Bool
/= :: 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
$cshowsPrec :: Int -> WrappedLine -> ShowS
showsPrec :: Int -> WrappedLine -> ShowS
$cshow :: WrappedLine -> String
show :: WrappedLine -> String
$cshowList :: [WrappedLine] -> ShowS
showList :: [WrappedLine] -> ShowS
Show)
data DisplayLines tag = DisplayLines
{ forall tag. DisplayLines tag -> [[Span tag]]
_displayLines_spans :: [[Span tag]]
, forall tag. DisplayLines tag -> OffsetMapWithAlignment
_displayLines_offsetMap :: OffsetMapWithAlignment
, forall tag. DisplayLines tag -> (Int, Int)
_displayLines_cursorPos :: (Int, Int)
}
deriving (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
$cshowsPrec :: forall tag. Show tag => Int -> DisplayLines tag -> ShowS
showsPrec :: Int -> DisplayLines tag -> ShowS
$cshow :: forall tag. Show tag => DisplayLines tag -> String
show :: DisplayLines tag -> String
$cshowList :: forall tag. Show tag => [DisplayLines tag] -> ShowS
showList :: [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
toLogicalIndex 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))
toLogicalIndex :: Int -> Text -> Int
toLogicalIndex :: Int -> Text -> Int
toLogicalIndex Int
n' t' :: Text
t'@(Text Array
_ Int
_ Int
len') = Int -> Int -> Int
loop Int
0 Int
0
where loop :: Int -> Int -> Int
loop !Int
i !Int
cnt
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len' Bool -> Bool -> Bool
|| Int
cnt 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
i
| Bool
otherwise = Int -> Int -> Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w)
where Iter Char
c Int
d = Text -> Int -> Iter
iter Text
t' Int
i
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 :: forall tag. [Span tag] -> Int
spansWidth = [Int] -> Int
forall a. Num a => [a] -> a
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 :: forall tag. [Span tag] -> Int
spansLength = [Int] -> Int
forall a. Num a => [a] -> a
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
$ HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
x (Int -> Text -> Int
toLogicalIndex (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
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' = 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) = case TextAlignment
alignment of
TextAlignment
TextAlignment_Left -> Text -> Bool -> Int -> WrappedLine
WrappedLine Text
t Bool
b Int
0
TextAlignment
TextAlignment_Right -> Text -> Bool -> Int -> WrappedLine
WrappedLine Text
t Bool
b (Int
maxWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)
TextAlignment
TextAlignment_Center -> Text -> Bool -> Int -> WrappedLine
WrappedLine Text
t Bool
b ((Int
maxWidthInt -> 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
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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WrappedLine -> (Text, Int)) -> [WrappedLine] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
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]])
-> [[WrappedLine]] -> [[WrappedLine]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((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))
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
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 a b. (a -> b) -> f a -> f b
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 a. a -> f a
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 a. a -> f a
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
displayLinesWithAlignment
:: TextAlignment
-> Int
-> tag
-> tag
-> TextZipper
-> DisplayLines tag
displayLinesWithAlignment :: forall tag.
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 a b. (a -> b) -> [a] -> [b]
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
([[Span tag]]
spansCurrentBefore, [Span tag]
spansCurLineBefore) = ([[Span tag]], [Span tag])
-> Maybe ([[Span tag]], [Span tag]) -> ([[Span tag]], [Span tag])
forall a. a -> Maybe a -> a
fromMaybe ([], []) (Maybe ([[Span tag]], [Span tag]) -> ([[Span tag]], [Span tag]))
-> Maybe ([[Span tag]], [Span tag]) -> ([[Span tag]], [Span tag])
forall a b. (a -> b) -> a -> b
$
[[Span tag]] -> Maybe ([[Span tag]], [Span tag])
forall a. [a] -> Maybe ([a], a)
initLast ([[Span tag]] -> Maybe ([[Span tag]], [Span tag]))
-> [[Span tag]] -> Maybe ([[Span tag]], [Span tag])
forall a b. (a -> b) -> a -> b
$ (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
_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
alignment Int
width Int
0 Text
b)
curLineOffset :: Int
curLineOffset = [Span tag] -> Int
forall tag. [Span tag] -> Int
spansWidth [Span tag]
spansCurLineBefore
cursorAfterEOL :: Bool
cursorAfterEOL = Int
curLineOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
width
cursorCharWidth :: Int
cursorCharWidth = case Text -> Maybe (Char, Text)
T.uncons Text
a of
Maybe (Char, Text)
Nothing -> Int
1
Just (Char
c, Text
_) -> Char -> Int
charWidth Char
c
([Span tag]
spansCurLineAfter, [[Span tag]]
spansCurrentAfter) = ([Span tag], [[Span tag]])
-> Maybe ([Span tag], [[Span tag]]) -> ([Span tag], [[Span tag]])
forall a. a -> Maybe a -> a
fromMaybe ([], []) (Maybe ([Span tag], [[Span tag]]) -> ([Span tag], [[Span tag]]))
-> Maybe ([Span tag], [[Span tag]]) -> ([Span tag], [[Span tag]])
forall a b. (a -> b) -> a -> b
$
[[Span tag]] -> Maybe ([Span tag], [[Span tag]])
forall a. [a] -> Maybe (a, [a])
headTail ([[Span tag]] -> Maybe ([Span tag], [[Span tag]]))
-> [[Span tag]] -> Maybe ([Span tag], [[Span tag]])
forall a b. (a -> b) -> a -> b
$ case Text -> Maybe (Char, Text)
T.uncons Text
a of
Maybe (Char, Text)
Nothing -> [[tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
cursorTag Text
" "]]
Just (Char
c, Text
rest) ->
let o :: Int
o = if Bool
cursorAfterEOL then Int
cursorCharWidth else Int
curLineOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cursorCharWidth
cursor :: Span tag
cursor = tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
cursorTag (Char -> Text
T.singleton Char
c)
in case (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
_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
alignment Int
width Int
o Text
rest) of
[] -> [[Span tag
cursor]]
([Span tag]
l:[[Span tag]]
ls) -> (Span tag
cursor Span tag -> [Span tag] -> [Span tag]
forall a. a -> [a] -> [a]
: [Span tag]
l) [Span tag] -> [[Span tag]] -> [[Span tag]]
forall a. a -> [a] -> [a]
: [[Span tag]]
ls
curLineSpanNormalCase :: [[Span tag]]
curLineSpanNormalCase = if Bool
cursorAfterEOL
then [ [Span tag]
spansCurLineBefore, [Span tag]
spansCurLineAfter ]
else [ [Span tag]
spansCurLineBefore [Span tag] -> [Span tag] -> [Span tag]
forall a. Semigroup a => a -> a -> a
<> [Span tag]
spansCurLineAfter ]
curLineSpan :: [[Span tag]]
curLineSpan = if TextAlignment
alignment TextAlignment -> TextAlignment -> Bool
forall a. Eq a => a -> a -> Bool
== TextAlignment
TextAlignment_Right Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cursorAfterEOL
then case [Span tag] -> [Span tag]
forall a. [a] -> [a]
reverse [Span tag]
spansCurLineBefore of
[] -> [[Span tag]]
curLineSpanNormalCase
(Span tag
_ Text
x):[Span tag]
xs -> case [Span tag]
spansCurLineAfter of
[] -> String -> [[Span tag]]
forall a. HasCallStack => String -> a
error String
"should not be possible"
(Span tag
_ Text
y):[Span tag]
ys -> [[Span tag] -> [Span tag]
forall a. [a] -> [a]
reverse (tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
cursorTag Text
xSpan tag -> [Span tag] -> [Span tag]
forall a. a -> [a] -> [a]
:[Span tag]
xs) [Span tag] -> [Span tag] -> [Span tag]
forall a. Semigroup a => a -> a -> a
<> ((tag -> Text -> Span tag
forall tag. tag -> Text -> Span tag
Span tag
tag Text
y)Span tag -> [Span tag] -> [Span tag]
forall a. a -> [a] -> [a]
:[Span tag]
ys)]
else [[Span tag]]
curLineSpanNormalCase
cursorY :: Int
cursorY = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
[ [[Span tag]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Span tag]]
spansBefore
, [[Span tag]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Span tag]]
spansCurrentBefore
, if Bool
cursorAfterEOL then Int
1 else Int
0
]
cursorX :: Int
cursorX = if Bool
cursorAfterEOL then Int
0 else Text -> Int
textWidth ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Span tag -> Text) -> [Span tag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Span tag
_ Text
t) -> Text
t) [Span tag]
spansCurLineBefore)
in 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]]
spansCurrentBefore
, [[Span tag]]
curLineSpan
, [[Span tag]]
spansCurrentAfter
, [[Span tag]]
spansAfter
]
, _displayLines_offsetMap :: OffsetMapWithAlignment
_displayLines_offsetMap = OffsetMapWithAlignment
offsets
, _displayLines_cursorPos :: (Int, Int)
_displayLines_cursorPos = (Int
cursorX, Int
cursorY)
}
where
initLast :: [a] -> Maybe ([a], a)
initLast :: forall a. [a] -> Maybe ([a], a)
initLast = \case
[] -> Maybe ([a], a)
forall a. Maybe a
Nothing
(a
x:[a]
xs) -> case [a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
initLast [a]
xs of
Maybe ([a], a)
Nothing -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([], a
x)
Just ([a]
ys, a
y) -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, a
y)
headTail :: [a] -> Maybe (a, [a])
headTail :: forall a. [a] -> Maybe (a, [a])
headTail = \case
[] -> Maybe (a, [a])
forall a. Maybe a
Nothing
a
x:[a]
xs -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
goToDisplayLinePosition :: forall tag.
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 a b. (a -> b) -> [a] -> [b]
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 :: forall tag. 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