module Yavie.Keybind.Vi (

  defaultKeybind
, defaultCmdbind
, defaultRomode

, defaultInsertmode

) where

import Control.EventDriven
  ( EventMonad, bind, unbind, runEvent, delegate,
    copyContainer, removeContainer )
import Yavie.Editor
  ( Editor, multi, needDeleteThisEditor, deleteThisEditor,
    cursorUp, cursorDown,
    cursorToTop, cursorToLine, cursorToLinePercent,
    cursorToHead, cursorToMiddle, cursorToLast,
    cursorLeft, cursorRight,
    cursorTopOfLineNotSpace, cursorTopOfLine, cursorEndOfLine,
    cursorFindChar, cursorFindCharBack,
    cursorWord, cursorWordEnd, cursorBackWord,
    resetStrForSearch, addStrForSearch,
    cursorSearchStr, cursorSearchStrBack,
    cursorNextSearchStr, cursorNextSearchStrBack,
    scrollUp, scrollDown, scrollUpPage, scrollDownPage,
    scrollUpHPage, scrollDownHPage,
    scrollForCursorHead, scrollForCursorMiddle, scrollForCursorLast,
    resetYank,
    deleteUp, deleteDown, deleteLine,
    deleteLeft, deleteRight, deleteChar,
    deleteCursorToBegin, deleteCursorToEnd,
    deleteWord, deleteWordEnd, deleteBackWord,
    deleteFind, deleteFindMore,
    concatTwoLines,
    yankLines,
    insertChar, insertNL, flipCase,
    inInsertMode, outInsertMode,
    pasteYanked, pasteYankedAfter,
    setVisualBeginY, resetVisualmode, deleteInLargeVmode, yankInLargeVmode,
    resizeDisplay,
    saveToHistory, undo, redo,
    resetTimes, addTimes,
    resetStatus, setStatus, addStatus, bsStatus,
    resetExCmd, addExCmd, getExCmd, bsExCmd,
    saveToFile,
    saveToTmpFile,
    isModified,
    saveToEditor,
    fileName,
    replaceModeOn, replaceModeOff )
import Control.Monad.State ( modify, gets, when )
import Data.Char           ( isDigit )
import Yavie.Keybind

saveHistory ::
  EventMonad Event ( Editor c ) () -> EventMonad Event ( Editor c ) ()
saveHistory = (modify saveToHistory >>)

key :: Char -> EventMonad Event ( Editor c ) ()
key ch = runEvent ( EvKey ( KASCII ch ) [ ] )

toInsertmode :: EventMonad Event ( Editor c ) ()
toInsertmode = saveHistory $
  modify ( setStatus "insert mode" ) >> modify inInsertMode >> bind insertmode >>
  modify saveToTmpFile

deleteEditorIfNeed :: EventMonad Event ( Editor c ) ()
deleteEditorIfNeed = do
  d <- gets needDeleteThisEditor
  when d removeContainer

defaultRomode :: Keybind c
defaultRomode ( EvKey ( KASCII c ) [ ] )
  | c `elem` "iIaArRdDcCsSoO" = return ()
defaultRomode e = defaultKeybind defaultCmdbind e

defaultKeybind :: Cmdbind c -> Keybind c
defaultKeybind _ EvExpose                           = return ()
defaultKeybind _ ( EvKey ( KASCII 'u' ) [ ] )       = modify undo
defaultKeybind _ ( EvKey ( KASCII 'r' ) [ MCtrl ] ) = modify redo
defaultKeybind _ ( EvKey ( KASCII 'j' ) [ ] ) = modify $ multi cursorDown
defaultKeybind _ ( EvKey ( KASCII 'k' ) [ ] ) = modify $ multi cursorUp
defaultKeybind _ ( EvKey ( KASCII 'H' ) [ ] ) = modify   cursorToHead
defaultKeybind _ ( EvKey ( KASCII 'M' ) [ ] ) = modify   cursorToMiddle
defaultKeybind _ ( EvKey ( KASCII 'L' ) [ ] ) = modify   cursorToLast
defaultKeybind _ ( EvKey ( KASCII 'l' ) [ ] ) = modify $ multi cursorRight
defaultKeybind _ ( EvKey ( KASCII 'h' ) [ ] ) = modify $ multi cursorLeft
defaultKeybind _ ( EvKey ( KASCII '$' ) [ ] ) = modify cursorEndOfLine
defaultKeybind _ ( EvKey ( KASCII '0' ) [ ] ) = modify cursorTopOfLine
defaultKeybind _ ( EvKey ( KASCII '^' ) [ ] ) = modify cursorTopOfLineNotSpace
defaultKeybind _ ( EvKey ( KASCII 'w' ) [ ] ) = modify $ multi cursorWord
defaultKeybind _ ( EvKey ( KASCII 'b' ) [ ] ) = modify $ multi cursorBackWord
defaultKeybind _ ( EvKey ( KASCII 'e' ) [ ] ) = modify $ multi cursorWordEnd
defaultKeybind _ ( EvKey ( KASCII 'f' ) [ ] ) = bind findmode
defaultKeybind _ ( EvKey ( KASCII 'F' ) [ ] ) = bind findbackmode
defaultKeybind _ ( EvKey ( KASCII 'e' ) [ MCtrl ] ) =
  modify $ multi scrollDown
