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

-- |
-- Module      :  Yi.Keymap.Vim.VisualMap
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- I'm a module waiting for some kind soul to give me a commentary!

module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where

import           Control.Applicative
import           Control.Lens hiding ((-~), op)
import           Control.Monad
import           Data.Char (ord)
import           Data.List (group)
import           Data.Maybe (fromJust)
import qualified Data.Text as T
import           Yi.Buffer.Adjusted hiding (Insert)
import           Yi.Editor
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.Operator
import           Yi.Keymap.Vim.StateUtils
import           Yi.Keymap.Vim.StyledRegion
import           Yi.Keymap.Vim.Utils
import           Yi.MiniBuffer
import           Yi.Monad
import           Yi.Utils

defVisualMap :: [VimOperator] -> [VimBinding]
defVisualMap operators =
    [escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding]
    ++ [chooseRegisterBinding]
    ++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]
    ++ [insertBinding, exBinding, shiftDBinding]

escAction :: EditorM RepeatToken
escAction = do
    resetCountE
    clrStatus
    withCurrentBuffer $ do
        setVisibleSelection False
        putRegionStyle Inclusive
    switchModeE Normal
    return Drop

escBinding :: VimBinding
escBinding = VimBindingE f
    where f evs (VimState { vsMode = (Visual _) }) = escAction <$
              matchFromBool (evs `elem` ["<Esc>", "<C-c>"])
          f _ _ = NoMatch

exBinding :: VimBinding
exBinding = VimBindingE f
    where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
              void $ spawnMinibufferE (T.pack ":'<,'>") id
              switchModeE Ex
              return Finish
          f _ _ = NoMatch

digitBindings :: [VimBinding]
digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9']

zeroBinding :: VimBinding
zeroBinding = VimBindingE f
    where f "0" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
              currentState <- getEditorDyn
              case vsCount currentState of
                  Just c -> do
                      setCountE (10 * c)
                      return Continue
                  Nothing -> do
                      withCurrentBuffer moveToSol
                      resetCountE
                      setStickyEolE False
                      return Continue
          f _ _ = NoMatch

setMarkBinding :: VimBinding
setMarkBinding = VimBindingE (f . T.unpack . _unEv)
    where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch
          f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do
              withCurrentBuffer $ setNamedMarkHereB [c]
              return Continue
          f _ _ = NoMatch

changeVisualStyleBinding :: VimBinding
changeVisualStyleBinding = VimBindingE f
    where f evs (VimState { vsMode = (Visual _) })
            | evs `elem` ["v", "V", "<C-v>"]
            = WholeMatch $ do
                  currentMode <- fmap vsMode getEditorDyn
                  let newStyle = case evs of
                         "v" -> Inclusive
                         "V" -> LineWise
                         "<C-v>" -> Block
                         _ -> error "Just silencing false positive warning."
                      newMode = Visual newStyle
                  if newMode == currentMode
                  then escAction
                  else do
                      modifyStateE $ \s -> s { vsMode = newMode }
                      withCurrentBuffer $ do
                          putRegionStyle newStyle
                          rectangleSelectionA .= (Block == newStyle)
                          setVisibleSelection True
                      return Finish
          f _ _ = NoMatch

mkDigitBinding :: Char -> VimBinding
mkDigitBinding c = VimBindingE (f . T.unpack . _unEv)
    where f [c'] (VimState { vsMode = (Visual _) }) | c == c'
            = WholeMatch $ do
                  modifyStateE mutate
                  return Continue
          f _ _ = NoMatch
          mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }
          mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d }
          d = ord c - ord '0'

motionBinding :: VimBinding
motionBinding = mkMotionBinding Continue $
    \m -> case m of
        Visual _ -> True
        _ -> False

regionOfSelectionB :: BufferM Region
regionOfSelectionB = savingPointB $ do
    start <- getSelectionMarkPointB
    stop <- pointB
    return $! mkRegion start stop

