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

-- |
-- Module      :  Yi.Keymap.Vim.NormalOperatorPendingMap
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Vim.NormalOperatorPendingMap
       (defNormalOperatorPendingMap) where

import           Control.Applicative
import           Control.Monad
import           Data.Char (isDigit)
import           Data.List (isPrefixOf)
import           Data.Maybe (fromMaybe, fromJust)
import           Data.Monoid
import qualified Data.Text as T
import           Yi.Buffer.Adjusted hiding (Insert)
import           Yi.Editor
import           Yi.Keymap.Keys
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.Motion
import           Yi.Keymap.Vim.Operator
import           Yi.Keymap.Vim.StateUtils
import           Yi.Keymap.Vim.StyledRegion
import           Yi.Keymap.Vim.TextObject
import           Yi.Keymap.Vim.Utils

defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]
defNormalOperatorPendingMap operators = [textObject operators, escBinding]

textObject :: [VimOperator] -> VimBinding
textObject operators = VimBindingE f
  where
    f evs vs = case vsMode vs of
                        NormalOperatorPending _ -> WholeMatch $ action evs
                        _ -> NoMatch
    action (Ev evs) = do
        currentState <- getEditorDyn

        let partial = vsTextObjectAccumulator currentState
            opChar = Ev . T.pack $ lastCharForOperator op
            op = fromJust $ stringToOperator operators opname
            (NormalOperatorPending opname) = vsMode currentState

        -- vim treats cw as ce
        let evs' = if opname == Op "c" && T.last evs == 'w' &&
                       (case parseOperand opChar (evr evs) of
                           JustMove _ -> True
                           _ -> False)
                   then T.init evs `T.snoc` 'e'
                   else evs
            -- TODO: fix parseOperand to take EventString as second arg
            evr x = T.unpack . _unEv $ partial <> Ev x
            operand = parseOperand opChar (evr evs')

        case operand of
            NoOperand -> do
                dropTextObjectAccumulatorE
                resetCountE
                switchModeE Normal
                return Drop
            PartialOperand -> do
                accumulateTextObjectEventE (Ev evs)
                return Continue
            _ -> do
                count <- getCountE
                dropTextObjectAccumulatorE
                token <- case operand of
                    JustTextObject cto@(CountedTextObject n _) -> do
                        normalizeCountE (Just n)
                        operatorApplyToTextObjectE op 1 $
                            changeTextObjectCount (count * n) cto
                    JustMove (CountedMove n m) -> do
                        mcount <- getMaybeCountE
                        normalizeCountE n
                        region <- withCurrentBuffer $ regionOfMoveB $ CountedMove (maybeMult mcount n) m
                        operatorApplyToRegionE op 1 region
                    JustOperator n style -> do
                        normalizeCountE (Just n)
                        normalizedCount <- getCountE
                        region <- withCurrentBuffer $ regionForOperatorLineB normalizedCount style
                        curPoint <- withCurrentBuffer pointB
                        token <- operatorApplyToRegionE op 1 region
                        when (opname == Op "y") $
                            withCurrentBuffer $ moveTo curPoint
                        return token

                    _ -> error "can't happen"
                resetCountE
                return token

regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion
regionForOperatorLineB n style = normalizeRegion =<< StyledRegion style <$> savingPointB (do
    current <- pointB
    if n == 1
    then do
        firstNonSpaceB
        p0 <- pointB
        return $! mkRegion p0 current
    else do
        void $ lineMoveRel (n-2)
        moveToEol
        rightB
        firstNonSpaceB
        p1 <- pointB
        return $! mkRegion current p1)

escBinding :: VimBinding
escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)

data OperandParseResult
    = JustTextObject !CountedTextObject
    | JustMove !CountedMove
    | JustOperator !Int !RegionStyle -- ^ like dd and d2vd
    | PartialOperand
    | NoOperand

parseOperand :: EventString -> String -> OperandParseResult
parseOperand opChar s = parseCommand mcount styleMod opChar commandString
    where (mcount, styleModString, commandString) = splitCountModifierCommand s
          styleMod = case styleModString of
            "" -> id
            "V" -> const LineWise
            "<C-v>" -> const Block
            "v" -> \style -> case style of
              Exclusive -> Inclusive
              _ -> Exclusive
            _ -> error "Can't happen"

-- | TODO: should this String be EventString?
parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)
             -> EventString -> String -> OperandParseResult
parseCommand _ _ _ "" = PartialOperand
parseCommand _ _ _ "i" = PartialOperand
parseCommand _ _ _ "a" = PartialOperand
parseCommand _ _ _ "g" = PartialOperand
parseCommand n sm o s | o' == s = JustOperator (fromMaybe 1 n) (sm LineWise)
  where o' = T.unpack . _unEv $ o
parseCommand n sm _ "0" =
  let m = Move Exclusive False (const moveToSol)
  in JustMove (CountedMove n (changeMoveStyle sm m))
parseCommand n sm _ s = case stringToMove . Ev $ T.pack s of
  WholeMatch m -> JustMove $ CountedMove n $ changeMoveStyle sm m
  PartialMatch -> PartialOperand
  NoMatch -> case stringToTextObject s of
    Just to -> JustTextObject $ CountedTextObject (fromMaybe 1 n)
               $ changeTextObjectStyle sm to
    Nothing -> NoOperand

-- TODO: setup doctests
-- Parse event string that can go after operator
-- w -> (Nothing, "", "w")
-- 2w -> (Just 2, "", "w")
-- V2w -> (Just 2, "V", "w")
-- v2V3<C-v>w -> (Just 6, "<C-v>", "w")
-- vvvvvvvvvvvvvw -> (Nothing, "v", "w")
-- 0 -> (Nothing, "", "0")
-- V0 -> (Nothing, "V", "0")
splitCountModifierCommand :: String -> (Maybe Int, String, String)
splitCountModifierCommand = go "" Nothing [""]
    where go "" Nothing mods "0" = (Nothing, head mods, "0")
          go ds count mods (h:t) | isDigit h = go (ds <> [h]) count mods t
          go ds@(_:_) count mods s@(h:_) | not (isDigit h) = go [] (maybeMult count (Just (read ds))) mods s
          go [] count mods (h:t) | h `elem` "vV" = go [] count ([h]:mods) t
          go [] count mods s | "<C-v>" `isPrefixOf` s = go [] count ("<C-v>":mods) (drop 5 s)
          go [] count mods s = (count, head mods, s)
          go ds count mods [] = (maybeMult count (Just (read ds)), head mods, [])
          go (_:_) _ _ (_:_) = error "Can't happen because isDigit and not isDigit cover every case"