defaultKeybind _ ( EvKey ( KASCII 'y' ) [ MCtrl ] ) =
  modify $ multi scrollUp
defaultKeybind _ ( EvKey ( KASCII 'f' ) [ MCtrl ] ) =
  modify $ multi scrollDownPage
defaultKeybind _ ( EvKey ( KASCII 'b' ) [ MCtrl ] ) =
  modify $ multi scrollUpPage
defaultKeybind _ ( EvKey ( KASCII 'd' ) [ MCtrl ] ) =
  modify $ multi scrollDownHPage
defaultKeybind _ ( EvKey ( KASCII 'u' ) [ MCtrl ] ) =
  modify $ multi scrollUpHPage
defaultKeybind _ ( EvKey ( KASCII 'x' ) [ ] ) = saveHistory $
  modify resetYank >> modify ( multi deleteChar )
defaultKeybind _ ( EvKey ( KASCII 'X' ) [ ] ) = saveHistory $
  modify $ multi ( deleteChar . cursorLeft )
defaultKeybind _ ( EvKey ( KASCII 'i' ) [ ] ) = toInsertmode
defaultKeybind _ ( EvKey ( KASCII 'I' ) [ ] ) = modify cursorTopOfLineNotSpace >> key 'i'
defaultKeybind _ ( EvKey ( KASCII 'a' ) [ ] ) = toInsertmode >>
  modify cursorRight
defaultKeybind _ ( EvKey ( KASCII 'A' ) [ ] ) = toInsertmode >>
  modify cursorEndOfLine >> modify cursorRight
defaultKeybind _ ( EvKey ( KASCII 'o' ) [ ] ) = 
  toInsertmode >> modify cursorEndOfLine >> modify cursorRight
               >> modify insertNL
defaultKeybind _ ( EvKey ( KASCII 'O' ) [ ] ) = 
  modify cursorTopOfLine >> modify insertNL
                                  >> modify cursorUp >> toInsertmode
defaultKeybind _ ( EvKey ( KASCII 'r' ) [ ] ) =
  saveHistory $ bind replacemodeOne
defaultKeybind _ ( EvKey ( KASCII '~' ) [ ] ) = saveHistory $
  modify flipCase >> key 'l'
defaultKeybind _ ( EvKey ( KASCII 'R' ) [ ] ) = saveHistory $
  modify inInsertMode >> modify replaceModeOn >> bind replacemode
defaultKeybind _ ( EvKey ( KASCII 's' ) [ ] ) = toInsertmode >>
  modify ( multi deleteChar )
defaultKeybind _ ( EvKey ( KASCII 'S' ) [ ] ) =
  modify cursorTopOfLine >> modify deleteCursorToEnd
                                     >> toInsertmode
defaultKeybind _ ( EvKey ( KASCII 'J' ) [ ] ) = saveHistory $
  modify cursorEndOfLine >> modify concatTwoLines
defaultKeybind _ ( EvKey ( KASCII 'D' ) [ ] ) = saveHistory $
  modify deleteCursorToEnd
defaultKeybind _ ( EvKey ( KASCII 'd' ) [ ] ) = saveHistory $
  modify resetYank >> bind deletemode
