{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Buffer.Implementation
( UIUpdate (..)
, Update (..)
, updateIsDelete
, Point
, Mark, MarkValue (..)
, Size
, Direction (..)
, BufferImpl (mem, marks, markNames, hlCache, overlays, dirtyOffset)
, Overlay (..)
, mkOverlay
, overlayUpdate
, applyUpdateI
, isValidUpdate
, reverseUpdateI
, sizeBI
, newBI
, solPoint
, solPoint'
, eolPoint'
, charsFromSolBI
, regexRegionBI
, getMarkDefaultPosBI
, modifyMarkBI
, getMarkValueBI
, getMarkBI
, newMarkBI
, deleteMarkValueBI
, setSyntaxBI
, addOverlayBI
, delOverlayBI
, delOverlaysOfOwnerBI
, getOverlaysOfOwnerBI
, updateSyntax
, getAst, focusAst
, strokesRangesBI
, getStream
, getIndexedStream
, lineAt
, SearchExp
, markPointAA
, markGravityAA
) where
import GHC.Generics (Generic)
import Data.Array ((!))
import Data.Binary (Binary (..))
import Data.Function (on)
import Data.List (groupBy)
import qualified Data.Map.Strict as M (Map, delete, empty, findMax, insert, lookup, map, maxViewWithKey)
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set (Set, delete, empty, filter, insert, map, toList)
import Data.Typeable (Typeable)
import Yi.Buffer.Basic (Direction (..), Mark (..), WindowRef, reverseDir)
import Yi.Regex (RegexLike (matchAll), SearchExp, searchRegex)
import Yi.Region (Region (..), fmapRegion, mkRegion, nearRegion, regionSize)
import Yi.Rope (YiString)
import qualified Yi.Rope as R
import Yi.Style (StyleName, UIStyle (hintStyle, strongHintStyle))
import Yi.Syntax
import Yi.Utils (SemiNum ((+~), (~-)), makeLensesWithSuffix, mapAdjust')
data MarkValue = MarkValue { MarkValue -> Point
markPoint :: !Point
, MarkValue -> Direction
markGravity :: !Direction}
deriving (Eq MarkValue
Eq MarkValue
-> (MarkValue -> MarkValue -> Ordering)
-> (MarkValue -> MarkValue -> Bool)
-> (MarkValue -> MarkValue -> Bool)
-> (MarkValue -> MarkValue -> Bool)
-> (MarkValue -> MarkValue -> Bool)
-> (MarkValue -> MarkValue -> MarkValue)
-> (MarkValue -> MarkValue -> MarkValue)
-> Ord MarkValue
MarkValue -> MarkValue -> Bool
MarkValue -> MarkValue -> Ordering
MarkValue -> MarkValue -> MarkValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MarkValue -> MarkValue -> MarkValue
$cmin :: MarkValue -> MarkValue -> MarkValue
max :: MarkValue -> MarkValue -> MarkValue
$cmax :: MarkValue -> MarkValue -> MarkValue
>= :: MarkValue -> MarkValue -> Bool
$c>= :: MarkValue -> MarkValue -> Bool
> :: MarkValue -> MarkValue -> Bool
$c> :: MarkValue -> MarkValue -> Bool
<= :: MarkValue -> MarkValue -> Bool
$c<= :: MarkValue -> MarkValue -> Bool
< :: MarkValue -> MarkValue -> Bool
$c< :: MarkValue -> MarkValue -> Bool
compare :: MarkValue -> MarkValue -> Ordering
$ccompare :: MarkValue -> MarkValue -> Ordering
$cp1Ord :: Eq MarkValue
Ord, MarkValue -> MarkValue -> Bool
(MarkValue -> MarkValue -> Bool)
-> (MarkValue -> MarkValue -> Bool) -> Eq MarkValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkValue -> MarkValue -> Bool
$c/= :: MarkValue -> MarkValue -> Bool
== :: MarkValue -> MarkValue -> Bool
$c== :: MarkValue -> MarkValue -> Bool
Eq, Int -> MarkValue -> ShowS
[MarkValue] -> ShowS
MarkValue -> String
(Int -> MarkValue -> ShowS)
-> (MarkValue -> String)
-> ([MarkValue] -> ShowS)
-> Show MarkValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkValue] -> ShowS
$cshowList :: [MarkValue] -> ShowS
show :: MarkValue -> String
$cshow :: MarkValue -> String
showsPrec :: Int -> MarkValue -> ShowS
$cshowsPrec :: Int -> MarkValue -> ShowS
Show, Typeable, (forall x. MarkValue -> Rep MarkValue x)
-> (forall x. Rep MarkValue x -> MarkValue) -> Generic MarkValue
forall x. Rep MarkValue x -> MarkValue
forall x. MarkValue -> Rep MarkValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkValue x -> MarkValue
$cfrom :: forall x. MarkValue -> Rep MarkValue x
Generic)
makeLensesWithSuffix "AA" ''MarkValue
instance Binary MarkValue
type Marks = M.Map Mark MarkValue
data HLState syntax = forall cache. HLState !(Highlighter cache syntax) !cache
data Overlay = Overlay
{ Overlay -> YiString
overlayOwner :: !R.YiString
, Overlay -> MarkValue
overlayBegin :: !MarkValue
, Overlay -> MarkValue
overlayEnd :: !MarkValue
, Overlay -> StyleName
overlayStyle :: !StyleName
, Overlay -> YiString
overlayAnnotation :: !R.YiString
}
instance Eq Overlay where
Overlay YiString
a MarkValue
b MarkValue
c StyleName
_ YiString
msg == :: Overlay -> Overlay -> Bool
== Overlay YiString
a' MarkValue
b' MarkValue
c' StyleName
_ YiString
msg' =
YiString
a YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
a' Bool -> Bool -> Bool
&& MarkValue
b MarkValue -> MarkValue -> Bool
forall a. Eq a => a -> a -> Bool
== MarkValue
b' Bool -> Bool -> Bool
&& MarkValue
c MarkValue -> MarkValue -> Bool
forall a. Eq a => a -> a -> Bool
== MarkValue
c' Bool -> Bool -> Bool
&& YiString
msg YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
msg'
instance Ord Overlay where
compare :: Overlay -> Overlay -> Ordering
compare (Overlay YiString
a MarkValue
b MarkValue
c StyleName
_ YiString
msg) (Overlay YiString
a' MarkValue
b' MarkValue
c' StyleName
_ YiString
msg')
= [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
[ YiString -> YiString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare YiString
a YiString
a'
, MarkValue -> MarkValue -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MarkValue
b MarkValue
b'
, MarkValue -> MarkValue -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MarkValue
c MarkValue
c'
, YiString -> YiString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare YiString
msg YiString
msg'
]
instance Show Overlay where
show :: Overlay -> String
show (Overlay YiString
a MarkValue
b MarkValue
c StyleName
_ YiString
msg) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Overlay { "
, String
"overlayOwner = ", YiString -> String
forall a. Show a => a -> String
show YiString
a, String
", "
, String
"overlayBegin = ", MarkValue -> String
forall a. Show a => a -> String
show MarkValue
b, String
", "
, String
"overlayEnd = ", MarkValue -> String
forall a. Show a => a -> String
show MarkValue
c, String
", "
, String
"overlayAnnotation = ", YiString -> String
forall a. Show a => a -> String
show YiString
msg, String
"}"]
data BufferImpl syntax = FBufferData
{ BufferImpl syntax -> YiString
mem :: !YiString
, BufferImpl syntax -> Marks
marks :: !Marks
, BufferImpl syntax -> Map String Mark
markNames :: !(M.Map String Mark)
, BufferImpl syntax -> HLState syntax
hlCache :: !(HLState syntax)
, BufferImpl syntax -> Set Overlay
overlays :: !(Set.Set Overlay)
, BufferImpl syntax -> Point
dirtyOffset :: !Point
} deriving Typeable
dummyHlState :: HLState syntax
dummyHlState :: HLState syntax
dummyHlState = Highlighter () syntax -> () -> HLState syntax
forall syntax cache.
Highlighter cache syntax -> cache -> HLState syntax
HLState Highlighter () syntax
forall syntax. Highlighter () syntax
noHighlighter (Highlighter () Any -> ()
forall cache syntax. Highlighter cache syntax -> cache
hlStartState Highlighter () Any
forall syntax. Highlighter () syntax
noHighlighter)
instance Binary (BufferImpl ()) where
put :: BufferImpl () -> Put
put BufferImpl ()
b = YiString -> Put
forall t. Binary t => t -> Put
put (BufferImpl () -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl ()
b) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Marks -> Put
forall t. Binary t => t -> Put
put (BufferImpl () -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl ()
b) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map String Mark -> Put
forall t. Binary t => t -> Put
put (BufferImpl () -> Map String Mark
forall syntax. BufferImpl syntax -> Map String Mark
markNames BufferImpl ()
b)
get :: Get (BufferImpl ())
get = YiString
-> Marks
-> Map String Mark
-> HLState ()
-> Set Overlay
-> Point
-> BufferImpl ()
forall syntax.
YiString
-> Marks
-> Map String Mark
-> HLState syntax
-> Set Overlay
-> Point
-> BufferImpl syntax
FBufferData (YiString
-> Marks
-> Map String Mark
-> HLState ()
-> Set Overlay
-> Point
-> BufferImpl ())
-> Get YiString
-> Get
(Marks
-> Map String Mark
-> HLState ()
-> Set Overlay
-> Point
-> BufferImpl ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get YiString
forall t. Binary t => Get t
get Get
(Marks
-> Map String Mark
-> HLState ()
-> Set Overlay
-> Point
-> BufferImpl ())
-> Get Marks
-> Get
(Map String Mark
-> HLState () -> Set Overlay -> Point -> BufferImpl ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Marks
forall t. Binary t => Get t
get Get
(Map String Mark
-> HLState () -> Set Overlay -> Point -> BufferImpl ())
-> Get (Map String Mark)
-> Get (HLState () -> Set Overlay -> Point -> BufferImpl ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Map String Mark)
forall t. Binary t => Get t
get Get (HLState () -> Set Overlay -> Point -> BufferImpl ())
-> Get (HLState ()) -> Get (Set Overlay -> Point -> BufferImpl ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HLState () -> Get (HLState ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure HLState ()
forall syntax. HLState syntax
dummyHlState Get (Set Overlay -> Point -> BufferImpl ())
-> Get (Set Overlay) -> Get (Point -> BufferImpl ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Overlay -> Get (Set Overlay)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Overlay
forall a. Set a
Set.empty Get (Point -> BufferImpl ()) -> Get Point -> Get (BufferImpl ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> Get Point
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point
0
data Update
= Insert
{ Update -> Point
updatePoint :: !Point
, Update -> Direction
updateDirection :: !Direction
, Update -> YiString
_insertUpdateString :: !YiString
}
| Delete
{ updatePoint :: !Point
, updateDirection :: !Direction
, Update -> YiString
_deleteUpdateString :: !YiString
} deriving (Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
(Int -> Update -> ShowS)
-> (Update -> String) -> ([Update] -> ShowS) -> Show Update
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Update] -> ShowS
$cshowList :: [Update] -> ShowS
show :: Update -> String
$cshow :: Update -> String
showsPrec :: Int -> Update -> ShowS
$cshowsPrec :: Int -> Update -> ShowS
Show, Typeable, (forall x. Update -> Rep Update x)
-> (forall x. Rep Update x -> Update) -> Generic Update
forall x. Rep Update x -> Update
forall x. Update -> Rep Update x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Update x -> Update
$cfrom :: forall x. Update -> Rep Update x
Generic)
instance Binary Update
updateIsDelete :: Update -> Bool
updateIsDelete :: Update -> Bool
updateIsDelete Delete {} = Bool
True
updateIsDelete Insert {} = Bool
False
updateString :: Update -> YiString
updateString :: Update -> YiString
updateString (Insert Point
_ Direction
_ YiString
s) = YiString
s
updateString (Delete Point
_ Direction
_ YiString
s) = YiString
s
updateSize :: Update -> Size
updateSize :: Update -> Size
updateSize = Int -> Size
Size (Int -> Size) -> (Update -> Int) -> Update -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Update -> Int) -> Update -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Int
R.length (YiString -> Int) -> (Update -> YiString) -> Update -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update -> YiString
updateString
data UIUpdate = TextUpdate !Update
| StyleUpdate !Point !Size
deriving ((forall x. UIUpdate -> Rep UIUpdate x)
-> (forall x. Rep UIUpdate x -> UIUpdate) -> Generic UIUpdate
forall x. Rep UIUpdate x -> UIUpdate
forall x. UIUpdate -> Rep UIUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UIUpdate x -> UIUpdate
$cfrom :: forall x. UIUpdate -> Rep UIUpdate x
Generic)
instance Binary UIUpdate
newBI :: YiString -> BufferImpl ()
newBI :: YiString -> BufferImpl ()
newBI YiString
s = YiString
-> Marks
-> Map String Mark
-> HLState ()
-> Set Overlay
-> Point
-> BufferImpl ()
forall syntax.
YiString
-> Marks
-> Map String Mark
-> HLState syntax
-> Set Overlay
-> Point
-> BufferImpl syntax
FBufferData YiString
s Marks
forall k a. Map k a
M.empty Map String Mark
forall k a. Map k a
M.empty HLState ()
forall syntax. HLState syntax
dummyHlState Set Overlay
forall a. Set a
Set.empty Point
0
insertChars :: YiString -> YiString -> Point -> YiString
insertChars :: YiString -> YiString -> Point -> YiString
insertChars YiString
p YiString
cs (Point Int
i) = YiString
left YiString -> YiString -> YiString
`R.append` YiString
cs YiString -> YiString -> YiString
`R.append` YiString
right
where (YiString
left, YiString
right) = Int -> YiString -> (YiString, YiString)
R.splitAt Int
i YiString
p
{-# INLINE insertChars #-}
deleteChars :: YiString -> Point -> Size -> YiString
deleteChars :: YiString -> Point -> Size -> YiString
deleteChars YiString
p (Point Int
i) (Size Int
n) = YiString
left YiString -> YiString -> YiString
`R.append` YiString
right
where (YiString
left, YiString
rest) = Int -> YiString -> (YiString, YiString)
R.splitAt Int
i YiString
p
right :: YiString
right = Int -> YiString -> YiString
R.drop Int
n YiString
rest
{-# INLINE deleteChars #-}
shiftMarkValue :: Point -> Size -> MarkValue -> MarkValue
shiftMarkValue :: Point -> Size -> MarkValue -> MarkValue
shiftMarkValue Point
from Size
by (MarkValue Point
p Direction
gravity) = Point -> Direction -> MarkValue
MarkValue Point
shifted Direction
gravity
where shifted :: Point
shifted | Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
from = Point
p
| Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
from = case Direction
gravity of
Direction
Backward -> Point
p
Direction
Forward -> Point
p'
| Bool
otherwise = Point
p'
where p' :: Point
p' = Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
from (Point
p Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Size
by)
mapOvlMarks :: (MarkValue -> MarkValue) -> Overlay -> Overlay
mapOvlMarks :: (MarkValue -> MarkValue) -> Overlay -> Overlay
mapOvlMarks MarkValue -> MarkValue
f (Overlay YiString
_owner MarkValue
s MarkValue
e StyleName
v YiString
msg) = YiString
-> MarkValue -> MarkValue -> StyleName -> YiString -> Overlay
Overlay YiString
_owner (MarkValue -> MarkValue
f MarkValue
s) (MarkValue -> MarkValue
f MarkValue
e) StyleName
v YiString
msg
sizeBI :: BufferImpl syntax -> Point
sizeBI :: BufferImpl syntax -> Point
sizeBI = Int -> Point
Point (Int -> Point)
-> (BufferImpl syntax -> Int) -> BufferImpl syntax -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Int
R.length (YiString -> Int)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
nelemsBI :: Int -> Point -> BufferImpl syntax -> YiString
nelemsBI :: Int -> Point -> BufferImpl syntax -> YiString
nelemsBI Int
n (Point Int
i) = Int -> YiString -> YiString
R.take Int
n (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.drop Int
i (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
getStream :: Direction -> Point -> BufferImpl syntax -> YiString
getStream :: Direction -> Point -> BufferImpl syntax -> YiString
getStream Direction
Forward (Point Int
i) = Int -> YiString -> YiString
R.drop Int
i (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
getStream Direction
Backward (Point Int
i) = YiString -> YiString
R.reverse (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.take Int
i (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
getIndexedStream :: Direction -> Point -> BufferImpl syntax -> [(Point,Char)]
getIndexedStream :: Direction -> Point -> BufferImpl syntax -> [(Point, Char)]
getIndexedStream Direction
Forward (Point Int
p) = [Point] -> String -> [(Point, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Point
Point Int
p..] (String -> [(Point, Char)])
-> (BufferImpl syntax -> String)
-> BufferImpl syntax
-> [(Point, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> String
R.toString (YiString -> String)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.drop Int
p (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
getIndexedStream Direction
Backward (Point Int
p) = [Point] -> String -> [(Point, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Point -> [Point]
forall t. Enum t => t -> [t]
dF (Point -> Point
forall a. Enum a => a -> a
pred (Int -> Point
Point Int
p))) (String -> [(Point, Char)])
-> (BufferImpl syntax -> String)
-> BufferImpl syntax
-> [(Point, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> String
R.toReverseString (YiString -> String)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.take Int
p (YiString -> YiString)
-> (BufferImpl syntax -> YiString) -> BufferImpl syntax -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem
where
dF :: t -> [t]
dF t
n = t
n t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
dF (t -> t
forall a. Enum a => a -> a
pred t
n)
mkOverlay :: R.YiString -> Region -> StyleName -> R.YiString -> Overlay
mkOverlay :: YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
owner Region
r =
YiString
-> MarkValue -> MarkValue -> StyleName -> YiString -> Overlay
Overlay YiString
owner
(Point -> Direction -> MarkValue
MarkValue (Region -> Point
regionStart Region
r) Direction
Backward)
(Point -> Direction -> MarkValue
MarkValue (Region -> Point
regionEnd Region
r) Direction
Forward)
overlayUpdate :: Overlay -> UIUpdate
overlayUpdate :: Overlay -> UIUpdate
overlayUpdate (Overlay YiString
_owner (MarkValue Point
s Direction
_) (MarkValue Point
e Direction
_) StyleName
_ YiString
_ann) =
Point -> Size -> UIUpdate
StyleUpdate Point
s (Point
e Point -> Point -> Size
forall absolute relative.
SemiNum absolute relative =>
absolute -> absolute -> relative
~- Point
s)
addOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax
addOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax
addOverlayBI Overlay
ov BufferImpl syntax
fb = BufferImpl syntax
fb{overlays :: Set Overlay
overlays = Overlay -> Set Overlay -> Set Overlay
forall a. Ord a => a -> Set a -> Set a
Set.insert Overlay
ov (BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb)}
delOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax
delOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax
delOverlayBI Overlay
ov BufferImpl syntax
fb = BufferImpl syntax
fb{overlays :: Set Overlay
overlays = Overlay -> Set Overlay -> Set Overlay
forall a. Ord a => a -> Set a -> Set a
Set.delete Overlay
ov (BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb)}
delOverlaysOfOwnerBI :: R.YiString -> BufferImpl syntax -> BufferImpl syntax
delOverlaysOfOwnerBI :: YiString -> BufferImpl syntax -> BufferImpl syntax
delOverlaysOfOwnerBI YiString
owner BufferImpl syntax
fb =
BufferImpl syntax
fb{overlays :: Set Overlay
overlays = (Overlay -> Bool) -> Set Overlay -> Set Overlay
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
/= YiString
owner) (YiString -> Bool) -> (Overlay -> YiString) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> YiString
overlayOwner) (BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb)}
getOverlaysOfOwnerBI :: R.YiString -> BufferImpl syntax -> Set.Set Overlay
getOverlaysOfOwnerBI :: YiString -> BufferImpl syntax -> Set Overlay
getOverlaysOfOwnerBI YiString
owner BufferImpl syntax
fb =
(Overlay -> Bool) -> Set Overlay -> Set Overlay
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
owner) (YiString -> Bool) -> (Overlay -> YiString) -> Overlay -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlay -> YiString
overlayOwner) (BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb)
strokesRangesBI :: (Point -> Point -> Point -> [Stroke]) ->
Maybe SearchExp -> Region -> Point -> BufferImpl syntax -> [[Stroke]]
strokesRangesBI :: (Point -> Point -> Point -> [Stroke])
-> Maybe SearchExp
-> Region
-> Point
-> BufferImpl syntax
-> [[Stroke]]
strokesRangesBI Point -> Point -> Point -> [Stroke]
getStrokes Maybe SearchExp
regex Region
rgn Point
point BufferImpl syntax
fb = [[Stroke]]
result
where
i :: Point
i = Region -> Point
regionStart Region
rgn
j :: Point
j = Region -> Point
regionEnd Region
rgn
dropBefore :: [Span a] -> [Span a]
dropBefore = (Span a -> Bool) -> [Span a] -> [Span a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Span a
s ->Span a -> Point
forall a. Span a -> Point
spanEnd Span a
s Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
i)
takeIn :: [Span a] -> [Span a]
takeIn = (Span a -> Bool) -> [Span a] -> [Span a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Span a
s -> Span a -> Point
forall a. Span a -> Point
spanBegin Span a
s Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
j)
groundLayer :: [Stroke]
groundLayer = [Point -> StyleName -> Point -> Stroke
forall a. Point -> a -> Point -> Span a
Span Point
i StyleName
forall a. Monoid a => a
mempty Point
j]
syntaxHlLayer :: [Stroke]
syntaxHlLayer = (Stroke -> Bool) -> [Stroke] -> [Stroke]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Span Point
b StyleName
_m Point
a) -> Point
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
a) ([Stroke] -> [Stroke]) -> [Stroke] -> [Stroke]
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> [Stroke]
getStrokes Point
point Point
i Point
j
layers2 :: [[Stroke]]
layers2 = ([Overlay] -> [Stroke]) -> [[Overlay]] -> [[Stroke]]
forall a b. (a -> b) -> [a] -> [b]
map ((Overlay -> Stroke) -> [Overlay] -> [Stroke]
forall a b. (a -> b) -> [a] -> [b]
map Overlay -> Stroke
overlayStroke) ([[Overlay]] -> [[Stroke]]) -> [[Overlay]] -> [[Stroke]]
forall a b. (a -> b) -> a -> b
$ (Overlay -> Overlay -> Bool) -> [Overlay] -> [[Overlay]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (YiString -> YiString -> Bool)
-> (Overlay -> YiString) -> Overlay -> Overlay -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Overlay -> YiString
overlayOwner) ([Overlay] -> [[Overlay]]) -> [Overlay] -> [[Overlay]]
forall a b. (a -> b) -> a -> b
$ Set Overlay -> [Overlay]
forall a. Set a -> [a]
Set.toList (Set Overlay -> [Overlay]) -> Set Overlay -> [Overlay]
forall a b. (a -> b) -> a -> b
$ BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb
layer3 :: [Stroke]
layer3 = case Maybe SearchExp
regex of
Just SearchExp
re -> [Stroke] -> [Stroke]
forall a. [Span a] -> [Span a]
takeIn ([Stroke] -> [Stroke]) -> [Stroke] -> [Stroke]
forall a b. (a -> b) -> a -> b
$ (Region -> Stroke) -> [Region] -> [Stroke]
forall a b. (a -> b) -> [a] -> [b]
map Region -> Stroke
hintStroke ([Region] -> [Stroke]) -> [Region] -> [Stroke]
forall a b. (a -> b) -> a -> b
$ SearchExp -> Region -> BufferImpl syntax -> [Region]
SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region]
regexRegionBI SearchExp
re (Point -> Point -> Region
mkRegion Point
i Point
j) BufferImpl syntax
fb
Maybe SearchExp
Nothing -> []
result :: [[Stroke]]
result = ([Stroke] -> [Stroke]) -> [[Stroke]] -> [[Stroke]]
forall a b. (a -> b) -> [a] -> [b]
map ((Stroke -> Stroke) -> [Stroke] -> [Stroke]
forall a b. (a -> b) -> [a] -> [b]
map Stroke -> Stroke
forall a. Span a -> Span a
clampStroke ([Stroke] -> [Stroke])
-> ([Stroke] -> [Stroke]) -> [Stroke] -> [Stroke]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stroke] -> [Stroke]
forall a. [Span a] -> [Span a]
takeIn ([Stroke] -> [Stroke])
-> ([Stroke] -> [Stroke]) -> [Stroke] -> [Stroke]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stroke] -> [Stroke]
forall a. [Span a] -> [Span a]
dropBefore) ([Stroke]
layer3 [Stroke] -> [[Stroke]] -> [[Stroke]]
forall a. a -> [a] -> [a]
: [[Stroke]]
layers2 [[Stroke]] -> [[Stroke]] -> [[Stroke]]
forall a. [a] -> [a] -> [a]
++ [[Stroke]
syntaxHlLayer, [Stroke]
groundLayer])
overlayStroke :: Overlay -> Stroke
overlayStroke (Overlay YiString
_owner MarkValue
sm MarkValue
em StyleName
a YiString
_msg) =
Point -> StyleName -> Point -> Stroke
forall a. Point -> a -> Point -> Span a
Span (MarkValue -> Point
markPoint MarkValue
sm) StyleName
a (MarkValue -> Point
markPoint MarkValue
em)
clampStroke :: Span a -> Span a
clampStroke (Span Point
l a
x Point
r) = Point -> a -> Point -> Span a
forall a. Point -> a -> Point -> Span a
Span (Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
i Point
l) a
x (Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
j Point
r)
hintStroke :: Region -> Stroke
hintStroke Region
r = Point -> StyleName -> Point -> Stroke
forall a. Point -> a -> Point -> Span a
Span (Region -> Point
regionStart Region
r) (if Point
point Point -> Region -> Bool
`nearRegion` Region
r then StyleName
strongHintStyle else StyleName
hintStyle) (Region -> Point
regionEnd Region
r)
isValidUpdate :: Update -> BufferImpl syntax -> Bool
isValidUpdate :: Update -> BufferImpl syntax -> Bool
isValidUpdate Update
u BufferImpl syntax
b = case Update
u of
(Delete Point
p Direction
_ YiString
_) -> Point -> Bool
check Point
p Bool -> Bool -> Bool
&& Point -> Bool
check (Point
p Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Update -> Size
updateSize Update
u)
(Insert Point
p Direction
_ YiString
_) -> Point -> Bool
check Point
p
where check :: Point -> Bool
check (Point Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= YiString -> Int
R.length (BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
b)
applyUpdateI :: Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateI :: Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateI Update
u BufferImpl syntax
fb = Point -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Point -> BufferImpl syntax -> BufferImpl syntax
touchSyntax (Update -> Point
updatePoint Update
u) (BufferImpl syntax -> BufferImpl syntax)
-> BufferImpl syntax -> BufferImpl syntax
forall a b. (a -> b) -> a -> b
$
BufferImpl syntax
fb {mem :: YiString
mem = YiString
p', marks :: Marks
marks = (MarkValue -> MarkValue) -> Marks -> Marks
forall a b k. (a -> b) -> Map k a -> Map k b
M.map MarkValue -> MarkValue
shift (BufferImpl syntax -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl syntax
fb),
overlays :: Set Overlay
overlays = (Overlay -> Overlay) -> Set Overlay -> Set Overlay
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((MarkValue -> MarkValue) -> Overlay -> Overlay
mapOvlMarks MarkValue -> MarkValue
shift) (BufferImpl syntax -> Set Overlay
forall syntax. BufferImpl syntax -> Set Overlay
overlays BufferImpl syntax
fb)}
where (!YiString
p', !Size
amount) = case Update
u of
Insert Point
pnt Direction
_ YiString
cs -> (YiString -> YiString -> Point -> YiString
insertChars YiString
p YiString
cs Point
pnt, Size
sz)
Delete Point
pnt Direction
_ YiString
_ -> (YiString -> Point -> Size -> YiString
deleteChars YiString
p Point
pnt Size
sz, Size -> Size
forall a. Num a => a -> a
negate Size
sz)
!sz :: Size
sz = Update -> Size
updateSize Update
u
shift :: MarkValue -> MarkValue
shift = Point -> Size -> MarkValue -> MarkValue
shiftMarkValue (Update -> Point
updatePoint Update
u) Size
amount
p :: YiString
p = BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
fb
reverseUpdateI :: Update -> Update
reverseUpdateI :: Update -> Update
reverseUpdateI (Delete Point
p Direction
dir YiString
cs) = Point -> Direction -> YiString -> Update
Insert Point
p (Direction -> Direction
reverseDir Direction
dir) YiString
cs
reverseUpdateI (Insert Point
p Direction
dir YiString
cs) = Point -> Direction -> YiString -> Update
Delete Point
p (Direction -> Direction
reverseDir Direction
dir) YiString
cs
lineAt :: Point
-> BufferImpl syntax -> Int
lineAt :: Point -> BufferImpl syntax -> Int
lineAt (Point Int
p) BufferImpl syntax
fb = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ YiString -> Int
R.countNewLines (Int -> YiString -> YiString
R.take Int
p (YiString -> YiString) -> YiString -> YiString
forall a b. (a -> b) -> a -> b
$ BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
fb)
solPoint :: Int -> BufferImpl syntax -> Point
solPoint :: Int -> BufferImpl syntax -> Point
solPoint Int
line BufferImpl syntax
fb = Int -> Point
Point (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ YiString -> Int
R.length (YiString -> Int) -> YiString -> Int
forall a b. (a -> b) -> a -> b
$ (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString, YiString) -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> YiString -> (YiString, YiString)
R.splitAtLine (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
fb)
eolPoint' :: Point
-> BufferImpl syntax
-> Point
eolPoint' :: Point -> BufferImpl syntax -> Point
eolPoint' p :: Point
p@(Point Int
ofs) BufferImpl syntax
fb = Int -> Point
Point (Int -> Point) -> (YiString -> Int) -> YiString -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Int
checkEol (YiString -> Int) -> (YiString -> YiString) -> YiString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
R.splitAtLine Int
ln (YiString -> Point) -> YiString -> Point
forall a b. (a -> b) -> a -> b
$ BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
fb
where
ln :: Int
ln = Point -> BufferImpl syntax -> Int
forall syntax. Point -> BufferImpl syntax -> Int
lineAt Point
p BufferImpl syntax
fb
checkEol :: YiString -> Int
checkEol YiString
t =
let l' :: Int
l' = YiString -> Int
R.length YiString
t
in case YiString -> Maybe Char
R.last YiString
t of
Just Char
'\n' | Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ofs -> Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Maybe Char
_ -> Int
l'
solPoint' :: Point -> BufferImpl syntax -> Point
solPoint' :: Point -> BufferImpl syntax -> Point
solPoint' Point
point BufferImpl syntax
fb = Int -> BufferImpl syntax -> Point
forall syntax. Int -> BufferImpl syntax -> Point
solPoint (Point -> BufferImpl syntax -> Int
forall syntax. Point -> BufferImpl syntax -> Int
lineAt Point
point BufferImpl syntax
fb) BufferImpl syntax
fb
charsFromSolBI :: Point -> BufferImpl syntax -> YiString
charsFromSolBI :: Point -> BufferImpl syntax -> YiString
charsFromSolBI Point
pnt BufferImpl syntax
fb = Int -> Point -> BufferImpl syntax -> YiString
forall syntax. Int -> Point -> BufferImpl syntax -> YiString
nelemsBI (Point -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Point -> Int) -> Point -> Int
forall a b. (a -> b) -> a -> b
$ Point
pnt Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
sol) Point
sol BufferImpl syntax
fb
where sol :: Point
sol = Point -> BufferImpl syntax -> Point
forall syntax. Point -> BufferImpl syntax -> Point
solPoint' Point
pnt BufferImpl syntax
fb
regexRegionBI :: SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region]
regexRegionBI :: SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region]
regexRegionBI SearchExp
se Region
r BufferImpl syntax
fb = case Direction
dir of
Direction
Forward -> (Array Int (Int, Int) -> Region)
-> [Array Int (Int, Int)] -> [Region]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point -> Point) -> Region -> Region
fmapRegion Point -> Point
addPoint (Region -> Region)
-> (Array Int (Int, Int) -> Region)
-> Array Int (Int, Int)
-> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Int, Int) -> Region
forall i. (Ix i, Num i) => Array i (Int, Int) -> Region
matchedRegion) ([Array Int (Int, Int)] -> [Region])
-> [Array Int (Int, Int)] -> [Region]
forall a b. (a -> b) -> a -> b
$ String -> [Array Int (Int, Int)]
matchAll' (String -> [Array Int (Int, Int)])
-> String -> [Array Int (Int, Int)]
forall a b. (a -> b) -> a -> b
$ YiString -> String
R.toString YiString
bufReg
Direction
Backward -> (Array Int (Int, Int) -> Region)
-> [Array Int (Int, Int)] -> [Region]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point -> Point) -> Region -> Region
fmapRegion Point -> Point
subPoint (Region -> Region)
-> (Array Int (Int, Int) -> Region)
-> Array Int (Int, Int)
-> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Int, Int) -> Region
forall i. (Ix i, Num i) => Array i (Int, Int) -> Region
matchedRegion) ([Array Int (Int, Int)] -> [Region])
-> [Array Int (Int, Int)] -> [Region]
forall a b. (a -> b) -> a -> b
$ String -> [Array Int (Int, Int)]
matchAll' (String -> [Array Int (Int, Int)])
-> String -> [Array Int (Int, Int)]
forall a b. (a -> b) -> a -> b
$ YiString -> String
R.toReverseString YiString
bufReg
where matchedRegion :: Array i (Int, Int) -> Region
matchedRegion Array i (Int, Int)
arr = let (Int
off,Int
len) = Array i (Int, Int)
arrArray i (Int, Int) -> i -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
!i
0 in Point -> Point -> Region
mkRegion (Int -> Point
Point Int
off) (Int -> Point
Point (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len))
addPoint :: Point -> Point
addPoint (Point Int
x) = Int -> Point
Point (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
subPoint :: Point -> Point
subPoint (Point Int
x) = Int -> Point
Point (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)
matchAll' :: String -> [Array Int (Int, Int)]
matchAll' = Regex -> String -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll (Direction -> SearchExp -> Regex
searchRegex Direction
dir SearchExp
se)
dir :: Direction
dir = Region -> Direction
regionDirection Region
r
Point Int
p = Region -> Point
regionStart Region
r
Point Int
q = Region -> Point
regionEnd Region
r
Size Int
s = Region -> Size
regionSize Region
r
bufReg :: YiString
bufReg = Int -> YiString -> YiString
R.take Int
s (YiString -> YiString)
-> (YiString -> YiString) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> YiString
R.drop Int
p (YiString -> YiString) -> YiString -> YiString
forall a b. (a -> b) -> a -> b
$ BufferImpl syntax -> YiString
forall syntax. BufferImpl syntax -> YiString
mem BufferImpl syntax
fb
newMarkBI :: MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)
newMarkBI :: MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)
newMarkBI MarkValue
initialValue BufferImpl syntax
fb =
let maxId :: Int
maxId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Mark -> Int
markId (Mark -> Int)
-> (((Mark, MarkValue), Marks) -> Mark)
-> ((Mark, MarkValue), Marks)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mark, MarkValue) -> Mark
forall a b. (a, b) -> a
fst ((Mark, MarkValue) -> Mark)
-> (((Mark, MarkValue), Marks) -> (Mark, MarkValue))
-> ((Mark, MarkValue), Marks)
-> Mark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Mark, MarkValue), Marks) -> (Mark, MarkValue)
forall a b. (a, b) -> a
fst (((Mark, MarkValue), Marks) -> Int)
-> Maybe ((Mark, MarkValue), Marks) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marks -> Maybe ((Mark, MarkValue), Marks)
forall k a. Map k a -> Maybe ((k, a), Map k a)
M.maxViewWithKey (BufferImpl syntax -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl syntax
fb)
newMark :: Mark
newMark = Int -> Mark
Mark (Int -> Mark) -> Int -> Mark
forall a b. (a -> b) -> a -> b
$ Int
maxId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
fb' :: BufferImpl syntax
fb' = BufferImpl syntax
fb { marks :: Marks
marks = Mark -> MarkValue -> Marks -> Marks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mark
newMark MarkValue
initialValue (BufferImpl syntax -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl syntax
fb)}
in (BufferImpl syntax
fb', Mark
newMark)
getMarkValueBI :: Mark -> BufferImpl syntax -> Maybe MarkValue
getMarkValueBI :: Mark -> BufferImpl syntax -> Maybe MarkValue
getMarkValueBI Mark
m (FBufferData { marks :: forall syntax. BufferImpl syntax -> Marks
marks = Marks
marksMap } ) = Mark -> Marks -> Maybe MarkValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Mark
m Marks
marksMap
deleteMarkValueBI :: Mark -> BufferImpl syntax -> BufferImpl syntax
deleteMarkValueBI :: Mark -> BufferImpl syntax -> BufferImpl syntax
deleteMarkValueBI Mark
m BufferImpl syntax
fb = BufferImpl syntax
fb { marks :: Marks
marks = Mark -> Marks -> Marks
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Mark
m (BufferImpl syntax -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl syntax
fb) }
getMarkBI :: String -> BufferImpl syntax -> Maybe Mark
getMarkBI :: String -> BufferImpl syntax -> Maybe Mark
getMarkBI String
name FBufferData {markNames :: forall syntax. BufferImpl syntax -> Map String Mark
markNames = Map String Mark
nms} = String -> Map String Mark -> Maybe Mark
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String Mark
nms
modifyMarkBI :: Mark -> (MarkValue -> MarkValue) -> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
modifyMarkBI :: Mark
-> (MarkValue -> MarkValue)
-> forall syntax. BufferImpl syntax -> BufferImpl syntax
modifyMarkBI Mark
m MarkValue -> MarkValue
f BufferImpl syntax
fb = BufferImpl syntax
fb {marks :: Marks
marks = (MarkValue -> MarkValue) -> Mark -> Marks -> Marks
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
mapAdjust' MarkValue -> MarkValue
f Mark
m (BufferImpl syntax -> Marks
forall syntax. BufferImpl syntax -> Marks
marks BufferImpl syntax
fb)}
setSyntaxBI :: ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax
setSyntaxBI :: ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax
setSyntaxBI (ExtHL Highlighter cache syntax
e) BufferImpl oldSyntax
fb = Point -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Point -> BufferImpl syntax -> BufferImpl syntax
touchSyntax Point
0 (BufferImpl syntax -> BufferImpl syntax)
-> BufferImpl syntax -> BufferImpl syntax
forall a b. (a -> b) -> a -> b
$ BufferImpl oldSyntax
fb {hlCache :: HLState syntax
hlCache = Highlighter cache syntax -> cache -> HLState syntax
forall syntax cache.
Highlighter cache syntax -> cache -> HLState syntax
HLState Highlighter cache syntax
e (Highlighter cache syntax -> cache
forall cache syntax. Highlighter cache syntax -> cache
hlStartState Highlighter cache syntax
e)}
touchSyntax :: Point -> BufferImpl syntax -> BufferImpl syntax
touchSyntax :: Point -> BufferImpl syntax -> BufferImpl syntax
touchSyntax Point
touchedIndex BufferImpl syntax
fb = BufferImpl syntax
fb { dirtyOffset :: Point
dirtyOffset = Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
touchedIndex (BufferImpl syntax -> Point
forall syntax. BufferImpl syntax -> Point
dirtyOffset BufferImpl syntax
fb)}
updateSyntax :: BufferImpl syntax -> BufferImpl syntax
updateSyntax :: BufferImpl syntax -> BufferImpl syntax
updateSyntax fb :: BufferImpl syntax
fb@FBufferData {dirtyOffset :: forall syntax. BufferImpl syntax -> Point
dirtyOffset = Point
touchedIndex, hlCache :: forall syntax. BufferImpl syntax -> HLState syntax
hlCache = HLState Highlighter cache syntax
hl cache
cache}
| Point
touchedIndex Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
forall a. Bounded a => a
maxBound = BufferImpl syntax
fb
| Bool
otherwise
= BufferImpl syntax
fb {dirtyOffset :: Point
dirtyOffset = Point
forall a. Bounded a => a
maxBound,
hlCache :: HLState syntax
hlCache = Highlighter cache syntax -> cache -> HLState syntax
forall syntax cache.
Highlighter cache syntax -> cache -> HLState syntax
HLState Highlighter cache syntax
hl (Highlighter cache syntax
-> Scanner Point Char -> Point -> cache -> cache
forall cache syntax.
Highlighter cache syntax
-> Scanner Point Char -> Point -> cache -> cache
hlRun Highlighter cache syntax
hl Scanner Point Char
getText Point
touchedIndex cache
cache)
}
where getText :: Scanner Point Char
getText = Point
-> (Point -> Point)
-> Char
-> (Point -> [(Point, Char)])
-> Scanner Point Char
forall st a.
st -> (st -> Point) -> a -> (st -> [(st, a)]) -> Scanner st a
Scanner Point
0 Point -> Point
forall a. a -> a
id (String -> Char
forall a. HasCallStack => String -> a
error String
"getText: no character beyond eof")
(\Point
idx -> Direction -> Point -> BufferImpl syntax -> [(Point, Char)]
forall syntax.
Direction -> Point -> BufferImpl syntax -> [(Point, Char)]
getIndexedStream Direction
Forward Point
idx BufferImpl syntax
fb)
getMarkDefaultPosBI :: Maybe String -> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark)
getMarkDefaultPosBI :: Maybe String
-> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark)
getMarkDefaultPosBI Maybe String
name Point
defaultPos fb :: BufferImpl syntax
fb@FBufferData {marks :: forall syntax. BufferImpl syntax -> Marks
marks = Marks
mks, markNames :: forall syntax. BufferImpl syntax -> Map String Mark
markNames = Map String Mark
nms} =
case (String -> Map String Mark -> Maybe Mark)
-> Map String Mark -> String -> Maybe Mark
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String Mark -> Maybe Mark
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map String Mark
nms (String -> Maybe Mark) -> Maybe String -> Maybe Mark
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
name of
Just Mark
m' -> (BufferImpl syntax
fb, Mark
m')
Maybe Mark
Nothing ->
let newMark :: Mark
newMark = Int -> Mark
Mark (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Mark -> Int
markId (Mark -> Int) -> Mark -> Int
forall a b. (a -> b) -> a -> b
$ (Mark, MarkValue) -> Mark
forall a b. (a, b) -> a
fst (Marks -> (Mark, MarkValue)
forall k a. Map k a -> (k, a)
M.findMax Marks
mks)))
nms' :: Map String Mark
nms' = case Maybe String
name of
Maybe String
Nothing -> Map String Mark
nms
Just String
nm -> String -> Mark -> Map String Mark -> Map String Mark
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
nm Mark
newMark Map String Mark
nms
mks' :: Marks
mks' = Mark -> MarkValue -> Marks -> Marks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Mark
newMark (Point -> Direction -> MarkValue
MarkValue Point
defaultPos Direction
Forward) Marks
mks
in (BufferImpl syntax
fb {marks :: Marks
marks = Marks
mks', markNames :: Map String Mark
markNames = Map String Mark
nms'}, Mark
newMark)
getAst :: WindowRef -> BufferImpl syntax -> syntax
getAst :: WindowRef -> BufferImpl syntax -> syntax
getAst WindowRef
w FBufferData {hlCache :: forall syntax. BufferImpl syntax -> HLState syntax
hlCache = HLState (SynHL {hlGetTree :: forall cache syntax.
Highlighter cache syntax -> cache -> WindowRef -> syntax
hlGetTree = cache -> WindowRef -> syntax
gt}) cache
cache} = cache -> WindowRef -> syntax
gt cache
cache WindowRef
w
focusAst :: M.Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax
focusAst :: Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax
focusAst Map WindowRef Region
r b :: BufferImpl syntax
b@FBufferData {hlCache :: forall syntax. BufferImpl syntax -> HLState syntax
hlCache = HLState s :: Highlighter cache syntax
s@(SynHL {hlFocus :: forall cache syntax.
Highlighter cache syntax -> Map WindowRef Region -> cache -> cache
hlFocus = Map WindowRef Region -> cache -> cache
foc}) cache
cache} = BufferImpl syntax
b {hlCache :: HLState syntax
hlCache = Highlighter cache syntax -> cache -> HLState syntax
forall syntax cache.
Highlighter cache syntax -> cache -> HLState syntax
HLState Highlighter cache syntax
s (Map WindowRef Region -> cache -> cache
foc Map WindowRef Region
r cache
cache)}