module Yavie.Editor (

-- * Types
  Editor
, Pos

-- * Load to Editor, Save to file, Display Editor

-- ** Load from and Save to file
, initialSaveToEditor
, saveToEditor

, saveToFile
, saveToTmpFile

-- ** Get value for Display
, isBoxCursor
, cursorPosOfDpy
, displayLines
, displayVisualLines

-- ** Get Editor state
, fileName
, cursorPos

-- ** Resize
, resizeDisplay

-- * Move cursor

-- ** Set cursor position
, cursorToXY

-- ** Move vertical
, cursorUp
, cursorDown
, cursorToTop
, cursorToLine
, cursorToLinePercent
, cursorToHead
, cursorToMiddle
, cursorToLast

-- ** Move horizontal
, cursorLeft
, cursorRight
, cursorTopOfLine
, cursorTopOfLineNotSpace
, cursorEndOfLine
, cursorFindChar
, cursorFindCharBack

-- ** Move horizontal over lines
, cursorWord
, cursorWordEnd
, cursorBackWord

, cursorSearchStr
, cursorNextSearchStr
, cursorSearchStrBack
, cursorNextSearchStrBack

, resetStrForSearch
, addStrForSearch

-- * Scroll
, scrollUp
, scrollDown
, scrollUpPage
, scrollDownPage
, scrollUpHPage
, scrollDownHPage
, scrollForCursorHead
, scrollForCursorMiddle
, scrollForCursorLast

-- * Delete

-- ** Delete vertical
, deleteUp
, deleteDown
, deleteLine
, deleteInLargeVmode

, concatTwoLines

-- ** Delete horizontal
, deleteLeft
, deleteRight
, deleteChar
, deleteCursorToEnd
, deleteCursorToBegin
, deleteFind
, deleteFindMore
, deleteFindBack

-- ** Delete horizontal over lines
, deleteWord
, deleteWordEnd
, deleteBackWord

-- * Insert
, insertString
, insertStringAfter
, insertChar
, insertNL

, flipCase

, inInsertMode
, outInsertMode

, replaceModeOn
, replaceModeOff

-- * Yank and Paste
, resetYank

, yankLines
, yankInLargeVmode

, pasteYanked
, pasteYankedAfter

-- * Abount Undo etc
, saveToHistory
, undo
, redo

, isModified
, resetModified

-- * Visual mode
, setVisualBeginY
, resetVisualmode

-- * Edit status bar
, resetStatus
, setStatus
, addStatus
, bsStatus

, resetExCmd
, addExCmd
, getExCmd
, bsExCmd

-- * Run multi times
, multi
, resetTimes
, addTimes

-- * IO Action

, resetIOAction
, setIOAction
, runIOAction

-- * Delete Editor

, needDeleteThisEditor
, deleteThisEditor

-- * Other value

, getOtherValue
, setOtherValue
, modifyOtherValue

) where

import           Yavie.EditorCore hiding
  ( runIOAction, saveToHistory, setIOAction, insertNL, insertChar,
    inInsertMode, linesForDisplay, resetYank, concatTwoLines,
    outInsertMode, pasteYanked, pasteYankedAfter, flipCase,
    undo, redo, resetStatus, setStatus, addStatus, bsStatus,
    isModified, resetModified, resizeMonitor,
    getFileName, resetIOAction,
    saveToTmpFile )
import qualified Yavie.EditorCore as C
  ( runIOAction, saveToHistory, setIOAction, insertNL, insertChar,
    inInsertMode, linesForDisplay, resetYank, concatTwoLines,
    outInsertMode, pasteYanked, pasteYankedAfter, flipCase,
    undo, redo, resetStatus, setStatus, addStatus, bsStatus,
    isModified, resetModified, resizeMonitor,
    getFileName, resetIOAction,
    saveToTmpFile )
import Yavie.Tools
import Data.List  ( elemIndices, findIndex )
import Data.Char  ( isDigit, isControl, isSpace )
import Data.Maybe ( fromMaybe )
import System.Directory

type Pos = ( Int, Int )

cursorToXY :: Int -> Int -> Editor c -> Editor c
cursorToXY cx cy = cursorToX cx . cursorToLineN cy