defaultKeybind _ ( EvKey ( KASCII 'C' ) [ ] ) = saveHistory $ modify inInsertMode >>
  modify deleteCursorToEnd >> key 'i'
defaultKeybind _ ( EvKey ( KASCII 'c' ) [ ] ) = saveHistory $ bind changemode
defaultKeybind _ ( EvKey ( KASCII 'y' ) [ ] ) = bind yankmode
defaultKeybind _ ( EvKey ( KASCII 'p' ) [ ] ) = saveHistory $ modify pasteYankedAfter
defaultKeybind _ ( EvKey ( KASCII 'P' ) [ ] ) = saveHistory $ modify pasteYanked
defaultKeybind _ ( EvKey ( KASCII 'G' ) [ ] ) =
  modify cursorToLine
defaultKeybind _ ( EvKey ( KASCII '%' ) [ ] ) = modify cursorToLinePercent
defaultKeybind _ ( EvKey ( KASCII 'g' ) [ ] ) = bind gomode
defaultKeybind cb ( EvKey ( KASCII 'Z' ) [ ] ) = bind $ lzmode cb
defaultKeybind _  ( EvKey ( KASCII 'z' ) [ ] ) = bind zmode
defaultKeybind _ ( EvKey ( KASCII c ) [ ] )
  | isDigit c = do modify resetTimes
                   modify $ addTimes c
                   bind digitmode 
defaultKeybind _ ( EvKey ( KASCII 'V' ) [ ] ) = do
  modify setVisualBeginY
  modify $ setStatus "V mode"
  bind visualVmode
defaultKeybind cb ( EvKey ( KASCII ':' ) [ ] ) = do
  modify resetStatus
  modify $ addStatus ':'
  modify resetExCmd
  bind $ exmode cb
defaultKeybind _ ( EvKey ( KASCII 'n' ) [ ] ) =
  modify cursorNextSearchStr
defaultKeybind _ ( EvKey ( KASCII 'N' ) [ ] ) =
  modify cursorNextSearchStrBack
defaultKeybind _ ( EvKey ( KASCII '/' ) [ ] ) = do
  modify resetStatus
  modify $ addStatus '/'
  modify resetStrForSearch
  bind $ searchmode False
defaultKeybind _ ( EvKey ( KASCII '?' ) [ ] ) = do
  modify resetStatus
  modify $ addStatus '?'
  modify resetStrForSearch
  bind $ searchmode True
defaultKeybind _ ( EvResize w h )             =
  modify $ resizeDisplay w $ h - 1
defaultKeybind _ EvDeleteEditor               = deleteEditorIfNeed
defaultKeybind _ _                            = return ()

searchmode :: Bool -> Event -> EventMonad Event ( Editor c ) ()
searchmode _ ( EvKey ( KASCII c ) [ MMeta ] ) = do
  _ <- runEvent $ EvKey KEsc [ ]
  runEvent $ EvKey ( KASCII c ) [ ]
searchmode _ ( EvKey KEsc [ ] ) = do
  _ <- unbind
  modify resetStatus
searchmode _ ( EvKey KEnter [ ] ) = do
  _ <- unbind
  modify resetStatus
searchmode d ( EvKey ( KASCII c ) [ ] ) = do
  modify $ addStrForSearch c
  modify $ addStatus c
  modify $ if d then cursorSearchStrBack else cursorSearchStr
searchmode _ _ = delegate

findmode, findbackmode :: Event -> EventMonad Event ( Editor c ) ()
findmode     ( EvKey ( KASCII c ) [ ] ) =
  unbind >> modify ( multi $ cursorFindChar c )
findmode     _                          = return ()
findbackmode ( EvKey ( KASCII c ) [ ] ) =
  unbind >> modify ( multi $ cursorFindCharBack c )
findbackmode _                          = return ()

defaultInsertmode, insertmode, replacemodeOne, replacemode :: Keybind c

defaultInsertmode = insertmode

insertmode ( EvKey ( KASCII c ) [ MMeta ] ) =
  runEvent ( EvKey KEsc [ ] ) >> runEvent ( EvKey ( KASCII c ) [ ] )
insertmode ( EvKey KEsc [ ] ) =
  modify resetStatus >> unbind >> modify cursorLeft >> modify outInsertMode
insertmode ( EvKey ( KASCII c ) [ ] ) =
  modify ( insertChar c )
