{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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)
data TextUnit = Character
| Line
| VLine
| Document
| GenUnit {TextUnit -> TextUnit
genEnclosingUnit :: TextUnit,
TextUnit -> Direction -> BufferM Bool
genUnitBoundary :: Direction -> BufferM Bool}
deriving Typeable
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
genBoundary :: Int
-> Int
-> (YiString -> Bool)
-> Direction
-> 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
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
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')
isEndOfSentence :: Char -> Bool
isEndOfSentence :: Char -> Bool
isEndOfSentence = (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
".!?")
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)
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
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
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 :: TextUnit
unitSep :: TextUnit
unitSep = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Document Direction -> BufferM Bool
atSepBoundary
unitSepThisLine :: TextUnit
unitSepThisLine :: TextUnit
unitSepThisLine = TextUnit -> (Direction -> BufferM Bool) -> TextUnit
GenUnit TextUnit
Line Direction -> BufferM Bool
atSepBoundary
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
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
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]
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
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 :: 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)
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
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)
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)
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
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
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
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)
genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
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
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)
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
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'
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
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)
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)
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)
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)
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)
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