{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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           Lens.Micro.Platform        ((.=))
import           Control.Monad              (forM_, void, when)
import           Data.Char                  (ord)
import           Data.List                  (group)
import           Data.Maybe                 (fromJust, fromMaybe)
import qualified Data.Text                  as T (unpack)
import           Yi.Buffer                  hiding (Insert)
import           Yi.Editor
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.Operator     (VimOperator (..), opDelete, stringToOperator)
import           Yi.Keymap.Vim.StateUtils
import           Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInRegionB)
import           Yi.Keymap.Vim.Tag          (gotoTag)
import           Yi.Keymap.Vim.TextObject
import           Yi.Keymap.Vim.Utils        (matchFromBool, mkChooseRegisterBinding, mkMotionBinding, addNewLineIfNecessary, pasteInclusiveB)
import           Yi.MiniBuffer              (spawnMinibufferE)
import           Yi.Monad                   (whenM)
import qualified Yi.Rope                    as R (toText, countNewLines)
import           Yi.Tag                     (Tag (Tag))
import           Yi.Utils                   (SemiNum ((-~)))

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

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 ":" id
              withCurrentBuffer $ writeN "'<,'>"
              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
                      withCurrentBuffer $ stickyEolA .= 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

textObjectBinding :: VimBinding
textObjectBinding = VimBindingE (f . T.unpack . _unEv)
    where
    f (stringToTextObject -> PartialMatch) (VimState {vsMode = Visual _}) = PartialMatch
    f (stringToTextObject -> WholeMatch to) (VimState {vsMode = Visual _, vsCount = mbCount}) =
        let count = fromMaybe 1 mbCount
        in
        WholeMatch $ do
            withCurrentBuffer $ do
                StyledRegion _ reg <- regionOfTextObjectB (CountedTextObject count to)
                setSelectionMarkPointB (regionStart reg)
                moveTo (regionEnd reg -~ 1)
            return Continue
    f _ _ = NoMatch

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")
                                  , ("s", "c")
                                  , ("S", "c")
                                  , ("C", "c")
                                  , ("~", "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)
                    void escAction
                    return Finish
                _ -> NoMatch
          f _ _ = NoMatch


data VisualPaste
  = PasteBefore
  | ReplaceSelection
  deriving (Eq, Ord, Show)

pasteBinding :: VimBinding
pasteBinding = VimBindingE (f . T.unpack . _unEv)
    where
    f "P" VimState { vsMode = (Visual style) } = pasteMatch style PasteBefore
    f "p" VimState { vsMode = (Visual style) } = pasteMatch style ReplaceSelection
    f _ _ = NoMatch

    pasteMatch :: RegionStyle -> VisualPaste -> MatchResult (EditorM RepeatToken)
    pasteMatch style p = WholeMatch $ do
        register <- getRegisterE . vsActiveRegister =<< getEditorDyn
        maybe (pure ()) (paste style p) register
        void escAction
        return Finish

    paste :: RegionStyle -> VisualPaste -> Register -> EditorM ()
    paste LineWise  = linePaste
    paste Block     = blockPaste
    paste Inclusive = otherPaste
    paste Exclusive = otherPaste

    linePaste :: VisualPaste -> Register -> EditorM ()
    linePaste p (Register _style rope) = withCurrentBuffer $ do
        region <- regionOfSelectionB
        when (p == ReplaceSelection) . void $ deleteRegionWithStyleB region LineWise
        insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise

    blockPaste :: VisualPaste -> Register -> EditorM ()
    blockPaste p (Register _style rope) = withCurrentBuffer $ do
        here <- pointB
        there <- getSelectionMarkPointB
        (here', there') <- flipRectangleB here there
        reg <- regionOfSelectionB
        moveTo (minimum [here, there, here', there'])
        when (p == ReplaceSelection) . void $ deleteRegionWithStyleB reg Block
        if R.countNewLines rope == 0
        then actionOnLeft reg $ maybe (pure ()) (\_ -> insertRopeWithStyleB rope _style)
        else pasteInclusiveB rope _style
      where
        -- Taken from deleteRegionWithStyleB
        actionOnLeft :: Region -> (Maybe Point -> BufferM ()) -> BufferM ()
        actionOnLeft reg action = savingPointB $ do
            (start, lengths) <- shapeOfBlockRegionB reg
            moveTo start
            forM_ (zip [0..] lengths) $ \(i, l) -> do
                p' <- pointB
                moveTo start
                void $ lineMoveRel i
                action (if l == 0 then Nothing else Just p')

    otherPaste :: VisualPaste -> Register -> EditorM ()
    otherPaste _ (Register _style rope) = withCurrentBuffer $ do
      region <- regionOfSelectionB
      region' <- convertRegionToStyleB region Inclusive
      replaceRegionB region' rope


switchEdgeBinding :: VimBinding
switchEdgeBinding = VimBindingE (f . T.unpack . _unEv)
    where f [c] (VimState { vsMode = (Visual _) }) | c `elem` ['o', 'O']
              = 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."
                  case cursors of
                      [] -> error "No cursor to move to (in Yi.Keymap.Vim.VisualMap.insertBinding)"
                      (mainCursor : _) -> withCurrentBuffer (moveTo mainCursor)
                  modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }
                  withCurrentBuffer $ setVisibleSelection False
                  switchModeE $ Insert (head evs)
                  return Continue
          f _ _ = NoMatch

tagJumpBinding :: VimBinding
tagJumpBinding = VimBindingY (f . T.unpack . _unEv)
    where f "<C-]>" (VimState { vsMode = (Visual _) })
            = WholeMatch $ do
                 tag <- Tag . R.toText <$> withCurrentBuffer
                            (regionOfSelectionB >>= readRegionB)
                 void $ withEditor escAction
                 gotoTag tag 0 Nothing
                 return Finish
          f _ _ = NoMatch