{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Buffer.TextUnit
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Working with blocks (units) of text.
--

module Yi.Buffer.TextUnit
    ( TextUnit(..)
    , outsideUnit
    , leftBoundaryUnit
    , unitWord
    , unitViWord
    , unitViWORD
    , unitViWordAnyBnd
    , unitViWORDAnyBnd
    , unitViWordOnLine
    , unitViWORDOnLine
    , unitDelimited
    , unitSentence, unitEmacsParagraph, unitParagraph
    , isAnySep, unitSep, unitSepThisLine, isWordChar
    , moveB, maybeMoveB
    , transformB, transposeB
    , regionOfB, regionOfNonEmptyB, regionOfPartB
    , regionWithTwoMovesB
    , regionOfPartNonEmptyB, regionOfPartNonEmptyAtB
    , readPrevUnitB, readUnitB
    , untilB, doUntilB_, untilB_, whileB, doIfCharB
    , atBoundaryB
    , numberOfB
    , deleteB, genMaybeMoveB
    , genMoveB, BoundarySide(..), genAtBoundaryB
    , checkPeekB
    , halfUnit
    , deleteUnitB
    ) where


import           Control.Monad       (void, when, (<=<))
import           Data.Char           (GeneralCategory (LineSeparator, ParagraphSeparator, Space),
                                      generalCategory, isAlphaNum, isSeparator, isSpace)
import           Data.Typeable       (Typeable)
import           Yi.Buffer.Basic     (Direction (..), Point (Point), mayReverse, reverseDir)
import           Yi.Buffer.Misc
import           Yi.Buffer.Region
import           Yi.Rope             (YiString)
import qualified Yi.Rope             as R (head, reverse, tail, toString)



-- | Designate a given "unit" of text.
data TextUnit = Character -- ^ a single character
              | Line  -- ^ a line of text (between newlines)
              | VLine -- ^ a "vertical" line of text (area of text between two characters at the same column number)
              | Document -- ^ the whole document
              | GenUnit {TextUnit -> TextUnit
genEnclosingUnit :: TextUnit,
                         TextUnit -> Direction -> BufferM Bool
genUnitBoundary  :: Direction -> BufferM Bool}
      -- there could be more text units, like Page, Searched, etc. it's probably a good
      -- idea to use GenUnit though.
                deriving Typeable

-- | Turns a unit into its "negative" by inverting the boundaries. For example,
-- @outsideUnit unitViWord@ will be the unit of spaces between words. For units
-- without boundaries ('Character', 'Document', ...), this is the identity
-- function.
outsideUnit :: TextUnit -> TextUnit
outsideUnit :: TextUnit -> TextUnit
outsideUnit (GenUnit TextUnit
enclosing Direction -> BufferM Bool
boundary) = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
enclosing (Direction -> BufferM Bool
boundary (Direction -> BufferM Bool)
-> (Direction -> Direction) -> Direction -> BufferM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Direction
reverseDir)
outsideUnit TextUnit
x = TextUnit
x -- for a lack of better definition

-- | Common boundary checking function: run the condition on @len@
-- characters in specified direction shifted by specified offset.
genBoundary :: Int -- ^ Offset from current position
            -> Int -- ^ Look-ahead
            -> (YiString -> Bool) -- ^ predicate
            -> Direction -- ^ Direction to look in
            -> BufferM Bool
genBoundary :: Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary Int
ofs Int
len YiString -> Bool
condition Direction
dir = YiString -> Bool
condition (YiString -> Bool) -> BufferM YiString -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
peekB
  where
    peekB :: BufferM YiString
peekB = do
      Point Int
p' <- BufferM Point
pointB
      let pt :: Point
pt@(Point Int
p) = Int -> Point
Point (Int
p' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
mayNegate Int
ofs)
      case Direction
dir of
        Direction
Forward -> Point -> Point -> BufferM YiString
betweenB Point
pt (Int -> Point
Point (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
        Direction
Backward -> YiString -> YiString
R.reverse (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> Point -> BufferM YiString
betweenB (Int -> Point
Point (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Point
pt

    mayNegate :: Int -> Int
mayNegate = case Direction
dir of
      Direction
Forward -> Int -> Int
forall a. a -> a
id
      Direction
Backward -> Int -> Int
forall a. Num a => a -> a
negate

-- | a word as in use in Emacs (fundamental mode)
unitWord :: TextUnit
unitWord :: TextUnit
unitWord =
  TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$
  \Direction
direction -> Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB (-Int
1) [Char -> Bool
isWordChar, Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isWordChar] Direction
direction

-- | delimited on the left and right by given characters, boolean
-- argument tells if whether those are included.
unitDelimited :: Char -> Char -> Bool -> TextUnit
unitDelimited :: Char -> Char -> Bool -> TextUnit
unitDelimited Char
left Char
right Bool
included = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ \Direction
direction ->
   case (Bool
included,Direction
direction) of
       (Bool
False, Direction
Backward) -> do
           Bool
isCursorOnLeftChar <- (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
left) (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB
           Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isCursorOnLeftChar BufferM ()
rightB
           Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
0 [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
left)] Direction
Backward
       (Bool
False, Direction
Forward)  -> do
           Bool
isCursorOnRightChar <- (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
right) (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB
           Bool
isTextUnitBlank <- Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
0 [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
left)] Direction
Backward
           if Bool
isTextUnitBlank Bool -> Bool -> Bool
&& Bool
isCursorOnRightChar
           then BufferM ()
leftB BufferM () -> BufferM Bool -> BufferM Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
           else Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
isCursorOnRightChar
       (Bool
True,  Direction
Backward) -> Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
0 [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
left)] Direction
Forward
       (Bool
True,  Direction
Forward)  -> BufferM ()
rightB BufferM () -> BufferM Bool -> BufferM Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
0 [(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
right)] Direction
Backward

isWordChar :: Char -> Bool
isWordChar :: Char -> Bool
isWordChar Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

isNl :: Char -> Bool
isNl :: Char -> Bool
isNl = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Tells if a char can end a sentence ('.', '!', '?').
isEndOfSentence :: Char -> Bool
isEndOfSentence :: Char -> Bool
isEndOfSentence = (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
".!?")

-- | Verifies that the string matches all the predicates, pairwise. If
-- the string is "too small", then return 'False'. Note the length of
-- predicates has to be finite.
checks :: [Char -> Bool] -> YiString -> Bool
checks :: [Char -> Bool] -> YiString -> Bool
checks [Char -> Bool]
ps' YiString
t' = [Char -> Bool] -> [Char] -> Bool
forall t. [t -> Bool] -> [t] -> Bool
go [Char -> Bool]
ps' (YiString -> [Char]
R.toString YiString
t')
  where
    go :: [t -> Bool] -> [t] -> Bool
go [] [t]
_ = Bool
True
    go [t -> Bool]
_ [] = Bool
False
    go (t -> Bool
p:[t -> Bool]
ps) (t
x:[t]
xs) =  t -> Bool
p t
x Bool -> Bool -> Bool
&& [t -> Bool] -> [t] -> Bool
go [t -> Bool]
ps [t]
xs

checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
offset [Char -> Bool]
conds = Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary Int
offset ([Char -> Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char -> Bool]
conds) ([Char -> Bool] -> YiString -> Bool
checks [Char -> Bool]
conds)

-- | Helper that takes first two characters of YiString. Faster than
-- take 2 and string conversion.
firstTwo :: YiString -> Maybe (Char, Char)
firstTwo :: YiString -> Maybe (Char, Char)
firstTwo YiString
t = case YiString -> Maybe Char
R.head YiString
t of
  Maybe Char
Nothing -> Maybe (Char, Char)
forall a. Maybe a
Nothing
  Just Char
c -> case YiString -> Maybe YiString
R.tail YiString
t Maybe YiString -> (YiString -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> Maybe Char
R.head of
    Maybe Char
Nothing -> Maybe (Char, Char)
forall a. Maybe a
Nothing
    Just Char
c' -> (Char, Char) -> Maybe (Char, Char)
forall a. a -> Maybe a
Just (Char
c, Char
c')

atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundary Char -> Int
charType = Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary (-Int
1) Int
2 ((YiString -> Bool) -> Direction -> BufferM Bool)
-> (YiString -> Bool) -> Direction -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ \YiString
cs -> case YiString -> Maybe (Char, Char)
firstTwo YiString
cs of
  Just (Char
c1, Char
c2) -> Char -> Bool
isNl Char
c1 Bool -> Bool -> Bool
&& Char -> Bool
isNl Char
c2 -- stop at empty lines
                   Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSpace Char
c1) Bool -> Bool -> Bool
&& (Char -> Int
charType Char
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Int
charType Char
c2)
  Maybe (Char, Char)
Nothing -> Bool
True

atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atAnyViWordBoundary Char -> Int
charType = Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary (-Int
1) Int
2 ((YiString -> Bool) -> Direction -> BufferM Bool)
-> (YiString -> Bool) -> Direction -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ \YiString
cs -> case YiString -> Maybe (Char, Char)
firstTwo YiString
cs of
  Just (Char
c1, Char
c2) -> Char -> Bool
isNl Char
c1 Bool -> Bool -> Bool
|| Char -> Bool
isNl Char
c2 Bool -> Bool -> Bool
|| Char -> Int
charType Char
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Int
charType Char
c2
  Maybe (Char, Char)
Nothing -> Bool
True

atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundaryOnLine Char -> Int
charType = Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary (-Int
1) Int
2 ((YiString -> Bool) -> Direction -> BufferM Bool)
-> (YiString -> Bool) -> Direction -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ \YiString
cs -> case YiString -> Maybe (Char, Char)
firstTwo YiString
cs of
  Just (Char
c1, Char
c2)-> Char -> Bool
isNl Char
c1 Bool -> Bool -> Bool
|| Char -> Bool
isNl Char
c2 Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSpace Char
c1) Bool -> Bool -> Bool
&& Char -> Int
charType Char
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Int
charType Char
c2
  Maybe (Char, Char)
Nothing -> Bool
True

unitViWord :: TextUnit
unitViWord :: TextUnit
unitViWord = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundary Char -> Int
viWordCharType

unitViWORD :: TextUnit
unitViWORD :: TextUnit
unitViWORD = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundary Char -> Int
viWORDCharType

unitViWordAnyBnd :: TextUnit
unitViWordAnyBnd :: TextUnit
unitViWordAnyBnd = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atAnyViWordBoundary Char -> Int
viWordCharType

unitViWORDAnyBnd :: TextUnit
unitViWORDAnyBnd :: TextUnit
unitViWORDAnyBnd = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atAnyViWordBoundary Char -> Int
viWORDCharType

unitViWordOnLine :: TextUnit
unitViWordOnLine :: TextUnit
unitViWordOnLine = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundaryOnLine Char -> Int
viWordCharType

unitViWORDOnLine :: TextUnit
unitViWORDOnLine :: TextUnit
unitViWORDOnLine = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundaryOnLine Char -> Int
viWORDCharType

viWordCharType :: Char -> Int
viWordCharType :: Char -> Int
viWordCharType Char
c | Char -> Bool
isSpace Char
c    = Int
1
                 | Char -> Bool
isWordChar Char
c = Int
2
                 | Bool
otherwise    = Int
3

viWORDCharType :: Char -> Int
viWORDCharType :: Char -> Int
viWORDCharType Char
c | Char -> Bool
isSpace Char
c = Int
1
                 | Bool
otherwise = Int
2

-- | Separator characters (space, tab, unicode separators). Most of
-- the units above attempt to identify "words" with various
-- punctuation and symbols included or excluded. This set of units is
-- a simple inverse: it is true for "whitespace" or "separators" and
-- false for anything that is not (letters, numbers, symbols,
-- punctuation, whatever).
isAnySep :: Char -> Bool
isAnySep :: Char -> Bool
isAnySep Char
c = Char -> Bool
isSeparator Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory]
seps
  where
    seps :: [GeneralCategory]
seps = [ GeneralCategory
Space, GeneralCategory
LineSeparator, GeneralCategory
ParagraphSeparator ]

atSepBoundary :: Direction -> BufferM Bool
atSepBoundary :: Direction -> BufferM Bool
atSepBoundary = Int -> Int -> (YiString -> Bool) -> Direction -> BufferM Bool
genBoundary (-Int
1) Int
2 ((YiString -> Bool) -> Direction -> BufferM Bool)
-> (YiString -> Bool) -> Direction -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ \YiString
cs -> case YiString -> Maybe (Char, Char)
firstTwo YiString
cs of
  Just (Char
c1, Char
c2) -> Char -> Bool
isNl Char
c1 Bool -> Bool -> Bool
|| Char -> Bool
isNl Char
c2 Bool -> Bool -> Bool
|| Char -> Bool
isAnySep Char
c1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Bool
isAnySep Char
c2
  Maybe (Char, Char)
Nothing -> Bool
True

-- | unitSep is true for any kind of whitespace/separator
unitSep :: TextUnit
unitSep :: TextUnit
unitSep = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document Direction -> BufferM Bool
atSepBoundary

-- | unitSepThisLine is true for any kind of whitespace/separator on this line only
unitSepThisLine :: TextUnit
unitSepThisLine :: TextUnit
unitSepThisLine = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Line Direction -> BufferM Bool
atSepBoundary


-- | Is the point at a @Unit@ boundary in the specified @Direction@?
atBoundary :: TextUnit -> Direction -> BufferM Bool
atBoundary :: TextUnit -> Direction -> BufferM Bool
atBoundary TextUnit
Document Direction
Backward = (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
0) (Point -> Bool) -> BufferM Point -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB
atBoundary TextUnit
Document Direction
Forward  = Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
(>=)   (Point -> Point -> Bool)
-> BufferM Point -> BufferM (Point -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB BufferM (Point -> Bool) -> BufferM Point -> BufferM Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Point
sizeB
atBoundary TextUnit
Character Direction
_ = Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
atBoundary TextUnit
VLine Direction
_ = Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True -- a fallacy; this needs a little refactoring.
atBoundary TextUnit
Line Direction
direction = Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB Int
0 [Char -> Bool
isNl] Direction
direction
atBoundary (GenUnit TextUnit
_ Direction -> BufferM Bool
atBound) Direction
dir = Direction -> BufferM Bool
atBound Direction
dir

enclosingUnit :: TextUnit -> TextUnit
enclosingUnit :: TextUnit -> TextUnit
enclosingUnit (GenUnit TextUnit
enclosing Direction -> BufferM Bool
_) = TextUnit
enclosing
enclosingUnit TextUnit
_ = TextUnit
Document

atBoundaryB :: TextUnit -> Direction -> BufferM Bool
atBoundaryB :: TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
Document Direction
d = TextUnit -> Direction -> BufferM Bool
atBoundary TextUnit
Document Direction
d
atBoundaryB TextUnit
u Direction
d = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> BufferM Bool -> BufferM (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextUnit -> Direction -> BufferM Bool
atBoundary TextUnit
u Direction
d BufferM (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TextUnit -> Direction -> BufferM Bool
atBoundaryB (TextUnit -> TextUnit
enclosingUnit TextUnit
u) Direction
d

-- | Paragraph to implement emacs-like forward-paragraph/backward-paragraph
unitEmacsParagraph :: TextUnit
unitEmacsParagraph :: TextUnit
unitEmacsParagraph = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB (-Int
2) [Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNl, Char -> Bool
isNl, Char -> Bool
isNl]

-- | Paragraph that begins and ends in the paragraph, not the empty lines surrounding it.
unitParagraph :: TextUnit
unitParagraph :: TextUnit
unitParagraph = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB (-Int
1) [Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNl, Char -> Bool
isNl, Char -> Bool
isNl]

unitSentence :: TextUnit
unitSentence :: TextUnit
unitSentence = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
unitEmacsParagraph ((Direction -> BufferM Bool) -> TextUnit)
-> (Direction -> BufferM Bool) -> TextUnit
forall a b. (a -> b) -> a -> b
$ \Direction
dir -> Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB (if Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward then -Int
1 else Int
0) (Direction -> [Char -> Bool] -> [Char -> Bool]
forall a. Direction -> [a] -> [a]
mayReverse Direction
dir [Char -> Bool
isEndOfSentence, Char -> Bool
isSpace]) Direction
dir

-- | Unit that have its left and right boundaries at the left boundary of the argument unit.
leftBoundaryUnit :: TextUnit -> TextUnit
leftBoundaryUnit :: TextUnit -> TextUnit
leftBoundaryUnit TextUnit
u = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document (\Direction
_dir -> TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
u Direction
Backward)

-- | @genAtBoundaryB u d s@ returns whether the point is at a given boundary @(d,s)@ .
-- Boundary @(d,s)@ , taking Word as example, means:
--      Word
--     ^^  ^^
--     12  34
-- 1: (Backward,OutsideBound)
-- 2: (Backward,InsideBound)
-- 3: (Forward,InsideBound)
-- 4: (Forward,OutsideBound)
--
-- rules:
-- genAtBoundaryB u Backward InsideBound  = atBoundaryB u Backward
-- genAtBoundaryB u Forward  OutsideBound = atBoundaryB u Forward
genAtBoundaryB :: TextUnit -> Direction -> BoundarySide -> BufferM Bool
genAtBoundaryB :: TextUnit -> Direction -> BoundarySide -> BufferM Bool
genAtBoundaryB TextUnit
u Direction
d BoundarySide
s = Point -> BufferM Bool -> BufferM Bool
forall a. Point -> BufferM a -> BufferM a
withOffset (TextUnit -> Direction -> BoundarySide -> Point
forall p p. Num p => p -> Direction -> BoundarySide -> p
off TextUnit
u Direction
d BoundarySide
s) (BufferM Bool -> BufferM Bool) -> BufferM Bool -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
u Direction
d
    where withOffset :: Point -> BufferM a -> BufferM a
withOffset Point
0 BufferM a
f = BufferM a
f
          withOffset Point
ofs BufferM a
f = BufferM a -> BufferM a
forall a. BufferM a -> BufferM a
savingPointB (((Point
ofs Point -> Point -> Point
forall a. Num a => a -> a -> a
+) (Point -> Point) -> BufferM Point -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB) BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
moveTo BufferM () -> BufferM a -> BufferM a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM a
f)
          off :: p -> Direction -> BoundarySide -> p
off p
_    Direction
Backward  BoundarySide
InsideBound = p
0
          off p
_    Direction
Backward BoundarySide
OutsideBound = p
1
          off p
_    Direction
Forward   BoundarySide
InsideBound = p
1
          off p
_    Direction
Forward  BoundarySide
OutsideBound = p
0


numberOfB :: TextUnit -> TextUnit -> BufferM Int
numberOfB :: TextUnit -> TextUnit -> BufferM Int
numberOfB TextUnit
unit TextUnit
containingUnit = BufferM Int -> BufferM Int
forall a. BufferM a -> BufferM a
savingPointB (BufferM Int -> BufferM Int) -> BufferM Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ do
                   TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
containingUnit Direction
Backward
                   Point
start <- BufferM Point
pointB
                   TextUnit -> Direction -> BufferM ()
moveB TextUnit
containingUnit Direction
Forward
                   Point
end <- BufferM Point
pointB
                   Point -> BufferM ()
moveTo Point
start
                   [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([()] -> Int) -> BufferM [()] -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool -> BufferM () -> BufferM [()]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
untilB ((Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
end) (Point -> Bool) -> BufferM Point -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB) (TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
Forward)

whileB :: BufferM Bool -> BufferM a -> BufferM [a]
whileB :: BufferM Bool -> BufferM a -> BufferM [a]
whileB BufferM Bool
cond = BufferM Bool -> BufferM a -> BufferM [a]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
untilB (Bool -> Bool
not (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
cond)

-- | Repeat an action until the condition is fulfilled or the cursor
-- stops moving. The Action may be performed zero times.
untilB :: BufferM Bool -> BufferM a -> BufferM [a]
untilB :: BufferM Bool -> BufferM a -> BufferM [a]
untilB BufferM Bool
cond BufferM a
f = do
  Bool
stop <- BufferM Bool
cond
  if Bool
stop then [a] -> BufferM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else BufferM Bool -> BufferM a -> BufferM [a]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
doUntilB BufferM Bool
cond BufferM a
f

-- | Repeat an action until the condition is fulfilled or the cursor
-- stops moving. The Action is performed at least once.
doUntilB :: BufferM Bool -> BufferM a -> BufferM [a]
doUntilB :: BufferM Bool -> BufferM a -> BufferM [a]
doUntilB BufferM Bool
cond BufferM a
f = BufferM [a]
loop
  where loop :: BufferM [a]
loop = do
          Point
p <- BufferM Point
pointB
          a
x <- BufferM a
f
          Point
p' <- BufferM Point
pointB
          Bool
stop <- BufferM Bool
cond
          (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> BufferM [a] -> BufferM [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
p' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
stop
            then BufferM [a]
loop
            else [a] -> BufferM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

doUntilB_ :: BufferM Bool -> BufferM a -> BufferM ()
doUntilB_ :: BufferM Bool -> BufferM a -> BufferM ()
doUntilB_ BufferM Bool
cond BufferM a
f = BufferM [a] -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Bool -> BufferM a -> BufferM [a]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
doUntilB BufferM Bool
cond BufferM a
f) -- maybe do an optimized version?

untilB_ :: BufferM Bool -> BufferM a -> BufferM ()
untilB_ :: BufferM Bool -> BufferM a -> BufferM ()
untilB_ BufferM Bool
cond BufferM a
f = BufferM [a] -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Bool -> BufferM a -> BufferM [a]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
untilB BufferM Bool
cond BufferM a
f) -- maybe do an optimized version?

-- | Do an action if the current buffer character passes the predicate
doIfCharB :: (Char -> Bool) -> BufferM a -> BufferM ()
doIfCharB :: (Char -> Bool) -> BufferM a -> BufferM ()
doIfCharB Char -> Bool
p BufferM a
o = BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char -> Bool
p Char
c) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM a -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void BufferM a
o


-- | Boundary side
data BoundarySide = InsideBound | OutsideBound
    deriving BoundarySide -> BoundarySide -> Bool
(BoundarySide -> BoundarySide -> Bool)
-> (BoundarySide -> BoundarySide -> Bool) -> Eq BoundarySide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundarySide -> BoundarySide -> Bool
$c/= :: BoundarySide -> BoundarySide -> Bool
== :: BoundarySide -> BoundarySide -> Bool
$c== :: BoundarySide -> BoundarySide -> Bool
Eq

-- | Generic move operation
-- Warning: moving To the (OutsideBound, Backward) bound of Document is impossible (offset -1!)
-- @genMoveB u b d@: move in direction d until encountering boundary b or unit u. See 'genAtBoundaryB' for boundary explanation.
genMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
Document (Direction
Forward,BoundarySide
InsideBound) Direction
Forward = Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Point -> Point -> Point
forall a. Num a => a -> a -> a
subtract Point
1 (Point -> Point) -> BufferM Point -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
sizeB
genMoveB TextUnit
Document (Direction, BoundarySide)
_                     Direction
Forward = Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
sizeB
genMoveB TextUnit
Document (Direction, BoundarySide)
_ Direction
Backward = Point -> BufferM ()
moveTo Point
0 -- impossible to go outside beginning of doc.
genMoveB TextUnit
Character (Direction, BoundarySide)
_ Direction
Forward  = BufferM ()
rightB
genMoveB TextUnit
Character (Direction, BoundarySide)
_ Direction
Backward = BufferM ()
leftB
genMoveB TextUnit
VLine     (Direction, BoundarySide)
_ Direction
Forward  = do
  Int
ofs <- Int -> BufferM Int
lineMoveRel Int
1
  Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Forward)
genMoveB TextUnit
VLine (Direction, BoundarySide)
_ Direction
Backward = BufferM ()
lineUp
genMoveB TextUnit
unit (Direction
boundDir, BoundarySide
boundSide) Direction
moveDir =
  BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
doUntilB_ (TextUnit -> Direction -> BoundarySide -> BufferM Bool
genAtBoundaryB TextUnit
unit Direction
boundDir BoundarySide
boundSide) (TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
moveDir)

-- | Generic maybe move operation.
-- As genMoveB, but don't move if we are at boundary already.
genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
-- optimized case for Document
genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMaybeMoveB TextUnit
Document (Direction, BoundarySide)
boundSpec Direction
moveDir = TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
Document (Direction, BoundarySide)
boundSpec Direction
moveDir
-- optimized case for start/end of Line
genMaybeMoveB TextUnit
Line (Direction
Backward, BoundarySide
InsideBound) Direction
Backward = Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Point -> BufferM Point
solPointB (Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
genMaybeMoveB TextUnit
Line (Direction
Forward, BoundarySide
OutsideBound) Direction
Forward = Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Point -> BufferM Point
eolPointB (Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
genMaybeMoveB TextUnit
unit (Direction
boundDir, BoundarySide
boundSide) Direction
moveDir =
  BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (TextUnit -> Direction -> BoundarySide -> BufferM Bool
genAtBoundaryB TextUnit
unit Direction
boundDir BoundarySide
boundSide) (TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
moveDir)


-- | Move to the next unit boundary
moveB :: TextUnit -> Direction -> BufferM ()
moveB :: TextUnit -> Direction -> BufferM ()
moveB TextUnit
u Direction
d = TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
u (Direction
d, case Direction
d of Direction
Forward -> BoundarySide
OutsideBound; Direction
Backward -> BoundarySide
InsideBound) Direction
d


-- | As 'moveB', unless the point is at a unit boundary

-- So for example here moveToEol = maybeMoveB Line Forward;
-- in that it will move to the end of current line and nowhere if we
-- are already at the end of the current line. Similarly for moveToSol.

maybeMoveB :: TextUnit -> Direction -> BufferM ()
maybeMoveB :: TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
u Direction
d = TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMaybeMoveB TextUnit
u (Direction
d, case Direction
d of Direction
Forward -> BoundarySide
OutsideBound; Direction
Backward -> BoundarySide
InsideBound) Direction
d

transposeB :: TextUnit -> Direction -> BufferM ()
transposeB :: TextUnit -> Direction -> BufferM ()
transposeB TextUnit
unit Direction
direction = do
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit (Direction -> Direction
reverseDir Direction
direction)
  Point
w0 <- BufferM Point
pointB
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
direction
  Point
w0' <- BufferM Point
pointB
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
direction
  Point
w1' <- BufferM Point
pointB
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit (Direction -> Direction
reverseDir Direction
direction)
  Point
w1 <- BufferM Point
pointB
  Region -> Region -> BufferM ()
swapRegionsB (Point -> Point -> Region
mkRegion Point
w0 Point
w0') (Point -> Point -> Region
mkRegion Point
w1 Point
w1')
  Point -> BufferM ()
moveTo Point
w1'

-- | Transforms the region given by 'TextUnit' in the 'Direction' with
-- user-supplied function.
transformB :: (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB :: (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB YiString -> YiString
f TextUnit
unit Direction
direction = do
  Point
p <- BufferM Point
pointB
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
direction
  Point
q <- BufferM Point
pointB
  let r :: Region
r = Point -> Point -> Region
mkRegion Point
p Point
q
  Region -> YiString -> BufferM ()
replaceRegionB Region
r (YiString -> BufferM ()) -> BufferM YiString -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< YiString -> YiString
f (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> BufferM YiString
readRegionB Region
r

-- | Delete between point and next unit boundary, return the deleted region.
deleteB :: TextUnit -> Direction -> BufferM ()
deleteB :: TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unit Direction
dir = Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unit Direction
dir

regionWithTwoMovesB :: BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB :: BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB BufferM a
move1 BufferM b
move2 =
    BufferM Region -> BufferM Region
forall a. BufferM a -> BufferM a
savingPointB (BufferM Region -> BufferM Region)
-> BufferM Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> BufferM Point -> BufferM (Point -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BufferM a
move1 BufferM a -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB) BufferM (Point -> Region) -> BufferM Point -> BufferM Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BufferM b
move2 BufferM b -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB)

-- | Region of the whole textunit where the current point is.
regionOfB :: TextUnit -> BufferM Region
regionOfB :: TextUnit -> BufferM Region
regionOfB TextUnit
unit = BufferM () -> BufferM () -> BufferM Region
forall a b. BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
unit Direction
Backward) (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
unit Direction
Forward)

-- An alternate definition would be the following, but it can return two units if the current point is between them.
-- eg.  "word1 ^ word2" would return both words.
-- regionOfB unit = mkRegion
--                  <$> pointAfter (maybeMoveB unit Backward)
--                  <*> destinationOfMoveB (maybeMoveB unit Forward)
-- | Non empty region of the whole textunit where the current point is.
regionOfNonEmptyB :: TextUnit -> BufferM Region
regionOfNonEmptyB :: TextUnit -> BufferM Region
regionOfNonEmptyB TextUnit
unit = BufferM Region -> BufferM Region
forall a. BufferM a -> BufferM a
savingPointB (BufferM Region -> BufferM Region)
-> BufferM Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$
  Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> BufferM Point -> BufferM (Point -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
unit Direction
Backward BufferM () -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB) BufferM (Point -> Region) -> BufferM Point -> BufferM Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
Forward BufferM () -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB)

-- | Region between the point and the next boundary.
-- The region is empty if the point is at the boundary.
regionOfPartB :: TextUnit -> Direction -> BufferM Region
regionOfPartB :: TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unit Direction
dir = Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> BufferM Point -> BufferM (Point -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB BufferM (Point -> Region) -> BufferM Point -> BufferM Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
destinationOfMoveB (TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
unit Direction
dir)

-- | Non empty region between the point and the next boundary,
-- In fact the region can be empty if we are at the end of file.
regionOfPartNonEmptyB :: TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB :: TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unit Direction
dir = Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> BufferM Point -> BufferM (Point -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB BufferM (Point -> Region) -> BufferM Point -> BufferM Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
destinationOfMoveB (TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
dir)

-- | Non empty region at given point and the next boundary,
regionOfPartNonEmptyAtB :: TextUnit -> Direction -> Point -> BufferM Region
regionOfPartNonEmptyAtB :: TextUnit -> Direction -> Point -> BufferM Region
regionOfPartNonEmptyAtB TextUnit
unit Direction
dir Point
p = do
    Point
oldP <- BufferM Point
pointB
    Point -> BufferM ()
moveTo Point
p
    Region
r <- TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unit Direction
dir
    Point -> BufferM ()
moveTo Point
oldP
    Region -> BufferM Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
r

readPrevUnitB :: TextUnit -> BufferM YiString
readPrevUnitB :: TextUnit -> BufferM YiString
readPrevUnitB TextUnit
unit = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unit Direction
Backward

readUnitB :: TextUnit -> BufferM YiString
readUnitB :: TextUnit -> BufferM YiString
readUnitB = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString)
-> (TextUnit -> BufferM Region) -> TextUnit -> BufferM YiString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TextUnit -> BufferM Region
regionOfB

halfUnit :: Direction -> TextUnit -> TextUnit
halfUnit :: Direction -> TextUnit -> TextUnit
halfUnit Direction
dir (GenUnit TextUnit
enclosing Direction -> BufferM Bool
boundary) =
  TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
enclosing (\Direction
d -> if Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
dir then Direction -> BufferM Bool
boundary Direction
d else Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
halfUnit Direction
_dir TextUnit
tu = TextUnit
tu

deleteUnitB :: TextUnit -> Direction -> BufferM ()
deleteUnitB :: TextUnit -> Direction -> BufferM ()
deleteUnitB TextUnit
unit Direction
dir = Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unit Direction
dir