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

-- |
-- Module      :  Yi.Keymap.Vim.Operator
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- TODO:
--
-- respecting wrap in gj, g0, etc
--
-- gm, go
-- ]], [[, [], ][
-- [(, [{, ]), ]}
-- ]m, ]M, [m, [M
-- [#, ]#
-- [*, [/, ]*, ]/
--
-- Traversing changelist

-- TODO:
-- from vim help:
--
-- Special case: "cw" and "cW" are treated like "ce" and "cE" if the cursor is
-- on a non-blank.  This is because "cw" is interpreted as change-word, and a
-- word does not include the following white space.  {Vi: "cw" when on a blank
-- followed by other blanks changes only the first blank; this is probably a
-- bug, because "dw" deletes all the blanks}
--
-- Another special case: When using the "w" motion in combination with an
-- operator and the last word moved over is at the end of a line, the end of
-- that word becomes the end of the operated text, not the first word in the
-- next line.
--
-- The original Vi implementation of "e" is buggy.  For example, the "e" command
-- will stop on the first character of a line if the previous line was empty.
-- But when you use "2e" this does not happen.  In Vim "ee" and "2e" are the
-- same, which is more logical.  However, this causes a small incompatibility
-- between Vi and Vim.

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 EventString
s = EventString -> MatchResult Move
lookupMove EventString
s
                 -- TODO: get rid of unpack
                 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 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 RegionStyle
style [(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, b
c) = (a
a, (a
b, b
c))

changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle RegionStyle -> RegionStyle
smod (Move RegionStyle
s Bool
j Maybe Int -> BufferM ()
m) = RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move (RegionStyle -> RegionStyle
smod RegionStyle
s) Bool
j Maybe Int -> BufferM ()
m

-- Linewise motions which treat no count as being the same as a count of 1.
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
    [ (EventString
"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)
    , (EventString
"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)
    , (EventString
"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)
    , (EventString
"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)
    , (EventString
"<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)
    , (EventString
"<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)
    , (EventString
"-", 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)
    , (EventString
"+", 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)
    , (EventString
"_", Bool
False, \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
> Int
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
- Int
1)
                BufferM ()
firstNonSpaceB)
    , (EventString
"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) -- TODO: save column
    , (EventString
"<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)
    , (EventString
"<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)
    , (EventString
"<C-f>", Bool
False, Int -> BufferM ()
scrollScreensB)
    , (EventString
"<PageDown>", Bool
False, Int -> BufferM ()
scrollScreensB)
    , (EventString
"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)
    , (EventString
"M", Bool
True, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
middleB)
    , (EventString
"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
<> [ (EventString
"G", Bool
True, Maybe Int -> BufferM ()
gotoXOrEOF) ]


-- Exclusive motions which treat no count as being the same as a count of 1.
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
    [ (EventString
"h", Bool
False, Int -> BufferM ()
moveXorSol)
    , (EventString
"l", Bool
False, Int -> BufferM ()
moveXorEol)
    , (EventString
"<Left>", Bool
False, Int -> BufferM ()
moveXorSol)
    , (EventString
"<Right>", Bool
False, Int -> BufferM ()
moveXorEol)
    , (EventString
"w", Bool
False, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitViWord)
    , (EventString
"W", Bool
False, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitViWORD)
    , (EventString
"b", Bool
False, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitViWord)
    , (EventString
"B", Bool
False, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitViWORD)
    , (EventString
"^", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB)
    , (EventString
"g^", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
firstNonSpaceB) -- TODO: respect wrapping
    , (EventString
"g0", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
moveToSol) -- TODO: respect wrapping
    , (EventString
"<Home>", Bool
False, BufferM () -> Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
moveToSol)
    -- "0" sort of belongs here, but is currently handled as a special case in some modes
    , (EventString
"|", Bool
False, \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
- Int
1))
    , (EventString
"(", Bool
True, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitSentence)
    , (EventString
")", Bool
True, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitSentence)
    , (EventString
"{", Bool
True, TextUnit -> Int -> BufferM ()
moveBackwardB TextUnit
unitEmacsParagraph)
    , (EventString
"}", Bool
True, TextUnit -> Int -> BufferM ()
moveForwardB TextUnit
unitEmacsParagraph)
    ]

-- Inclusive motions which treat no count as being the same as a count of 1.
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 (\(EventString
key, 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 Int
1))
    [
    -- Word motions
      (EventString
"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)
    , (EventString
"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)
    , (EventString
"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)
    , (EventString
"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)

    -- Intraline stuff
    , (EventString
"g$", \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
> Int
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
- Int
1)
                BufferM ()
moveToEol)
    , (EventString
"<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)
    , (EventString
"$", \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
> Int
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
- Int
1)
                BufferM ()
moveToEol
                BufferM ()
leftOnEol)
    , (EventString
"g_", \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
> Int
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
- Int
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
<>
    [(EventString
"%", Bool
True,
        \Maybe Int
maybeCount -> case Maybe Int
maybeCount of
            Maybe Int
Nothing -> BufferM ()
findMatchingPairB
            Just 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 Maybe Int
n (Move RegionStyle
style Bool
_isJump 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 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 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 Maybe Int
n = case Maybe Int
n of
    Maybe Int
Nothing -> BufferM ()
botB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol
    Just 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 Int
1)

matchGotoMarkMove :: String -> MatchResult Move
matchGotoMarkMove :: String -> MatchResult Move
matchGotoMarkMove (Char
m:String
_) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\'', Char
'`'] = MatchResult Move
forall a. MatchResult a
NoMatch
matchGotoMarkMove (Char
_:[]) = MatchResult Move
forall a. MatchResult a
PartialMatch
matchGotoMarkMove (Char
m: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
== Char
'`' then RegionStyle
Inclusive else RegionStyle
LineWise
          action :: p -> BufferM ()
action p
_mcount = do
              Maybe Mark
mmark <- String -> BufferM (Maybe Mark)
mayGetMarkB [Char
c]
              case Maybe Mark
mmark of
                  Maybe Mark
Nothing -> String -> BufferM ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BufferM ()) -> String -> BufferM ()
forall a b. (a -> b) -> a -> b
$ String
"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
<> String
" not set"
                  Just 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 String
_ = MatchResult Move
forall a. MatchResult a
NoMatch

matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove :: String -> MatchResult Move
matchGotoCharMove (Char
m:[]) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
"FtT") = MatchResult Move
forall a. MatchResult a
PartialMatch
matchGotoCharMove (Char
m:String
"<lt>") | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
"FtT") = String -> MatchResult Move
matchGotoCharMove (Char
mChar -> String -> String
forall a. a -> [a] -> [a]
:String
"<")
matchGotoCharMove (Char
m:Char
c:[]) | Char
m Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
"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 (RegionStyle
style, BufferM ()
move, BufferM ()
offset) =
              case Char
m of
                  Char
'f' -> (RegionStyle
Inclusive, Char -> BufferM ()
nextCInLineInc Char
c, () -> BufferM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                  Char
't' -> (RegionStyle
Inclusive, Char -> BufferM ()
nextCInLineInc Char
c, TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward)
                  Char
'F' -> (RegionStyle
Exclusive, Char -> BufferM ()
prevCInLineInc Char
c, () -> BufferM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                  Char
'T' -> (RegionStyle
Exclusive, Char -> BufferM ()
prevCInLineInc Char
c, TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Forward)
                  Char
_ -> String -> (RegionStyle, BufferM (), BufferM ())
forall a. HasCallStack => String -> a
error String
"can't happen"
          action :: Maybe Int -> BufferM ()
action Maybe Int
mcount = do
                  let count :: Int
count = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
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
- Int
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 String
_ = MatchResult Move
forall a. MatchResult a
NoMatch