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

    -- |
    -- Module      :  Yi.Keymap.Vim.Operator
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Implements some operators for the Vim keymap.

    module Yi.Keymap.Vim.Operator
        ( VimOperator(..)
        , defOperators
        , opDelete
        , opChange
        , opYank
        , opFormat
        , stringToOperator
        , mkCharTransformOperator
        , operatorApplyToTextObjectE
        , lastCharForOperator
        ) where

    import           Control.Monad              (when)
    import           Data.Char                  (isSpace, toLower, toUpper)
    import           Data.Foldable              (find)
    import qualified Data.List.NonEmpty as NE
    import           Data.Maybe                 (fromJust)
    import           Data.Monoid                ((<>))
    import qualified Data.Text                  as T (unpack)
    import           Yi.Buffer                  hiding (Insert)
    import           Yi.Buffer.Misc             (startUpdateTransactionB)
    import           Yi.Editor                  (EditorM, getEditorDyn, withCurrentBuffer)
    import           Yi.Keymap.Vim.Common
    import           Yi.Keymap.Vim.EventUtils   (eventToEventString, parseEvents)
    import           Yi.Keymap.Vim.StateUtils   (setRegisterE, switchModeE, modifyStateE)
    import           Yi.Keymap.Vim.StyledRegion (StyledRegion (..), transformCharactersInRegionB)
    import           Yi.Keymap.Vim.TextObject   (CountedTextObject, regionOfTextObjectB)
    import           Yi.Keymap.Vim.Utils        (indentBlockRegionB)
    import           Yi.Misc                    (rot13Char)
    import           Yi.Rope                    (YiString)
    import qualified Yi.Rope                    as R

    data VimOperator = VimOperator {
        VimOperator -> OperatorName
    operatorName :: !OperatorName
      , VimOperator -> Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    }

    defOperators :: [VimOperator]
    defOperators :: [VimOperator]
    defOperators =
        [ VimOperator
    opYank
        , VimOperator
    opDelete
        , VimOperator
    opChange
        , VimOperator
    opFormat
        , OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator OperatorName
    "gu" Char -> Char
    toLower
        , OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator OperatorName
    "gU" Char -> Char
    toUpper
        , OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator OperatorName
    "g~" Char -> Char
    switchCaseChar
        , OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator OperatorName
    "g?" Char -> Char
    rot13Char
        , OperatorName -> (Int -> Int) -> VimOperator
    mkShiftOperator OperatorName
    ">" Int -> Int
    forall a. a -> a
    id
        , OperatorName -> (Int -> Int) -> VimOperator
    mkShiftOperator OperatorName
    "<lt>" Int -> Int
    forall a. Num a => a -> a
    negate
        ]

    stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator
    stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator
    stringToOperator [VimOperator]
    ops OperatorName
    name = (VimOperator -> Bool) -> [VimOperator] -> Maybe VimOperator
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((OperatorName -> OperatorName -> Bool
    forall a. Eq a => a -> a -> Bool
    == OperatorName
    name) (OperatorName -> Bool)
    -> (VimOperator -> OperatorName) -> VimOperator -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VimOperator -> OperatorName
    operatorName) [VimOperator]
    ops

    operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
    operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
    operatorApplyToTextObjectE VimOperator
    op Int
    count CountedTextObject
    cto = do
        styledRegion <- BufferM StyledRegion -> EditorM StyledRegion
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM StyledRegion -> EditorM StyledRegion)
    -> BufferM StyledRegion -> EditorM StyledRegion
    forall a b. (a -> b) -> a -> b
    $ CountedTextObject -> BufferM StyledRegion
    regionOfTextObjectB CountedTextObject
    cto
        operatorApplyToRegionE op count styledRegion

    opYank :: VimOperator
    opYank :: VimOperator
    opYank = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    "y"
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    _count (StyledRegion RegionStyle
    style Region
    reg) -> do
            s <- BufferM YiString -> EditorM YiString
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM YiString -> EditorM YiString)
    -> BufferM YiString -> EditorM YiString
    forall a b. (a -> b) -> a -> b
    $ Region -> RegionStyle -> BufferM YiString
    readRegionRopeWithStyleB Region
    reg RegionStyle
    style
            regName <- fmap vsActiveRegister getEditorDyn
            setRegisterE regName style s
            withCurrentBuffer $ moveTo . regionStart =<< convertRegionToStyleB reg style
            switchModeE Normal
            return Finish
    }

    opDelete :: VimOperator
    opDelete :: VimOperator
    opDelete = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    "d"
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    _count (StyledRegion RegionStyle
    style Region
    reg) -> do
            s <- BufferM YiString -> EditorM YiString
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM YiString -> EditorM YiString)
    -> BufferM YiString -> EditorM YiString
    forall a b. (a -> b) -> a -> b
    $ Region -> RegionStyle -> BufferM YiString
    readRegionRopeWithStyleB Region
    reg RegionStyle
    style
            regName <- fmap vsActiveRegister getEditorDyn
            setRegisterE regName style s
            withCurrentBuffer $ do
                point <- NE.head <$> deleteRegionWithStyleB reg style
                moveTo point
                eof <- atEof
                if eof
                then do
                    leftB
                    c <- readB
                    when (c == '\n') $ deleteN 1 >> moveToSol
                else leftOnEol
            switchModeE Normal
            return Finish
    }

    opChange :: VimOperator
    opChange :: VimOperator
    opChange = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    "c"
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    _count (StyledRegion RegionStyle
    style Region
    reg) -> do
            s <- BufferM YiString -> EditorM YiString
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM YiString -> EditorM YiString)
    -> BufferM YiString -> EditorM YiString
    forall a b. (a -> b) -> a -> b
    $ Region -> RegionStyle -> BufferM YiString
    readRegionRopeWithStyleB Region
    reg RegionStyle
    style
            regName <- fmap vsActiveRegister getEditorDyn
            setRegisterE regName style s
            do
                withCurrentBuffer $ startUpdateTransactionB
                case style of
                    RegionStyle
    LineWise -> BufferM () -> EditorM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
    forall a b. (a -> b) -> a -> b
    $ do
                        point <- NonEmpty Point -> Point
    forall a. NonEmpty a -> a
    NE.head (NonEmpty Point -> Point)
    -> BufferM (NonEmpty Point) -> BufferM Point
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Region -> RegionStyle -> BufferM (NonEmpty Point)
    deleteRegionWithStyleB Region
    reg RegionStyle
    style
                        moveTo point
                        insertB '\n'
                        leftB
                    RegionStyle
    Block -> do
                        points <- BufferM (NonEmpty Point) -> EditorM (NonEmpty Point)
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM (NonEmpty Point) -> EditorM (NonEmpty Point))
    -> BufferM (NonEmpty Point) -> EditorM (NonEmpty Point)
    forall a b. (a -> b) -> a -> b
    $ do
                            points <- Region -> RegionStyle -> BufferM (NonEmpty Point)
    deleteRegionWithStyleB Region
    reg RegionStyle
    style
                            moveTo $ NE.head points
                            return points
                        modifyStateE $ \VimState
    s -> VimState
    s { vsSecondaryCursors = NE.tail points }
                    RegionStyle
    _ -> BufferM () -> EditorM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
    forall a b. (a -> b) -> a -> b
    $ do
                        point <- NonEmpty Point -> Point
    forall a. NonEmpty a -> a
    NE.head (NonEmpty Point -> Point)
    -> BufferM (NonEmpty Point) -> BufferM Point
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Region -> RegionStyle -> BufferM (NonEmpty Point)
    deleteRegionWithStyleB Region
    reg RegionStyle
    style
                        moveTo point
            switchModeE $ Insert 'c'
            return Continue
    }

    opFormat :: VimOperator
    opFormat :: VimOperator
    opFormat = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    "gq"
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    _count (StyledRegion RegionStyle
    style Region
    reg) -> do
          BufferM () -> EditorM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
    forall a b. (a -> b) -> a -> b
    $ RegionStyle -> Region -> BufferM ()
    formatRegionB RegionStyle
    style Region
    reg
          VimMode -> EditorM ()
    switchModeE VimMode
    Normal
          RepeatToken -> EditorM RepeatToken
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RepeatToken
    Finish
    }

    formatRegionB :: RegionStyle -> Region -> BufferM ()
    formatRegionB :: RegionStyle -> Region -> BufferM ()
    formatRegionB RegionStyle
    Block Region
    _reg = () -> BufferM ()
    forall a. a -> BufferM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    formatRegionB RegionStyle
    _style Region
    reg = do
        start <- Point -> BufferM Point
    solPointB (Point -> BufferM Point) -> Point -> BufferM Point
    forall a b. (a -> b) -> a -> b
    $ Region -> Point
    regionStart Region
    reg
        end <- eolPointB $ regionEnd reg
        moveTo start
        -- Don't use firstNonSpaceB since paragraphs can start with lines made
        -- completely of whitespace (which should be fixed)
        untilB_ ((not . isSpace) <$> readB) rightB
        indent <- curCol
        modifyRegionB (formatStringWithIndent indent) $ reg { regionStart = start
                                                            , regionEnd = end
                                                            }
        -- Emulate vim behaviour
        moveTo =<< solPointB end
        firstNonSpaceB

    formatStringWithIndent :: Int -> YiString -> YiString
    formatStringWithIndent :: Int -> YiString -> YiString
    formatStringWithIndent Int
    indent YiString
    str
        | YiString -> Bool
    R.null YiString
    str = YiString
    R.empty
        | Bool
    otherwise = let spaces :: YiString
    spaces = Int -> Char -> YiString
    R.replicateChar Int
    indent Char
    ' '
                          (YiString
    formattedLine, YiString
    textToFormat) = Int -> YiString -> (YiString, YiString)
    getNextLine (Int
    80 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    indent) YiString
    str
                          lineEnd :: YiString
    lineEnd = if YiString -> Bool
    R.null YiString
    textToFormat
                                    then YiString
    R.empty
                                    else Char
    '\n' Char -> YiString -> YiString
    `R.cons` Int -> YiString -> YiString
    formatStringWithIndent Int
    indent YiString
    textToFormat
                      in [YiString] -> YiString
    R.concat [ YiString
    spaces
                                  , YiString
    formattedLine
                                  , YiString
    lineEnd
                                  ]

    getNextLine :: Int -> YiString -> (YiString, YiString)
    getNextLine :: Int -> YiString -> (YiString, YiString)
    getNextLine Int
    maxLength YiString
    str = let firstSplit :: (YiString, YiString)
    firstSplit = (YiString, YiString) -> (YiString, YiString)
    takeBlock (YiString
    R.empty, (Char -> Bool) -> YiString -> YiString
    R.dropWhile Char -> Bool
    isSpace YiString
    str)
                                    isMaxLength :: (YiString, YiString) -> Bool
    isMaxLength (YiString
    l, YiString
    r) = YiString -> Int
    R.length YiString
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxLength Bool -> Bool -> Bool
    || YiString -> Bool
    R.null YiString
    r
                                in if (YiString, YiString) -> Bool
    isMaxLength (YiString, YiString)
    firstSplit
                                   then (YiString, YiString)
    firstSplit
                                   else let (YiString
    line, YiString
    remainingText) = ((YiString, YiString) -> Bool)
    -> ((YiString, YiString) -> (YiString, YiString))
    -> (YiString, YiString)
    -> (YiString, YiString)
    forall a. (a -> Bool) -> (a -> a) -> a -> a
    until (YiString, YiString) -> Bool
    isMaxLength
                                                                          (YiString, YiString) -> (YiString, YiString)
    takeBlock
                                                                          (YiString, YiString)
    firstSplit
                                        in if YiString -> Int
    R.length YiString
    line Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxLength
                                           then ((Char -> Bool) -> YiString -> YiString
    R.dropWhileEnd Char -> Bool
    isSpace YiString
    line, YiString
    remainingText)
                                           else let (YiString
    beginL, YiString
    endL) = YiString -> (YiString, YiString)
    breakAtLastItem YiString
    line
                                                in if Char -> Bool
    isSpace (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe Char -> Char
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Char -> Char) -> Maybe Char -> Char
    forall a b. (a -> b) -> a -> b
    $ YiString -> Maybe Char
    R.head YiString
    endL
                                                   then (YiString
    beginL, YiString
    remainingText)
                                                   else ((Char -> Bool) -> YiString -> YiString
    R.dropWhileEnd Char -> Bool
    isSpace YiString
    beginL, YiString
    endL YiString -> YiString -> YiString
    `R.append` YiString
    remainingText)
                                where
                                    isMatch :: Maybe Char -> Char -> Bool
    isMatch (Just Char
    x) Char
    y = Char -> Bool
    isSpace Char
    x Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Bool
    isSpace Char
    y
                                    isMatch Maybe Char
    Nothing Char
    _ = Bool
    False

                                    -- Gets the next block of either whitespace, or non-whitespace,
                                    -- characters
                                    takeBlock :: (YiString, YiString) -> (YiString, YiString)
    takeBlock (YiString
    cur, YiString
    rest) =
                                        let (YiString
    word, YiString
    line) = (Char -> Bool) -> YiString -> (YiString, YiString)
    R.span (Maybe Char -> Char -> Bool
    isMatch (Maybe Char -> Char -> Bool) -> Maybe Char -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ YiString -> Maybe Char
    R.head YiString
    rest) YiString
    rest
                                        in (YiString
    cur YiString -> YiString -> YiString
    `R.append` (Char -> Char) -> YiString -> YiString
    R.map (\Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' then Char
    ' ' else Char
    c) YiString
    word, YiString
    line)
                                    breakAtLastItem :: YiString -> (YiString, YiString)
    breakAtLastItem YiString
    s =
                                        let y :: YiString
    y = (Char -> Bool) -> YiString -> YiString
    R.takeWhileEnd (Maybe Char -> Char -> Bool
    isMatch (Maybe Char -> Char -> Bool) -> Maybe Char -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ YiString -> Maybe Char
    R.last YiString
    s) YiString
    s
                                            (YiString
    x, YiString
    _) = Int -> YiString -> (YiString, YiString)
    R.splitAt (YiString -> Int
    R.length YiString
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - YiString -> Int
    R.length YiString
    y) YiString
    s
                                        in (YiString
    x, YiString
    y)

    mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator
    mkCharTransformOperator OperatorName
    name Char -> Char
    f = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    name
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    count StyledRegion
    sreg -> do
            BufferM () -> EditorM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
    forall a b. (a -> b) -> a -> b
    $ StyledRegion -> (Char -> Char) -> BufferM ()
    transformCharactersInRegionB StyledRegion
    sreg
                        ((Char -> Char) -> BufferM ()) -> (Char -> Char) -> BufferM ()
    forall a b. (a -> b) -> a -> b
    $ ((Char -> Char) -> (Char -> Char) -> Char -> Char)
    -> (Char -> Char) -> [Char -> Char] -> Char -> Char
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Char -> Char) -> (Char -> Char) -> Char -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) Char -> Char
    forall a. a -> a
    id (Int -> (Char -> Char) -> [Char -> Char]
    forall a. Int -> a -> [a]
    replicate Int
    count Char -> Char
    f)
            VimMode -> EditorM ()
    switchModeE VimMode
    Normal
            RepeatToken -> EditorM RepeatToken
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RepeatToken
    Finish
    }

    mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator
    mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator
    mkShiftOperator OperatorName
    name Int -> Int
    countMod = VimOperator {
        operatorName :: OperatorName
    operatorName = OperatorName
    name
      , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
    operatorApplyToRegionE = \Int
    count (StyledRegion RegionStyle
    style Region
    reg) -> do
            BufferM () -> EditorM ()
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
    forall a b. (a -> b) -> a -> b
    $
                if RegionStyle
    style RegionStyle -> RegionStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == RegionStyle
    Block
                then Int -> Region -> BufferM ()
    indentBlockRegionB (Int -> Int
    countMod Int
    count) Region
    reg
                else do
                    reg' <- Region -> RegionStyle -> BufferM Region
    convertRegionToStyleB Region
    reg RegionStyle
    style
                    shiftIndentOfRegionB (countMod count) reg'
            VimMode -> EditorM ()
    switchModeE VimMode
    Normal
            RepeatToken -> EditorM RepeatToken
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RepeatToken
    Finish
    }

    lastCharForOperator :: VimOperator -> String
    lastCharForOperator :: VimOperator -> [Char]
    lastCharForOperator (VimOperator { operatorName :: VimOperator -> OperatorName
    operatorName = OperatorName
    name })
        -- This cast here seems stupid, maybe we should only have one
        -- type?
        = case EventString -> [Event]
    parseEvents (Text -> EventString
    Ev (Text -> EventString)
    -> (OperatorName -> Text) -> OperatorName -> EventString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OperatorName -> Text
    _unOp (OperatorName -> EventString) -> OperatorName -> EventString
    forall a b. (a -> b) -> a -> b
    $ OperatorName
    name) of
            [] -> [Char] -> [Char]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "invalid operator name " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Char]
    T.unpack (OperatorName -> Text
    _unOp OperatorName
    name)
            [Event]
    evs -> Text -> [Char]
    T.unpack (Text -> [Char]) -> (Event -> Text) -> Event -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EventString -> Text
    _unEv (EventString -> Text) -> (Event -> EventString) -> Event -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Event -> EventString
    eventToEventString (Event -> [Char]) -> Event -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Event] -> Event
    forall a. HasCallStack => [a] -> a
    last [Event]
    evs