insertmode ( EvKey KEnter [ ] ) =
  modify insertNL
insertmode _                  = delegate

replacemodeOne ( EvKey ( KASCII c ) [ ] ) =
  modify inInsertMode >>
  modify ( multi $ insertChar c . deleteChar ) >> unbind >> modify cursorLeft
  >> modify outInsertMode
replacemodeOne _               = return ()

replacemode ( EvKey ( KASCII c ) [ MMeta ] ) =
  runEvent ( EvKey KEsc [ ] ) >> key c
replacemode ( EvKey KEsc [ ] ) =
  modify resetStatus >> unbind >> modify cursorLeft >> modify replaceModeOff
                     >> modify outInsertMode
replacemode ( EvKey ( KASCII c ) [ ] ) =
  modify deleteChar >> modify ( insertChar c )
replacemode ( EvKey KEnter [ ] ) =
  modify deleteChar >> modify insertNL
replacemode _ = delegate

deletemode, yankmode, changemode, gomode :: Event -> EventMonad Event ( Editor c ) ()

deletemode ( EvKey ( KASCII 'k' ) [ ] ) = modify deleteUp >> unbind
deletemode ( EvKey ( KASCII 'j' ) [ ] ) = modify deleteDown >> unbind
deletemode ( EvKey ( KASCII 'h' ) [ ] ) = modify ( multi deleteLeft ) >> unbind
deletemode ( EvKey ( KASCII 'l' ) [ ] ) = modify ( multi deleteRight ) >> unbind
deletemode ( EvKey ( KASCII 'd' ) [ ] ) = modify deleteLine >> unbind
deletemode ( EvKey ( KASCII 'w' ) [ ] ) = modify ( multi deleteWord ) >> unbind
deletemode ( EvKey ( KASCII 'e' ) [ ] ) = modify ( multi deleteWordEnd ) >> unbind
deletemode ( EvKey ( KASCII 'b' ) [ ] ) = modify ( multi deleteBackWord ) >> unbind
deletemode ( EvKey ( KASCII '0' ) [ ] ) = modify deleteCursorToBegin >> unbind
deletemode ( EvKey ( KASCII '$' ) [ ] ) = modify deleteCursorToEnd >> unbind
deletemode ( EvKey ( KASCII 'f' ) [ ] ) =
  bind deletefmode
deletemode ( EvKey ( KASCII 't' ) [ ] ) =
  bind deletetmode
deletemode ( EvKey ( KASCII _ ) [ ] ) = unbind
deletemode _ = delegate

deletefmode, deletetmode, changefmode, changetmode ::
  Event -> EventMonad Event ( Editor c ) ()

deletefmode ( EvKey ( KASCII c ) [ ] ) = do
  modify $ multi $ deleteFindMore c
  unbind >> unbind
deletefmode ( EvKey _ _ ) = unbind >> unbind
deletefmode _ = delegate

deletetmode ( EvKey ( KASCII c ) [ ] ) = do
  modify $ multi $ deleteFind c
  unbind >> unbind
deletetmode (EvKey _ _ ) = unbind >> unbind
deletetmode _ = delegate

changefmode ( EvKey ( KASCII c ) [ ] ) = do
  modify $ multi $ deleteFindMore c
  _ <- unbind >> unbind
  key 'i'
changefmode ( EvKey _ _ ) = unbind >> unbind
changefmode _             = delegate

changetmode ( EvKey ( KASCII c ) [ ] ) = do
  modify $ multi $ deleteFind c
  _ <- unbind >> unbind
  key 'i'
changetmode ( EvKey _ _ ) = unbind >> unbind
changetmode _ = delegate

yankmode ( EvKey ( KASCII 'y' ) [ ] ) = modify yankLines >> unbind
yankmode ( EvKey _ _ ) = unbind
yankmode _ = delegate

changemode ( EvKey ( KASCII 'w' ) [ ] ) =
  modify ( multi deleteWord ) >> unbind >> key 'i'
changemode ( EvKey ( KASCII 'e' ) [ ] ) =
  modify ( multi deleteWordEnd ) >> unbind >> key 'i'
changemode ( EvKey ( KASCII 'b' ) [ ] ) =
  modify ( multi deleteBackWord ) >> unbind >> key 'i'
