{-# 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 a :: YiString
a b :: MarkValue
b c :: MarkValue
c _ msg :: YiString
msg == :: Overlay -> Overlay -> Bool
== Overlay a' :: YiString
a' b' :: MarkValue
b' c' :: MarkValue
c' _ msg' :: 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 a :: YiString
a b :: MarkValue
b c :: MarkValue
c _ msg :: YiString
msg) (Overlay a' :: YiString
a' b' :: MarkValue
b' c' :: MarkValue
c' _ msg' :: 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 a :: YiString
a b :: MarkValue
b c :: MarkValue
c _ msg :: YiString
msg) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "Overlay { "
, "overlayOwner = ", YiString -> String
forall a. Show a => a -> String
show YiString
a, ", "
, "overlayBegin = ", MarkValue -> String
forall a. Show a => a -> String
show MarkValue
b, ", "
, "overlayEnd = ", MarkValue -> String
forall a. Show a => a -> String
show MarkValue
c, ", "
, "overlayAnnotation = ", YiString -> String
forall a. Show a => a -> String
show YiString
msg, "}"]
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 b :: 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 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 _ _ s :: YiString
s) = YiString
s
updateString (Delete _ _ s :: 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 s :: 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 0
insertChars :: YiString -> YiString -> Point -> YiString
insertChars :: YiString -> YiString -> Point -> YiString
insertChars p :: YiString
p cs :: YiString
cs (Point i :: Int
i) = YiString
left YiString -> YiString -> YiString
`R.append` YiString
cs YiString -> YiString -> YiString
`R.append` YiString
right
where (left :: YiString
left, right :: 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 p :: YiString
p (Point i :: Int
i) (Size n :: Int
n) = YiString
left YiString -> YiString -> YiString
`R.append` YiString
right
where (left :: YiString
left, rest :: 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 from :: Point
from by :: Size
by (MarkValue p :: Point
p gravity :: 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
Backward -> Point
p
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 f :: MarkValue -> MarkValue
f (Overlay _owner :: YiString
_owner s :: MarkValue
s e :: MarkValue
e v :: StyleName
v msg :: 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 n :: Int
n (Point i :: 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 Forward (Point i :: 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 Backward (Point i :: 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 Forward (Point p :: 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 Backward (Point p :: 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 n :: 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 owner :: YiString
owner r :: 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 _owner :: YiString
_owner (MarkValue s :: Point
s _) (MarkValue e :: Point
e _) _ _ann :: 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 ov :: Overlay
ov fb :: 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 ov :: Overlay
ov fb :: 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 owner :: YiString
owner fb :: 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 owner :: YiString
owner fb :: 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 getStrokes :: Point -> Point -> Point -> [Stroke]
getStrokes regex :: Maybe SearchExp
regex rgn :: Region
rgn point :: Point
point fb :: 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 (\s :: 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 (\s :: 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 b :: Point
b _m :: StyleName
_m a :: 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 re :: 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
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 _owner :: YiString
_owner sm :: MarkValue
sm em :: MarkValue
em a :: StyleName
a _msg :: 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 l :: Point
l x :: a
x r :: 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 r :: 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 u :: Update
u b :: BufferImpl syntax
b = case Update
u of
(Delete p :: Point
p _ _) -> 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 p :: Point
p _ _) -> Point -> Bool
check Point
p
where check :: Point -> Bool
check (Point x :: Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 u :: Update
u fb :: 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 pnt :: Point
pnt _ cs :: YiString
cs -> (YiString -> YiString -> Point -> YiString
insertChars YiString
p YiString
cs Point
pnt, Size
sz)
Delete pnt :: Point
pnt _ _ -> (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 p :: Point
p dir :: Direction
dir cs :: YiString
cs) = Point -> Direction -> YiString -> Update
Insert Point
p (Direction -> Direction
reverseDir Direction
dir) YiString
cs
reverseUpdateI (Insert p :: Point
p dir :: Direction
dir cs :: 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 p :: Int
p) fb :: BufferImpl syntax
fb = 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 line :: Int
line fb :: 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
- 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 ofs :: Int
ofs) fb :: 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 t :: YiString
t =
let l' :: Int
l' = YiString -> Int
R.length YiString
t
in case YiString -> Maybe Char
R.last YiString
t of
Just '\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
- 1
_ -> Int
l'
solPoint' :: Point -> BufferImpl syntax -> Point
solPoint' :: Point -> BufferImpl syntax -> Point
solPoint' point :: Point
point fb :: 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 pnt :: Point
pnt fb :: 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 se :: SearchExp
se r :: Region
r fb :: BufferImpl syntax
fb = case Direction
dir of
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
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 arr :: Array i (Int, Int)
arr = let (off :: Int
off,len :: Int
len) = Array i (Int, Int)
arrArray i (Int, Int) -> i -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
!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 x :: Int
x) = Int -> Point
Point (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
subPoint :: Point -> Point
subPoint (Point x :: 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 p :: Int
p = Region -> Point
regionStart Region
r
Point q :: Int
q = Region -> Point
regionEnd Region
r
Size s :: 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 initialValue :: MarkValue
initialValue fb :: BufferImpl syntax
fb =
let maxId :: Int
maxId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 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
+ 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 m :: 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 m :: Mark
m fb :: 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 name :: 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 m :: Mark
m f :: MarkValue -> MarkValue
f fb :: 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 e :: Highlighter cache syntax
e) fb :: BufferImpl oldSyntax
fb = Point -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Point -> BufferImpl syntax -> BufferImpl syntax
touchSyntax 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 touchedIndex :: Point
touchedIndex fb :: 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 hl :: Highlighter cache syntax
hl cache :: 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 0 Point -> Point
forall a. a -> a
id (String -> Char
forall a. HasCallStack => String -> a
error "getText: no character beyond eof")
(\idx :: 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 name :: Maybe String
name defaultPos :: 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 m' :: Mark
m' -> (BufferImpl syntax
fb, Mark
m')
Nothing ->
let newMark :: Mark
newMark = Int -> Mark
Mark (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
Nothing -> Map String Mark
nms
Just nm :: 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 w :: 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} = 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 r :: 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
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)}