{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.Motion
( Move(..)
, CountedMove(..)
, stringToMove
, regionOfMoveB
, changeMoveStyle
) where
import Prelude hiding (repeat)
import Control.Applicative (Alternative ((<|>)))
import Lens.Micro.Platform (_3, over, use)
import Control.Monad (replicateM_, void, when, (<=<))
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (unpack)
import Yi.Buffer
import Yi.Keymap.Vim.Common (EventString (_unEv), MatchResult (..), lookupBestMatch)
import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)
data Move = Move {
Move -> RegionStyle
moveStyle :: !RegionStyle
, Move -> Bool
moveIsJump :: !Bool
, Move -> Maybe Int -> BufferM ()
moveAction :: Maybe Int -> BufferM ()
}
data CountedMove = CountedMove !(Maybe Int) !Move
stringToMove :: EventString -> MatchResult Move
stringToMove :: EventString -> MatchResult Move
stringToMove s :: EventString
s = EventString -> MatchResult Move
lookupMove EventString
s
MatchResult Move -> MatchResult Move -> MatchResult Move
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> MatchResult Move
matchGotoCharMove (Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> String) -> EventString -> String
forall a b. (a -> b) -> a -> b
$ EventString
s)
MatchResult Move -> MatchResult Move -> MatchResult Move
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> MatchResult Move
matchGotoMarkMove (Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> String) -> EventString -> String
forall a b. (a -> b) -> a -> b
$ EventString
s)
lookupMove :: EventString -> MatchResult Move
lookupMove :: EventString -> MatchResult Move
lookupMove s :: EventString
s = RegionStyle
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> MatchResult Move
findMoveWithStyle RegionStyle
Exclusive [(EventString, Bool, Maybe Int -> BufferM ())]
exclusiveMotions
MatchResult Move -> MatchResult Move -> MatchResult Move
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RegionStyle
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> MatchResult Move
findMoveWithStyle RegionStyle
Inclusive [(EventString, Bool, Maybe Int -> BufferM ())]
inclusiveMotions
MatchResult Move -> MatchResult Move -> MatchResult Move
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RegionStyle
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> MatchResult Move
findMoveWithStyle RegionStyle
LineWise [(EventString, Bool, Maybe Int -> BufferM ())]
linewiseMotions
where findMoveWithStyle :: RegionStyle
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> MatchResult Move
findMoveWithStyle style :: RegionStyle
style choices :: [(EventString, Bool, Maybe Int -> BufferM ())]
choices =
((Bool, Maybe Int -> BufferM ()) -> Move)
-> MatchResult (Bool, Maybe Int -> BufferM ()) -> MatchResult Move
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> (Maybe Int -> BufferM ()) -> Move)
-> (Bool, Maybe Int -> BufferM ()) -> Move
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move RegionStyle
style)) (EventString
-> [(EventString, (Bool, Maybe Int -> BufferM ()))]
-> MatchResult (Bool, Maybe Int -> BufferM ())
forall a. EventString -> [(EventString, a)] -> MatchResult a
lookupBestMatch EventString
s (((EventString, Bool, Maybe Int -> BufferM ())
-> (EventString, (Bool, Maybe Int -> BufferM ())))
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> [(EventString, (Bool, Maybe Int -> BufferM ()))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventString, Bool, Maybe Int -> BufferM ())
-> (EventString, (Bool, Maybe Int -> BufferM ()))
forall a a b. (a, a, b) -> (a, (a, b))
regroup [(EventString, Bool, Maybe Int -> BufferM ())]
choices))
regroup :: (a, a, b) -> (a, (a, b))
regroup (a :: a
a, b :: a
b, c :: b
c) = (a
a, (a
b, b
c))
changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle smod :: RegionStyle -> RegionStyle
smod (Move s :: RegionStyle
s j :: Bool
j m :: Maybe Int -> BufferM ()
m) = RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move (RegionStyle -> RegionStyle
smod RegionStyle
s) Bool
j Maybe Int -> BufferM ()
m
linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
linewiseMotions = ((EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ()))
-> [(EventString, Bool, Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ())
withDefaultCount
[ ("j", Bool
False, BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel)
, ("gj", Bool
False, BufferM () -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM () -> BufferM ())
-> (Int -> BufferM ()) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM ()
lineMoveVisRel)
, ("gk", Bool
False, BufferM () -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM () -> BufferM ())
-> (Int -> BufferM ()) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM ()
lineMoveVisRel (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("k", Bool
False, BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel (Int -> BufferM Int) -> (Int -> Int) -> Int -> BufferM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("<Down>", Bool
False, BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel)
, ("<Up>", Bool
False, BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel (Int -> BufferM Int) -> (Int -> Int) -> Int -> BufferM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("-", Bool
False, BufferM () -> () -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB (() -> BufferM ()) -> (Int -> BufferM ()) -> Int -> BufferM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel (Int -> BufferM Int) -> (Int -> Int) -> Int -> BufferM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("+", Bool
False, BufferM () -> () -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB (() -> BufferM ()) -> (Int -> BufferM ()) -> Int -> BufferM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
lineMoveRel)
, ("_", Bool
False, \n :: Int
n -> do
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
BufferM ()
firstNonSpaceB)
, ("gg", Bool
True, BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ())
-> (Int -> BufferM Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
gotoLn)
, ("<C-b>", Bool
False, Int -> BufferM ()
scrollScreensB (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("<PageUp>", Bool
False, Int -> BufferM ()
scrollScreensB (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate)
, ("<C-f>", Bool
False, Int -> BufferM ()
scrollScreensB)
, ("<PageDown>", Bool
False, Int -> BufferM ()
scrollScreensB)
, ("H", Bool
True, Int -> BufferM ()
downFromTosB (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred)
, ("M", Bool
True, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
middleB)
, ("L", Bool
True, Int -> BufferM ()
upFromBosB (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred)
]
[(EventString, Bool, Maybe Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
forall a. Semigroup a => a -> a -> a
<> [ ("G", Bool
True, Maybe Int -> BufferM ()
gotoXOrEOF) ]
exclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
exclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
exclusiveMotions = ((EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ()))
-> [(EventString, Bool, Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ())
withDefaultCount
[ ("h", Bool
False, Int -> BufferM ()
moveXorSol)
, ("l", Bool
False, Int -> BufferM ()
moveXorEol)
, ("<Left>", Bool
False, Int -> BufferM ()
moveXorSol)
, ("<Right>", Bool
False, Int -> BufferM ()
moveXorEol)
, ("w", Bool
False, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitViWord)
, ("W", Bool
False, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitViWORD)
, ("b", Bool
False, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitViWord)
, ("B", Bool
False, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitViWORD)
, ("^", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB)
, ("g^", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB)
, ("g0", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
moveToSol)
, ("<Home>", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
moveToSol)
, ("|", Bool
False, \n :: Int
n -> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
moveXorEol (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
, ("(", Bool
True, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitSentence)
, (")", Bool
True, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitSentence)
, ("{", Bool
True, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitEmacsParagraph)
, ("}", Bool
True, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitEmacsParagraph)
]
inclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
inclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]
inclusiveMotions = ((EventString, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ()))
-> [(EventString, Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(key :: EventString
key, action :: Int -> BufferM ()
action) -> (EventString
key, Bool
False, Int -> BufferM ()
action (Int -> BufferM ())
-> (Maybe Int -> Int) -> Maybe Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1))
[
("e", BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
unitViWord (Direction
Forward, BoundarySide
InsideBound) Direction
Forward)
, ("E", BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
unitViWORD (Direction
Forward, BoundarySide
InsideBound) Direction
Forward)
, ("ge", BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
unitViWord (Direction
Forward, BoundarySide
InsideBound) Direction
Backward)
, ("gE", BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
unitViWORD (Direction
Forward, BoundarySide
InsideBound) Direction
Backward)
, ("g$", \n :: Int
n -> do
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
BufferM ()
moveToEol)
, ("<End>", BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM ()
moveToEol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
leftOnEol)
, ("$", \n :: Int
n -> do
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
BufferM ()
moveToEol
BufferM ()
leftOnEol)
, ("g_", \n :: Int
n -> do
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
BufferM ()
lastNonSpaceB)
]
[(EventString, Bool, Maybe Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
-> [(EventString, Bool, Maybe Int -> BufferM ())]
forall a. Semigroup a => a -> a -> a
<>
[("%", Bool
True,
\maybeCount :: Maybe Int
maybeCount -> case Maybe Int
maybeCount of
Nothing -> BufferM ()
findMatchingPairB
Just percent :: Int
percent -> Int -> BufferM ()
movePercentageFileB Int
percent)
]
repeat :: BufferM () -> Int -> BufferM ()
repeat :: BufferM () -> Int -> BufferM ()
repeat = (Int -> BufferM () -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_
regionOfMoveB :: CountedMove -> BufferM StyledRegion
regionOfMoveB :: CountedMove -> BufferM StyledRegion
regionOfMoveB = StyledRegion -> BufferM StyledRegion
normalizeRegion (StyledRegion -> BufferM StyledRegion)
-> (CountedMove -> BufferM StyledRegion)
-> CountedMove
-> BufferM StyledRegion
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CountedMove -> BufferM StyledRegion
regionOfMoveB'
regionOfMoveB' :: CountedMove -> BufferM StyledRegion
regionOfMoveB' :: CountedMove -> BufferM StyledRegion
regionOfMoveB' (CountedMove n :: Maybe Int
n (Move style :: RegionStyle
style _isJump :: Bool
_isJump move :: Maybe Int -> BufferM ()
move)) = do
Region
region <- 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
(Maybe Int -> BufferM ()
move Maybe Int
n BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RegionStyle
style RegionStyle -> RegionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== RegionStyle
Inclusive) BufferM ()
leftOnEol)
StyledRegion -> BufferM StyledRegion
forall (m :: * -> *) a. Monad m => a -> m a
return (StyledRegion -> BufferM StyledRegion)
-> StyledRegion -> BufferM StyledRegion
forall a b. (a -> b) -> a -> b
$! RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
style Region
region
moveForwardB, moveBackwardB :: TextUnit -> Int -> BufferM ()
moveForwardB :: TextUnit -> Int -> BufferM ()
moveForwardB unit :: TextUnit
unit = BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMoveB TextUnit
unit (Direction
Backward,BoundarySide
InsideBound) Direction
Forward
moveBackwardB :: TextUnit -> Int -> BufferM ()
moveBackwardB unit :: TextUnit
unit = BufferM () -> Int -> BufferM ()
repeat (BufferM () -> Int -> BufferM ())
-> BufferM () -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
moveB TextUnit
unit Direction
Backward
gotoXOrEOF :: Maybe Int -> BufferM ()
gotoXOrEOF :: Maybe Int -> BufferM ()
gotoXOrEOF n :: Maybe Int
n = case Maybe Int
n of
Nothing -> BufferM ()
botB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol
Just n' :: Int
n' -> Int -> BufferM Int
gotoLn Int
n' BufferM Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol
withDefaultCount :: (EventString, Bool, Int -> BufferM ()) -> (EventString, Bool, Maybe Int -> BufferM ())
withDefaultCount :: (EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ())
withDefaultCount = ASetter
(EventString, Bool, Int -> BufferM ())
(EventString, Bool, Maybe Int -> BufferM ())
(Int -> BufferM ())
(Maybe Int -> BufferM ())
-> ((Int -> BufferM ()) -> Maybe Int -> BufferM ())
-> (EventString, Bool, Int -> BufferM ())
-> (EventString, Bool, Maybe Int -> BufferM ())
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(EventString, Bool, Int -> BufferM ())
(EventString, Bool, Maybe Int -> BufferM ())
(Int -> BufferM ())
(Maybe Int -> BufferM ())
forall s t a b. Field3 s t a b => Lens s t a b
_3 ((Int -> BufferM ())
-> (Maybe Int -> Int) -> Maybe Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1)
matchGotoMarkMove :: String -> MatchResult Move
matchGotoMarkMove :: String -> MatchResult Move
matchGotoMarkMove (m :: Char
m:_) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ['\'', '`'] = MatchResult Move
forall a. MatchResult a
NoMatch
matchGotoMarkMove (_:[]) = MatchResult Move
forall a. MatchResult a
PartialMatch
matchGotoMarkMove (m :: Char
m:c :: Char
c:[]) = Move -> MatchResult Move
forall a. a -> MatchResult a
WholeMatch (Move -> MatchResult Move) -> Move -> MatchResult Move
forall a b. (a -> b) -> a -> b
$ RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move RegionStyle
style Bool
True Maybe Int -> BufferM ()
forall p. p -> BufferM ()
action
where style :: RegionStyle
style = if Char
m Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '`' then RegionStyle
Inclusive else RegionStyle
LineWise
action :: p -> BufferM ()
action _mcount :: p
_mcount = do
Maybe Mark
mmark <- String -> BufferM (Maybe Mark)
mayGetMarkB [Char
c]
case Maybe Mark
mmark of
Nothing -> String -> BufferM ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BufferM ()) -> String -> BufferM ()
forall a b. (a -> b) -> a -> b
$ "Mark " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " not set"
Just mark :: Mark
mark -> Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA Mark
mark)
matchGotoMarkMove _ = MatchResult Move
forall a. MatchResult a
NoMatch
matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove (m :: Char
m:[]) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ('f' Char -> String -> String
forall a. a -> [a] -> [a]
: "FtT") = MatchResult Move
forall a. MatchResult a
PartialMatch
matchGotoCharMove (m :: Char
m:"<lt>") | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ('f' Char -> String -> String
forall a. a -> [a] -> [a]
: "FtT") = String -> MatchResult Move
matchGotoCharMove (Char
mChar -> String -> String
forall a. a -> [a] -> [a]
:"<")
matchGotoCharMove (m :: Char
m:c :: Char
c:[]) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ('f' Char -> String -> String
forall a. a -> [a] -> [a]
: "FtT") = Move -> MatchResult Move
forall a. a -> MatchResult a
WholeMatch (Move -> MatchResult Move) -> Move -> MatchResult Move
forall a b. (a -> b) -> a -> b
$ RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move RegionStyle
style Bool
False Maybe Int -> BufferM ()
action
where (style :: RegionStyle
style, move :: BufferM ()
move, offset :: BufferM ()
offset) =
case Char
m of
'f' -> (RegionStyle
Inclusive, Char -> BufferM ()
nextCInLineInc Char
c, () -> BufferM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
't' -> (RegionStyle
Inclusive, Char -> BufferM ()
nextCInLineInc Char
c, TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward)
'F' -> (RegionStyle
Exclusive, Char -> BufferM ()
prevCInLineInc Char
c, () -> BufferM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
'T' -> (RegionStyle
Exclusive, Char -> BufferM ()
prevCInLineInc Char
c, TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Forward)
_ -> String -> (RegionStyle, BufferM (), BufferM ())
forall a. HasCallStack => String -> a
error "can't happen"
action :: Maybe Int -> BufferM ()
action mcount :: Maybe Int
mcount = do
let count :: Int
count = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Int
mcount
Point
p0 <- BufferM Point
pointB
Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM ()
move
Point
p1 <- BufferM Point
pointB
BufferM ()
move
Point
p2 <- BufferM Point
pointB
BufferM ()
offset
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p2) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
p0
matchGotoCharMove _ = MatchResult Move
forall a. MatchResult a
NoMatch