resetIOAction :: Editor c -> Editor c
resetIOAction = C.resetIOAction

fileName :: Editor c -> FilePath
fileName = C.getFileName

cursorPos :: Editor c -> Pos
cursorPos ed = ( getCursX ed, getCursY ed )

resizeDisplay :: Int -> Int -> Editor c -> Editor c
resizeDisplay = C.resizeMonitor

isModified :: Editor c -> Bool
isModified = C.isModified

resetModified :: Editor c -> Editor c
resetModified = C.resetModified

resetStatus, bsStatus :: Editor c -> Editor c
resetStatus = C.resetStatus; bsStatus = C.bsStatus

setStatus :: String -> Editor c -> Editor c
setStatus = C.setStatus

addStatus :: Char -> Editor c -> Editor c
addStatus = C.addStatus

undo, redo :: Editor c -> Editor c
undo = C.undo; redo = C.redo

flipCase :: Editor c -> Editor c
flipCase = C.flipCase

pasteYankedAfter :: Editor c -> Editor c
pasteYankedAfter = C.pasteYankedAfter

pasteYanked :: Editor c -> Editor c
pasteYanked = C.pasteYanked

outInsertMode :: Editor c -> Editor c
outInsertMode = C.outInsertMode

concatTwoLines :: Editor c -> Editor c
concatTwoLines = C.concatTwoLines

resetYank :: Editor c -> Editor c
resetYank = C.resetYank

inInsertMode :: Editor c -> Editor c
inInsertMode = C.inInsertMode

insertChar :: Char -> Editor c -> Editor c
insertChar = C.insertChar

insertNL :: Editor c -> Editor c
insertNL = C.insertNL

insertString, insertStringGen :: String -> Editor c -> Editor c
insertString str = insertStringGen str . saveToHistory
insertStringGen ""            = id
insertStringGen ( '\n' : cs ) = insertStringGen cs . insertNL
insertStringGen ( c    : cs ) = insertStringGen cs . cursorRight . insertChar c

insertStringAfter :: String -> Editor c -> Editor c
insertStringAfter str =
  outInsertMode . insertString str . cursorRight . inInsertMode

saveToHistory :: Editor c -> Editor c
saveToHistory = C.saveToHistory

setIOAction :: ( Editor c -> IO ( Editor c ) ) -> Editor c -> Editor c
setIOAction = C.setIOAction

runIOAction :: Editor c -> IO ( Editor c )
runIOAction = C.runIOAction

type Editor c = EditorC ( Container c )

data Container c = Container {
  cExCmd        :: String     ,
  cStrForSearch :: String     ,
  cTimes        :: Int        ,
  cVisualBeginY :: Maybe Int  ,
  cDeleteSelf   :: Bool       ,
  cReplaceMode  :: Bool       ,
  cOther        :: Maybe c
 }

initContainer :: Container c
initContainer = Container {
  cExCmd        = ""      ,
  cStrForSearch = ""      ,
  cTimes        = 0       ,
  cVisualBeginY = Nothing ,
  cDeleteSelf   = False   ,
  cReplaceMode  = False   ,
  cOther        = Nothing
 }

cursorUp    , cursorDown                          :: Editor c -> Editor c
cursorToTop , cursorToLine  , cursorToLinePercent :: Editor c -> Editor c
cursorToHead, cursorToMiddle, cursorToLast        :: Editor c -> Editor c

cursorUp            = moveToLine $ const3 (+ (-1))
cursorDown          = moveToLine $ const3 (+   1)

cursorToTop         = moveToLine $ const4      0
cursorToLine        = scrollForCursorMiddle .
                      moveToLineT ( \n -> const2 . flip addIfMinus ( n - 1 ) )
cursorToLinePercent = scrollForCursorMiddle .
                      moveToLineT ( \n -> const2 . (`div` 100) . (* n) )

cursorToHead        = moveToLineT $ \n -> const2 (+ ( intoLargerEq 1 n - 1 ))
cursorToMiddle      = moveToLine  $ const $ \mh -> const . (+ mh `div` 2)
cursorToLast        = moveToLineT $ \n _ mh -> (+ ( mh - intoLargerEq 1 n ))

cursorToLineN :: Int -> Editor c -> Editor c
cursorToLineN n = moveToLine ( \_ _ _ _ -> n )