operatorBindings :: [VimOperator] -> [VimBinding]
operatorBindings operators = fmap mkOperatorBinding $ operators ++ visualOperators
    where visualOperators = fmap synonymOp
                                  [ ("x", "d")
                                  , ("~", "g~")
                                  , ("Y", "y")
                                  , ("u", "gu")
                                  , ("U", "gU")
                                  ]
          synonymOp (newName, existingName) =
                    VimOperator newName . operatorApplyToRegionE . fromJust
                    . stringToOperator operators $ existingName

chooseRegisterBinding :: VimBinding
chooseRegisterBinding = mkChooseRegisterBinding $
    \s -> case s of
        (VimState { vsMode = (Visual _) }) -> True
        _ -> False

shiftDBinding :: VimBinding
shiftDBinding = VimBindingE (f . T.unpack . _unEv)
    where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do
              (Visual style) <- vsMode <$> getEditorDyn
              reg <- withCurrentBuffer regionOfSelectionB
              case style of
                  Block -> withCurrentBuffer $ do
                      (start, lengths) <- shapeOfBlockRegionB reg
                      moveTo start
                      startCol <- curCol
                      forM_ (reverse [0 .. length lengths - 1]) $ \l -> do
                          moveTo start
                          void $ lineMoveRel l
                          whenM (fmap (== startCol) curCol) deleteToEol
                      leftOnEol
                  _ ->  do
                      reg' <- withCurrentBuffer $ convertRegionToStyleB reg LineWise
                      reg'' <- withCurrentBuffer $ mkRegionOfStyleB (regionStart reg')
                                                              (regionEnd reg' -~ Size 1)
                                                              Exclusive
                      void $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg''
              resetCountE
              switchModeE Normal
              return Finish
          f _ _ = NoMatch

mkOperatorBinding :: VimOperator -> VimBinding
mkOperatorBinding op = VimBindingE f
  where
    f evs (VimState { vsMode = (Visual _) }) =
      action <$ evs `matchesString` Ev (_unOp $ operatorName op)
    f _ _ = NoMatch
    action = do
        (Visual style) <- vsMode <$> getEditorDyn
        region <- withCurrentBuffer regionOfSelectionB
        count <- getCountE
        token <- operatorApplyToRegionE op count $ StyledRegion style region
        resetCountE
        clrStatus
        withCurrentBuffer $ do
            setVisibleSelection False
            putRegionStyle Inclusive
        return token

replaceBinding :: VimBinding
replaceBinding = VimBindingE (f . T.unpack . _unEv)
    where f evs (VimState { vsMode = (Visual _) }) =
              case evs of
                "r" -> PartialMatch
                ('r':c:[]) -> WholeMatch $ do
                    (Visual style) <- vsMode <$> getEditorDyn
                    region <- withCurrentBuffer regionOfSelectionB
                    withCurrentBuffer $ transformCharactersInRegionB (StyledRegion style region)
                                      (\x -> if x == '\n' then x else c)
                    switchModeE Normal
                    return Finish
                _ -> NoMatch
          f _ _ = NoMatch

switchEdgeBinding :: VimBinding
switchEdgeBinding = VimBindingE (f . T.unpack . _unEv)
    where f [c] (VimState { vsMode = (Visual _) }) | c `elem` "oO"
              = WholeMatch $ do
                  (Visual style) <- vsMode <$> getEditorDyn
                  withCurrentBuffer $ do
                      here <- pointB
                      there <- getSelectionMarkPointB
                      (here', there') <- case (c, style) of
                                            ('O', Block) -> flipRectangleB here there
                                            (_, _) -> return (there, here)
                      moveTo here'
                      setSelectionMarkPointB there'
                  return Continue
          f _ _ = NoMatch

insertBinding :: VimBinding
insertBinding = VimBindingE (f . T.unpack . _unEv)
    where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA"
            = WholeMatch $ do
                  (Visual style) <- vsMode <$> getEditorDyn
                  region <- withCurrentBuffer regionOfSelectionB
                  cursors <- withCurrentBuffer $ case evs of
                      "I" -> leftEdgesOfRegionB style region
                      "A" -> rightEdgesOfRegionB style region
                      _ -> error "Just silencing ghc's false positive warning."
                  withCurrentBuffer $ moveTo $ head cursors
                  modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }
                  switchModeE $ Insert (head evs)
                  return Continue
          f _ _ = NoMatch