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

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

module Yi.Keymap.Vim.ReplaceMap (defReplaceMap) where

import           Control.Monad            (replicateM_, when)
import           Data.Monoid              ((<>))
import qualified Data.Text                as T (unpack)
import           Yi.Buffer
import           Yi.Editor                (EditorM, getEditorDyn, withCurrentBuffer)
import           Yi.Keymap.Keys           (Key (KEsc), ctrlCh, spec)
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)
import           Yi.Keymap.Vim.StateUtils
import           Yi.Keymap.Vim.Utils      (mkBindingE)

defReplaceMap :: [VimBinding]
defReplaceMap :: [VimBinding]
defReplaceMap = [VimBinding]
specials [VimBinding] -> [VimBinding] -> [VimBinding]
forall a. Semigroup a => a -> a -> a
<> [VimBinding
printable]

specials :: [VimBinding]
specials :: [VimBinding]
specials = ((Event, EditorM (), VimState -> VimState) -> VimBinding)
-> [(Event, EditorM (), VimState -> VimState)] -> [VimBinding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VimMode
-> RepeatToken
-> (Event, EditorM (), VimState -> VimState)
-> VimBinding
mkBindingE VimMode
Replace RepeatToken
Finish)
             [ (Key -> Event
spec Key
KEsc, EditorM ()
exitReplaceMode, VimState -> VimState
resetCount (VimState -> VimState)
-> (VimState -> VimState) -> VimState -> VimState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimMode -> VimState -> VimState
switchMode VimMode
Normal)
             , (Char -> Event
ctrlCh Char
'c', EditorM ()
exitReplaceMode, VimState -> VimState
resetCount (VimState -> VimState)
-> (VimState -> VimState) -> VimState -> VimState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimMode -> VimState -> VimState
switchMode VimMode
Normal)
             ]

exitReplaceMode :: EditorM ()
exitReplaceMode :: EditorM ()
exitReplaceMode = do
  Int
count <- EditorM Int
getCountE
  Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
      [Event]
inputEvents <- (VimState -> [Event]) -> EditorM VimState -> EditorM [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventString -> [Event]
parseEvents (EventString -> [Event])
-> (VimState -> EventString) -> VimState -> [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimState -> EventString
vsOngoingInsertEvents) EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
      Int -> EditorM () -> EditorM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ (Event -> EditorM RepeatToken) -> [Event] -> EditorM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventString -> EditorM RepeatToken
printableAction (EventString -> EditorM RepeatToken)
-> (Event -> EventString) -> Event -> EditorM RepeatToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> EventString
eventToEventString) [Event]
inputEvents
  (VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
s -> VimState
s { vsOngoingInsertEvents :: EventString
vsOngoingInsertEvents = EventString
forall a. Monoid a => a
mempty }
  BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM ()
moveXorSol Int
1

printable :: VimBinding
printable :: VimBinding
printable = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
    where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs VimState
s | VimMode
Replace VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
== VimState -> VimMode
vsMode VimState
s = EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ EventString -> EditorM RepeatToken
printableAction EventString
evs
          f EventString
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch

printableAction :: EventString -> EditorM RepeatToken
printableAction :: EventString -> EditorM RepeatToken
printableAction EventString
evs = do
    EventString -> EditorM ()
saveInsertEventStringE EventString
evs
    BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ case 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
evs of
        [Char
c]    -> Char -> BufferM ()
insertOrReplaceB Char
c
        String
"<lt>" -> Char -> BufferM ()
insertOrReplaceB Char
'<'
        String
"<CR>" -> Char -> BufferM ()
insertOrReplaceB Char
'\n'
        -- For testing purposes assume noexpandtab, tw=4
        String
"<Esc>" -> Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
4 (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char -> BufferM ()
insertOrReplaceB Char
' '
        String
"<C-t>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-d>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-e>" -> BufferM ()
insertOrReplaceCharWithBelowB
        String
"<C-y>" -> BufferM ()
insertOrReplaceCharWithAboveB
        String
"<C-h>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-j>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-o>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-w>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-r>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
"<C-k>" -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO
        String
evs' -> String -> BufferM ()
forall a. HasCallStack => String -> a
error (String -> BufferM ()) -> String -> BufferM ()
forall a b. (a -> b) -> a -> b
$ String
"Unhandled event " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
evs' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in replace mode"
    RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Continue

insertOrReplaceB :: Char -> BufferM ()
insertOrReplaceB :: Char -> BufferM ()
insertOrReplaceB Char
c = do
    Char
currentChar <- BufferM Char
readB
    if Char
currentChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    then Char -> BufferM ()
insertB Char
c
    else Char -> BufferM ()
replaceCharB Char
c
    BufferM ()
rightB

insertOrReplaceCharWithBelowB :: BufferM ()
insertOrReplaceCharWithBelowB :: BufferM ()
insertOrReplaceCharWithBelowB = do
    Char
currentChar <- BufferM Char
readB
    if Char
currentChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    then BufferM ()
insertCharWithBelowB
    else BufferM ()
replaceCharWithBelowB
    BufferM ()
rightB

insertOrReplaceCharWithAboveB :: BufferM ()
insertOrReplaceCharWithAboveB :: BufferM ()
insertOrReplaceCharWithAboveB = do
    Char
currentChar <- BufferM Char
readB
    if Char
currentChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    then BufferM ()
insertCharWithAboveB
    else BufferM ()
replaceCharWithAboveB
    BufferM ()
rightB