{-# 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 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 -- ^ 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 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

-- | 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 _ _ 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

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

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

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

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

------------------------------------------------------------------------
-- 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 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 {- 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 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

-------------------------------------
-- * "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 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

-- | 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 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)

-- | 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 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)

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

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

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

-- 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 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]

    -- 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 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)

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

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

-- | Apply a /valid/ update
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)}
                                   -- 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 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
          -- FIXME: remove collapsed overlays

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


------------------------------------------------------------------------
-- 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 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)

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

-- | 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 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
    -- In case we're somewhere without trailing newline, we need to
    -- stay where we are
    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
          -- We're looking at EOL and we weren't asking for EOL past
          -- this point, so back up one for good visual effect
          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
          -- We asked for EOL past the last newline so just go to the
          -- very end of content
          _ -> Int
l'

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

-- | 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 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

-- | 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 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)}
-- 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 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)

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

-- | 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 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)}