changemode ( EvKey ( KASCII '$' ) [ ] ) =
  modify inInsertMode >> modify deleteCursorToEnd >> unbind
                                  >> key 'i'
changemode ( EvKey ( KASCII '0' ) [ ] ) =
  modify deleteCursorToBegin >> unbind >> key 'i'
changemode ( EvKey ( KASCII 'c' ) [ ] ) =
  modify cursorTopOfLine >> modify deleteCursorToEnd >> unbind >> key 'i'
changemode ( EvKey ( KASCII 'f' ) [ ] ) = bind changefmode
changemode ( EvKey ( KASCII 't' ) [ ] ) = bind changetmode
changemode ( EvKey _ _ ) = unbind
changemode _             = delegate

gomode ( EvKey ( KASCII 'g' ) [ ] ) =
  modify cursorToTop >> unbind
gomode ( EvKey ( KASCII _ ) [ ] ) = unbind
gomode _                          = delegate


lzmode :: Cmdbind c -> Keybind c
lzmode cb ( EvKey ( KASCII 'Z' ) [ ] ) = unbind >> cb "wq"
lzmode _ ( EvKey _              _   ) = unbind
lzmode _ _                            = delegate

zmode :: Keybind c
zmode ( EvKey ( KASCII '.' ) [ ] ) =
  unbind >> modify scrollForCursorMiddle
zmode ( EvKey   KEnter       [ ] ) =
  unbind >> modify scrollForCursorHead
zmode ( EvKey ( KASCII '-' ) [ ] ) =
  unbind >> modify scrollForCursorLast
zmode ( EvKey _              _   ) = unbind
zmode _                            = delegate

digitmode :: Event -> EventMonad Event ( Editor c ) ()
digitmode ( EvKey ( KASCII c ) [ ] )
  | isDigit c = modify $ addTimes c
  | otherwise = unbind >> runEvent ( EvKey ( KASCII c ) [ ] )
digitmode EvDeleteEditor = delegate
digitmode ev = unbind >> runEvent ev

exmode :: Cmdbind c -> Keybind c
exmode _ ( EvKey ( KASCII c ) [ MMeta ] ) = do
  _ <- runEvent $ EvKey KEsc [ ]
  runEvent $ EvKey ( KASCII c ) [ ]
exmode _ ( EvKey KEsc [ ] ) = do
  _ <- unbind
  modify resetStatus
exmode cb ( EvKey KEnter [ ] ) = do
  _ <- unbind
  modify resetStatus
  cmd <- gets getExCmd
  modify resetExCmd
  cb cmd
exmode _ ( EvKey ( KASCII 'h' ) [ MCtrl ] ) = do
  modify bsStatus
  modify bsExCmd
exmode _ ( EvKey ( KASCII c ) [ ] ) = do
  modify $ addStatus c
  modify $ addExCmd c
exmode _ _ = return ()

defaultCmdbind :: Cmdbind c
defaultCmdbind "q"   = do
  m <- gets isModified
  if m then modify ( setStatus "modified! use wq or q!" )
       else removeContainer
defaultCmdbind "q!"  = removeContainer
defaultCmdbind "w"   = modify saveToFile
defaultCmdbind "wq"  = do
  modify saveToFile
  modify deleteThisEditor
defaultCmdbind "e!"               = do
  fn <- gets fileName
  modify $ saveToEditor fn
defaultCmdbind ( 'e' : ' ' : fn ) = do
  _ <- copyContainer
  modify $ saveToEditor fn
defaultCmdbind cmd   = modify $ setStatus $ cmd ++ " is not valid ex command"

visualVmode :: Event -> EventMonad Event ( Editor c ) ()
visualVmode ( EvKey ( KASCII c ) [ MMeta ] ) =
  runEvent ( EvKey KEsc [ ] ) >> runEvent ( EvKey ( KASCII c ) [ ] )
visualVmode ( EvKey KEsc [ ] ) = modify resetVisualmode >> unbind
visualVmode ( EvKey ( KASCII 'y' ) [ ] ) = do
  modify yankInLargeVmode
  unbind
visualVmode ( EvKey ( KASCII 'd' ) [ ] ) = saveHistory $ do
  modify deleteInLargeVmode
  unbind
visualVmode _ = delegate