moveToLineT :: ( Int -> Int -> Int -> Int -> Int ) -> Editor c -> Editor c
moveToLineT f ed = let n   = getTimes ed
                       ned = resetTimes ed
                    in moveToLine ( \bs mh my -> const $ f n bs mh my ) ned

cursorToX :: Int -> Editor c -> Editor c
cursorToX x = moveInlineSimple $ const2 x

cursorLeft     , cursorRight                              :: Editor c -> Editor c
cursorTopOfLine, cursorTopOfLineNotSpace, cursorEndOfLine :: Editor c -> Editor c
cursorWord     , cursorWordEnd     , cursorBackWord       :: Editor c -> Editor c
cursorFindChar , cursorFindCharBack                       :: Char -> Editor c -> Editor c

cursorLeft      = moveInlineSimple $ const (+ (-1))
cursorRight     = moveInlineSimple $ const (+   1)

cursorEndOfLine = moveInlineSimple $ const . (+ (-1)) . length
cursorTopOfLine = moveInlineSimple $ const2 0
cursorTopOfLineNotSpace =
  moveInlineSimple $
    \ln -> const $ fromMaybe ( lastIndex ln ) $ findIndex ( not . isSpace ) ln

cursorWord     = scrollForCursorIn .
                 outInsertMode .
                 moveToChar False False ( const $ not . isSpace ) .
                 moveToChar False False ( const         isSpace ) .
                 inInsertMode
cursorWordEnd  = scrollForCursorIn .
                 outInsertMode .
                 moveToChar True  False ( const         isSpace ) .
                 moveToChar True  False ( const $ not . isSpace ) .
                 inInsertMode
cursorBackWord = scrollForCursorIn .
                 outInsertMode .
                 moveToChar True  True  ( const         isSpace ) .
                 moveToChar True  True  ( const $ not . isSpace ) .
                 inInsertMode

cursorFindChar     = moveInline False False False . findChar
cursorFindCharBack = moveInline False False False . findCharBack

moveInlineSimple :: ( String -> Int -> Int ) -> Editor c -> Editor c
moveInlineSimple f =
  moveInline False False False ( \ln -> Just . f ln )

findChar, findCharMore, findCharBack :: Char -> String -> Int -> Maybe Int
findChar     ch ln cx = let nxs = filter (> cx) $ elemIndices ch ln
                         in Just $ if null nxs then cx else head nxs
findCharMore ch ln cx = let nxs = filter (> cx) $ elemIndices ch ln
                         in Just $ if null nxs then cx else head nxs + 1
findCharBack ch ln cx = let nxs = filter (< cx) $ elemIndices ch ln
                         in Just $ if null nxs then cx else last nxs

cursorNextSearchStr, cursorSearchStr         :: Editor c -> Editor c
cursorSearchStrBack, cursorNextSearchStrBack :: Editor c -> Editor c

cursorSearchStr ed         = scrollForCursorMiddleIfOut $
  moveInline False False True  ( searchStr $ getStrForSearch ed ) ed
cursorNextSearchStr ed     = scrollForCursorMiddleIfOut $
  moveInline True  False True  ( searchStr $ getStrForSearch ed ) ed

cursorSearchStrBack ed     = scrollForCursorMiddleIfOut $
  moveInline False True True  ( searchStrBack $ getStrForSearch ed ) ed
cursorNextSearchStrBack ed = scrollForCursorMiddleIfOut $
  moveInline True  True True  ( searchStrBack $ getStrForSearch ed ) ed

searchStr, searchStrBack :: String -> String -> Int -> Maybe Int
searchStr     "" _  _  = Nothing
searchStr     ss ln cx = let nxs = filter (>= cx) $ strIndices ss ln
                          in if null nxs then Nothing else Just $ head nxs
searchStrBack "" _  _  = Nothing
searchStrBack ss ln cx = let nxs = filter (<= cx) $ strIndices ss ln
                          in if null nxs then Nothing else Just $ last nxs

scrollUp           , scrollDown            :: Editor c -> Editor c
scrollUpPage       , scrollDownPage        :: Editor c -> Editor c
scrollUpHPage      , scrollDownHPage       :: Editor c -> Editor c
scrollForCursorHead, scrollForCursorMiddle :: Editor c -> Editor c
scrollForCursorLast                        :: Editor c -> Editor c
scrollForCursorMiddleIfOut                 :: Editor c -> Editor c

scrollUp                   = setMonitorY  $ const2 (+ (-1))
scrollDown                 = setMonitorY  $ const2 (+   1)
scrollUpPage               = setMonitorY  $ \mh      -> const (+ (- mh        ))
scrollDownPage             = setMonitorY  $ \mh      -> const (+    mh         )
scrollUpHPage              = setMonitorY  $ \mh      -> const (+ (- mh `div` 2))
scrollDownHPage            = setMonitorY  $ \mh      -> const (+    mh `div` 2)
scrollForCursorHead        = setMonitorYT $ \n _  cy -> cy - n  + 1
scrollForCursorMiddle      = setMonitorY  $ \mh cy   -> const $ cy - mh `div` 2
scrollForCursorLast        = setMonitorYT $ \n mh cy -> cy - mh + n
scrollForCursorMiddleIfOut = setMonitorY sfcmio
  where
  sfcmio mh cy my | cy < my || cy > my + mh - 1 = cy - mh `div` 2
                  | otherwise                   = my

setMonitorYT :: ( Int -> Int -> Int -> Int ) -> Editor c -> Editor c
setMonitorYT f ed = let n   = intoLargerEq 1 $ getTimes ed
                        ned = resetTimes ed
                     in setMonitorY ( \mh cy _ -> f n mh cy ) ned

deleteUp, deleteDown :: Editor c -> Editor c
deleteLine :: Editor c -> Editor c
deleteUp   = deleteToLineT $ const3 . flip (-)
deleteDown = deleteToLineT $ const3 . (+)
deleteLine = deleteToLineT $ const3 . (+) . flip (-) 1

deleteInLargeVmode :: Editor c -> Editor c
deleteInLargeVmode ed =
  case mvy of
       Just vy -> modifyVisualBeginY ( const Nothing ) $
                    deleteToLineT ( const5 vy ) ed
       Nothing -> error "you are not in visual V mode"
  where
  mvy = getVisualBeginY ed

deleteToLineT :: ( Int -> Int -> Int -> Int -> Int -> Int ) -> Editor c -> Editor c
deleteToLineT f ed = let t   = intoLargerEq 1 $ getTimes ed
                         ned = resetTimes ed
                      in deleteToLine ( \bs mh my cy -> f t bs mh my cy ) ned

deleteLeft, deleteRight :: Editor c -> Editor c
deleteChar              :: Editor c -> Editor c
deleteLeft  = deleteInline False False $ const $ Just . (+ (-1))
deleteRight = deleteInline False False $ const $ Just . (+   1)
deleteChar  = deleteInline False False $ const $ Just . (+   1)

deleteCursorToEnd, deleteCursorToBegin :: Editor c -> Editor c
deleteCursorToEnd    = deleteInline False False $ const . Just . length
deleteCursorToBegin  = deleteInline False False $ const $ const $ Just 0

deleteFind, deleteFindMore, deleteFindBack :: Char -> Editor c -> Editor c
deleteFind            = deleteInline False False . findChar
deleteFindMore        = deleteInline False False . findCharMore
deleteFindBack        = deleteInline False False . findCharBack

deleteWord :: Editor c -> Editor c
deleteWord = deleteToChar False False ( const $ not . isSpace ) .
             deleteToChar False False ( const isSpace )

deleteWordEnd :: Editor c -> Editor c
deleteWordEnd = deleteToChar False False ( const isSpace ) .
                deleteToChar False False ( const $ not . isSpace )

deleteBackWord :: Editor c -> Editor c
deleteBackWord = deleteToChar True  True ( const isSpace ) .
                 deleteToChar True  True ( const $ not . isSpace )

initialSaveToEditor :: Int -> Int -> FilePath -> String -> Editor c
initialSaveToEditor = saveToEditorCore initContainer

modifyCExCmd :: ( String -> String ) -> Container c -> Container c
modifyCExCmd f c@Container { cExCmd = ec } = c { cExCmd = f ec }

modifyCStrForSearch :: ( String -> String ) -> Container c -> Container c
modifyCStrForSearch f c@Container { cStrForSearch = sfs } =
  c { cStrForSearch = f sfs }

modifyCTimes :: ( Int -> Int ) -> Container c -> Container c
modifyCTimes f c@Container { cTimes = t } = c { cTimes = f t }

modifyCVisualBeginY :: ( Maybe Int -> Maybe Int ) -> Container c -> Container c
modifyCVisualBeginY f c@Container { cVisualBeginY = v } = c { cVisualBeginY = f v }

setCVisualBeginY :: Int -> Container c -> Container c
setCVisualBeginY y c = c { cVisualBeginY = Just y }

saveToTmpFile :: Editor c -> Editor c
saveToTmpFile ed  = if isModified ed
                       then setIOAction C.saveToTmpFile ed
                       else ed

saveToFile :: Editor c -> Editor c
saveToFile ed  = if isModified ed
                     then setIOAction saveToFileC ed
                     else ed

replaceModeOn, replaceModeOff :: Editor c -> Editor c
replaceModeOn  = modifyContainer $ \c -> c { cReplaceMode = True  }
replaceModeOff = modifyContainer $ \c -> c { cReplaceMode = False }

isReplaceMode :: Editor c -> Bool
isReplaceMode = getsContainer cReplaceMode

deleteThisEditor :: Editor c -> Editor c
deleteThisEditor = modifyContainer $ \c -> c { cDeleteSelf = True }

needDeleteThisEditor :: Editor c -> Bool
needDeleteThisEditor = getsContainer cDeleteSelf


saveToEditor :: FilePath -> Editor c -> Editor c
saveToEditor fn = setIOAction ( editNextFileIfNeed fn )

editNextFileIfNeed :: String -> Editor c -> IO ( Editor c )
editNextFileIfNeed fn ed =
          do e <- doesFileExist fn
             if e then do cnt <- readFile fn
                          return $ resaveToEditor fn cnt ed
                  else return $ deleteThisEditor
                              $ setStatus ( "not exist file " ++ fn ) ed

resaveToEditor :: String -> String -> Editor c -> Editor c
resaveToEditor = resaveToEditorCore

getVisualBeginYWithMonitorY :: ( Maybe Int -> Int -> a ) -> Editor c -> a
getVisualBeginYWithMonitorY = getsContainerWithMonitorY cVisualBeginY

getVisualBeginY :: Editor c -> Maybe Int
getVisualBeginY = getsContainer cVisualBeginY

modifyVisualBeginY :: ( Maybe Int -> Maybe Int ) -> Editor c -> Editor c
modifyVisualBeginY = modifyContainer . modifyCVisualBeginY

resetVisualmode :: Editor c -> Editor c
resetVisualmode = modifyVisualBeginY $ const Nothing

setVisualBeginY :: Editor c -> Editor c
setVisualBeginY = setToCursY setCVisualBeginY

resetExCmd :: Editor c -> Editor c
resetExCmd = modifyContainer $ modifyCExCmd $ const ""

addExCmd :: Char -> Editor c -> Editor c
addExCmd = modifyContainer . modifyCExCmd . flip (++) . (: [])

bsExCmd :: Editor c -> Editor c
bsExCmd = modifyContainer $ modifyCExCmd init_

init_ :: [ a ] -> [ a ]
init_ [ ] = [ ]
init_ lst = init lst

getExCmd :: Editor c -> String
getExCmd = getsContainer cExCmd

getStrForSearch :: Editor c -> String
getStrForSearch = getsContainer cStrForSearch

modifyStrForSearch :: ( String -> String ) -> Editor c -> Editor c
modifyStrForSearch = modifyContainer . modifyCStrForSearch

getTimes :: Editor c -> Int
getTimes = getsContainer cTimes

modifyTimes :: ( Int -> Int ) -> Editor c -> Editor c
modifyTimes = modifyContainer . modifyCTimes

resetTimes :: Editor c -> Editor c
resetTimes = modifyTimes $ const 0

addTimes :: Char -> Editor c -> Editor c
addTimes c
  | isDigit c = modifyTimes $ (+ read [ c ]) . (10 *)
  | otherwise = error "first argument of addTimes is digit character"

resetStrForSearch :: Editor c -> Editor c
resetStrForSearch = modifyStrForSearch $ const ""

addStrForSearch :: Char -> Editor c -> Editor c
addStrForSearch = modifyStrForSearch . flip (++) . (: [])

multi :: ( Editor c -> Editor c ) -> Editor c -> Editor c
multi f ed =
  let t = getTimes ed
   in resetTimes $ iterate f ed !! if t == 0 then 1 else t

yankInLargeVmode :: Editor c -> Editor c
yankInLargeVmode ed =
  case mvy of
       Just vy -> modifyVisualBeginY ( const Nothing ) $ yankLinesCursTo vy ed
       Nothing -> error "you are not in visual V mode"
  where
  mvy = getVisualBeginY ed

yankLines :: Editor c -> Editor c
yankLines ed
  = resetTimes $ yankLinesNum ( if t == 0 then 1 else t ) ed
    where
    t = getTimes ed

data DisplayLines = DisplayLines {
  isNotBoxCursorLFD      :: Bool,
  getCursorPosLFD        :: ( Int, Int ),
  displayLinesWithSelLFD :: [ ( Bool, String ) ]
}

isBoxCursor :: Editor c -> Bool
isBoxCursor = not . isNotBoxCursorLFD . linesForDisplay

cursorPosOfDpy :: Editor c -> Pos
cursorPosOfDpy = getCursorPosLFD . linesForDisplay

displayVisualLines :: Editor c -> [ ( Bool, String ) ]
displayVisualLines = displayLinesWithSelLFD . linesForDisplay

displayLines :: Editor c -> [ String ]
displayLines = displayLinesLFD . linesForDisplay

displayLinesLFD :: DisplayLines -> [ String ]
displayLinesLFD = map snd . displayLinesWithSelLFD

linesForDisplay :: Editor c -> DisplayLines
linesForDisplay ed = DisplayLines
  ( isInsertMode ed && not ( isReplaceMode ed ) ) ( ncx, mcy ) ( ab linesGen )
  where
  ( ( cx, mcy ), linesGen ) = C.linesForDisplay ed
  ncx                = tab2spaceN ( ctrl2str $ linesGen !! mcy ) $
                       ctrl2strN  ( linesGen !! mcy ) cx
  mvy                = getVisualBeginY ed
  vyInMonitor        = getVisualBeginYWithMonitorY ( \( Just v ) m -> v - m ) ed
  cyInMonitor        = getCursorYInMonitor ed
  ab = addBool . splitLines . map ( map processCtrlChar . tab2space . ctrl2str )
  addBool ( pre, sel, aft ) = map ((,) False) pre ++ map ((,) True) sel
                                                  ++ map ((,) False) aft
  splitLines lns =
    maybe ( lns, [], [] )
          ( \_  -> if cyInMonitor <= vyInMonitor
                     then ( take ( cyInMonitor - 1 ) lns ,
                            if cyInMonitor > 0
                               then take ( vyInMonitor + 2 - cyInMonitor ) $
                                      drop ( cyInMonitor - 1 ) lns
                               else take vyInMonitor lns ,
                            drop ( vyInMonitor + 1 ) lns )
                     else ( take vyInMonitor lns ,
                            if vyInMonitor > 0
                               then take ( cyInMonitor - vyInMonitor ) $
                                      drop vyInMonitor lns 
                               else take cyInMonitor lns ,
                            drop cyInMonitor lns ) )
          mvy
  processCtrlChar '\t' = ' '
  processCtrlChar c | isControl c = 'C' | otherwise = c

getOtherValue :: Editor c -> Maybe c
getOtherValue = getsContainer cOther

modifyCOther :: ( c -> c ) -> Container c -> Container c
modifyCOther m cnt@Container { cOther = Just co } = cnt { cOther = Just $ m co }
modifyCOther _     Container { cOther = Nothing } = error errStr
  where errStr = "modifyCOther: set value before modify"

setCOther :: c -> Container c -> Container c
setCOther v cnt = cnt { cOther = Just v }

modifyOtherValue :: ( c -> c ) -> Editor c -> Editor c
modifyOtherValue = modifyContainer . modifyCOther

setOtherValue :: c -> Editor c -> Editor c
setOtherValue = modifyContainer . setCOther