{-# 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
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- 'Buffer' implementation, wrapping Rope

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 -- ^ buffer text
    , BufferImpl syntax -> Marks
marks       :: !Marks -- ^ Marks for this buffer
    , BufferImpl syntax -> Map String Mark
markNames   :: !(M.Map String Mark)
    , BufferImpl syntax -> HLState syntax
hlCache     :: !(HLState syntax) -- ^ syntax highlighting state
    , BufferImpl syntax -> Set Overlay
overlays    :: !(Set.Set Overlay)
    -- ^ set of (non overlapping) visual overlay regions
    , BufferImpl syntax -> Point
dirtyOffset :: !Point
    -- ^ Lowest modified offset since last recomputation of syntax
    } 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)

-- Atm we can't store overlays because stylenames are functions (can't be serialized)
-- TODO: ideally I'd like to get rid of overlays entirely; although we could imagine them storing mere styles.
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

-- | Mutation actions (also used the undo or redo list)
--
-- For the undo/redo, we use the /partial checkpoint/ (Berlage, pg16) strategy to store
-- just the components of the state that change.
--
-- Note that the update direction is only a hint for moving the cursor
-- (mainly for undo purposes); the insertions and deletions are always
-- applied Forward.
--
-- Note that keeping the text does not cost much: we keep the updates in the undo list;
-- if it's a "Delete" it means we have just inserted the text in the buffer, so the update shares
-- the data with the buffer. If it's an "Insert" we have to keep the data any way.
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

--------------------------------------------------
-- Low-level primitives.

-- | New FBuffer filled from string.
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

-- | Write string into buffer.
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 #-}

-- | Write string into buffer.
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 #-}

------------------------------------------------------------------------
-- Mid-level insert/delete

-- | Shift a mark position, supposing an update at a given point, by a given amount.
-- Negative amount represent deletions.
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 {- p > from -} = 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

-------------------------------------
-- * "high-level" (exported) operations

-- | Point of EOF
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

-- | Return @n@ Chars starting at @i@ of the buffer.
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

-- | TODO: This guy is a pretty big bottleneck and only one function
-- uses it which in turn is only seldom used and most of the output is
-- thrown away anyway. We could probably get away with never
-- converting this to String here. The old implementation did so
-- because it worked over ByteString but we don't have to.
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)

-- | Create an "overlay" for the style @sty@ between points @s@ and @e@
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)

-- | Obtain a style-update for a specific overlay
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)

-- | Add a style "overlay" between the given points.
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)}

-- | Remove a previously added "overlay"
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)

-- FIXME: this can be really inefficient.

-- | Return style information for the range @(i,j)@ Style information
--   is derived from syntax highlighting, active overlays and current regexp.  The
--   returned list contains tuples @(l,s,r)@ where every tuple is to
--   be interpreted as apply the style @s@ from position @l@ to @r@ in
--   the buffer.  In each list, the strokes are guaranteed to be
--   ordered and non-overlapping.  The lists of strokes are ordered by
--   decreasing priority: the 1st layer should be "painted" on top.
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]

    -- zero-length spans seem to break stroking in general, so filter them out!
    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)

------------------------------------------------------------------------
-- Point based editing

-- | Checks if an Update is valid
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)

-- | Apply a /valid/ update
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)}
                                   -- FIXME: this is inefficient; find a way to use mapMonotonic
                                   -- (problem is that marks can have different gravities)
    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
          -- FIXME: remove collapsed overlays

-- | Reverse the given update
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


------------------------------------------------------------------------
-- Line based editing

-- | Line at the given point. (Lines are indexed from 1)
lineAt :: Point -- ^ Line for which to grab EOL for
       -> 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)

-- | Point that starts the given line (Lines are indexed from 1)
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)

-- | Point that's at EOL. Notably, this puts you right before the
-- newline character if one exists, and right at the end of the text
-- if one does not.
eolPoint' :: Point
             -- ^ Point from which we take the line to find the EOL of
          -> 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
    -- In case we're somewhere without trailing newline, we need to
    -- stay where we are
    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
          -- We're looking at EOL and we weren't asking for EOL past
          -- this point, so back up one for good visual effect
          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
          -- We asked for EOL past the last newline so just go to the
          -- very end of content
          Maybe Char
_ -> Int
l'

-- | Get begining of the line relatively to @point@.
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

-- | Return indices of all strings in buffer matching regex, inside the given region.
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

-- | Modify a mark value.
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)}
-- NOTE: we must insert the value strictly otherwise we can hold to whatever structure the value of the mark depends on.
-- (often a whole buffer)

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)

------------------------------------------------------------------------

-- | Returns the requested mark, creating a new mark with that name (at the supplied position) if needed
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)}