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.Applicative (Applicative ((<*>)), (<$>))
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 {genEnclosingUnit :: TextUnit,
genUnitBoundary :: Direction -> BufferM Bool}
deriving Typeable
outsideUnit :: TextUnit -> TextUnit
outsideUnit (GenUnit enclosing boundary) = GenUnit enclosing (boundary . reverseDir)
outsideUnit x = x
genBoundary :: Int
-> Int
-> (YiString -> Bool)
-> Direction
-> BufferM Bool
genBoundary ofs len condition dir = condition <$> peekB
where
peekB = do
Point p' <- pointB
let pt@(Point p) = Point (p' + mayNegate ofs)
case dir of
Forward -> betweenB pt (Point $ max 0 p + len)
Backward -> R.reverse <$> betweenB (Point $ p len) pt
mayNegate = case dir of
Forward -> id
Backward -> negate
unitWord :: TextUnit
unitWord =
GenUnit Document $
\direction -> checkPeekB (1) [isWordChar, not . isWordChar] direction
unitDelimited :: Char -> Char -> Bool -> TextUnit
unitDelimited left right included = GenUnit Document $ \direction ->
case (included,direction) of
(False, Backward) -> do
isCursorOnLeftChar <- (== left) <$> readB
when isCursorOnLeftChar rightB
checkPeekB 0 [(== left)] Backward
(False, Forward) -> do
isCursorOnRightChar <- (== right) <$> readB
isTextUnitBlank <- checkPeekB 0 [(== left)] Backward
if isTextUnitBlank && isCursorOnRightChar
then leftB >> return True
else return isCursorOnRightChar
(True, Backward) -> checkPeekB 0 [(== left)] Forward
(True, Forward) -> rightB >> checkPeekB 0 [(== right)] Backward
isWordChar :: Char -> Bool
isWordChar x = isAlphaNum x || x == '_'
isNl :: Char -> Bool
isNl = (== '\n')
isEndOfSentence :: Char -> Bool
isEndOfSentence = (`elem` ".!?")
checks :: [Char -> Bool] -> YiString -> Bool
checks ps' t' = go ps' (R.toString t')
where
go [] _ = True
go _ [] = False
go (p:ps) (x:xs) = p x && go ps xs
checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool
checkPeekB offset conds = genBoundary offset (length conds) (checks conds)
firstTwo :: YiString -> Maybe (Char, Char)
firstTwo t = case R.head t of
Nothing -> Nothing
Just c -> case R.tail t >>= R.head of
Nothing -> Nothing
Just c' -> Just (c, c')
atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundary charType = genBoundary (1) 2 $ \cs -> case firstTwo cs of
Just (c1, c2) -> isNl c1 && isNl c2
|| not (isSpace c1) && (charType c1 /= charType c2)
Nothing -> True
atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool
atAnyViWordBoundary charType = genBoundary (1) 2 $ \cs -> case firstTwo cs of
Just (c1, c2) -> isNl c1 || isNl c2 || charType c1 /= charType c2
Nothing -> True
atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool
atViWordBoundaryOnLine charType = genBoundary (1) 2 $ \cs -> case firstTwo cs of
Just (c1, c2)-> isNl c1 || isNl c2 || not (isSpace c1) && charType c1 /= charType c2
Nothing -> True
unitViWord :: TextUnit
unitViWord = GenUnit Document $ atViWordBoundary viWordCharType
unitViWORD :: TextUnit
unitViWORD = GenUnit Document $ atViWordBoundary viWORDCharType
unitViWordAnyBnd :: TextUnit
unitViWordAnyBnd = GenUnit Document $ atAnyViWordBoundary viWordCharType
unitViWORDAnyBnd :: TextUnit
unitViWORDAnyBnd = GenUnit Document $ atAnyViWordBoundary viWORDCharType
unitViWordOnLine :: TextUnit
unitViWordOnLine = GenUnit Document $ atViWordBoundaryOnLine viWordCharType
unitViWORDOnLine :: TextUnit
unitViWORDOnLine = GenUnit Document $ atViWordBoundaryOnLine viWORDCharType
viWordCharType :: Char -> Int
viWordCharType c | isSpace c = 1
| isWordChar c = 2
| otherwise = 3
viWORDCharType :: Char -> Int
viWORDCharType c | isSpace c = 1
| otherwise = 2
isAnySep :: Char -> Bool
isAnySep c = isSeparator c || isSpace c || generalCategory c `elem` seps
where
seps = [ Space, LineSeparator, ParagraphSeparator ]
atSepBoundary :: Direction -> BufferM Bool
atSepBoundary = genBoundary (1) 2 $ \cs -> case firstTwo cs of
Just (c1, c2) -> isNl c1 || isNl c2 || isAnySep c1 /= isAnySep c2
Nothing -> True
unitSep :: TextUnit
unitSep = GenUnit Document atSepBoundary
unitSepThisLine :: TextUnit
unitSepThisLine = GenUnit Line atSepBoundary
atBoundary :: TextUnit -> Direction -> BufferM Bool
atBoundary Document Backward = (== 0) <$> pointB
atBoundary Document Forward = (>=) <$> pointB <*> sizeB
atBoundary Character _ = return True
atBoundary VLine _ = return True
atBoundary Line direction = checkPeekB 0 [isNl] direction
atBoundary (GenUnit _ atBound) dir = atBound dir
enclosingUnit :: TextUnit -> TextUnit
enclosingUnit (GenUnit enclosing _) = enclosing
enclosingUnit _ = Document
atBoundaryB :: TextUnit -> Direction -> BufferM Bool
atBoundaryB Document d = atBoundary Document d
atBoundaryB u d = (||) <$> atBoundary u d <*> atBoundaryB (enclosingUnit u) d
unitEmacsParagraph :: TextUnit
unitEmacsParagraph = GenUnit Document $ checkPeekB (2) [not . isNl, isNl, isNl]
unitParagraph :: TextUnit
unitParagraph = GenUnit Document $ checkPeekB (1) [not . isNl, isNl, isNl]
unitSentence :: TextUnit
unitSentence = GenUnit unitEmacsParagraph $ \dir -> checkPeekB (if dir == Forward then 1 else 0) (mayReverse dir [isEndOfSentence, isSpace]) dir
leftBoundaryUnit :: TextUnit -> TextUnit
leftBoundaryUnit u = GenUnit Document (\_dir -> atBoundaryB u Backward)
genAtBoundaryB :: TextUnit -> Direction -> BoundarySide -> BufferM Bool
genAtBoundaryB u d s = withOffset (off u d s) $ atBoundaryB u d
where withOffset 0 f = f
withOffset ofs f = savingPointB (((ofs +) <$> pointB) >>= moveTo >> f)
off _ Backward InsideBound = 0
off _ Backward OutsideBound = 1
off _ Forward InsideBound = 1
off _ Forward OutsideBound = 0
numberOfB :: TextUnit -> TextUnit -> BufferM Int
numberOfB unit containingUnit = savingPointB $ do
maybeMoveB containingUnit Backward
start <- pointB
moveB containingUnit Forward
end <- pointB
moveTo start
length <$> untilB ((>= end) <$> pointB) (moveB unit Forward)
whileB :: BufferM Bool -> BufferM a -> BufferM [a]
whileB cond = untilB (not <$> cond)
untilB :: BufferM Bool -> BufferM a -> BufferM [a]
untilB cond f = do
stop <- cond
if stop then return [] else doUntilB cond f
doUntilB :: BufferM Bool -> BufferM a -> BufferM [a]
doUntilB cond f = loop
where loop = do
p <- pointB
x <- f
p' <- pointB
stop <- cond
(x:) <$> if p /= p' && not stop
then loop
else return []
doUntilB_ :: BufferM Bool -> BufferM a -> BufferM ()
doUntilB_ cond f = void (doUntilB cond f)
untilB_ :: BufferM Bool -> BufferM a -> BufferM ()
untilB_ cond f = void (untilB cond f)
doIfCharB :: (Char -> Bool) -> BufferM a -> BufferM ()
doIfCharB p o = readB >>= \c -> when (p c) $ void o
data BoundarySide = InsideBound | OutsideBound
deriving Eq
genMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB Document (Forward,InsideBound) Forward = moveTo =<< subtract 1 <$> sizeB
genMoveB Document _ Forward = moveTo =<< sizeB
genMoveB Document _ Backward = moveTo 0
genMoveB Character _ Forward = rightB
genMoveB Character _ Backward = leftB
genMoveB VLine _ Forward = do
ofs <- lineMoveRel 1
when (ofs < 1) (maybeMoveB Line Forward)
genMoveB VLine _ Backward = lineUp
genMoveB unit (boundDir, boundSide) moveDir =
doUntilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir)
genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMaybeMoveB Document boundSpec moveDir = genMoveB Document boundSpec moveDir
genMaybeMoveB Line (Backward, InsideBound) Backward = moveTo =<< solPointB =<< pointB
genMaybeMoveB Line (Forward, OutsideBound) Forward = moveTo =<< eolPointB =<< pointB
genMaybeMoveB unit (boundDir, boundSide) moveDir =
untilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir)
moveB :: TextUnit -> Direction -> BufferM ()
moveB u d = genMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d
maybeMoveB :: TextUnit -> Direction -> BufferM ()
maybeMoveB u d = genMaybeMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d
transposeB :: TextUnit -> Direction -> BufferM ()
transposeB unit direction = do
moveB unit (reverseDir direction)
w0 <- pointB
moveB unit direction
w0' <- pointB
moveB unit direction
w1' <- pointB
moveB unit (reverseDir direction)
w1 <- pointB
swapRegionsB (mkRegion w0 w0') (mkRegion w1 w1')
moveTo w1'
transformB :: (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB f unit direction = do
p <- pointB
moveB unit direction
q <- pointB
let r = mkRegion p q
replaceRegionB r =<< f <$> readRegionB r
deleteB :: TextUnit -> Direction -> BufferM ()
deleteB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir
regionWithTwoMovesB :: BufferM a -> BufferM b -> BufferM Region
regionWithTwoMovesB move1 move2 =
savingPointB $ mkRegion <$> (move1 >> pointB) <*> (move2 >> pointB)
regionOfB :: TextUnit -> BufferM Region
regionOfB unit = regionWithTwoMovesB (maybeMoveB unit Backward) (maybeMoveB unit Forward)
regionOfNonEmptyB :: TextUnit -> BufferM Region
regionOfNonEmptyB unit = savingPointB $
mkRegion <$> (maybeMoveB unit Backward >> pointB) <*> (moveB unit Forward >> pointB)
regionOfPartB :: TextUnit -> Direction -> BufferM Region
regionOfPartB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (maybeMoveB unit dir)
regionOfPartNonEmptyB :: TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (moveB unit dir)
regionOfPartNonEmptyAtB :: TextUnit -> Direction -> Point -> BufferM Region
regionOfPartNonEmptyAtB unit dir p = do
oldP <- pointB
moveTo p
r <- regionOfPartNonEmptyB unit dir
moveTo oldP
return r
readPrevUnitB :: TextUnit -> BufferM YiString
readPrevUnitB unit = readRegionB =<< regionOfPartNonEmptyB unit Backward
readUnitB :: TextUnit -> BufferM YiString
readUnitB = readRegionB <=< regionOfB
halfUnit :: Direction -> TextUnit -> TextUnit
halfUnit dir (GenUnit enclosing boundary) =
GenUnit enclosing (\d -> if d == dir then boundary d else return False)
halfUnit _dir tu = tu
deleteUnitB :: TextUnit -> Direction -> BufferM ()
deleteUnitB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir