Cursor.hs

module Editor.Cursor where

import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text.Zipper as Z
import Editor.Core
import Editor.Util

moveCursorPos :: (Int, Int) -> EditorState -> EditorState
moveCursorPos p = withZipper (Z.moveCursorClosest p) . clearSelection

moveCursorUp :: EditorState -> EditorState
moveCursorUp = withZipper Z.moveUp . clearSelection

moveCursorDown :: EditorState -> EditorState
moveCursorDown = withZipper Z.moveDown . clearSelection

moveCursorLeft :: EditorState -> EditorState
moveCursorLeft = withZipper Z.moveLeft . clearSelection

moveCursorRight :: EditorState -> EditorState
moveCursorRight = withZipper Z.moveRight . clearSelection

moveCursorLineStart :: EditorState -> EditorState
moveCursorLineStart = withZipper Z.gotoBOL . clearSelection

moveCursorLineEnd :: EditorState -> EditorState
moveCursorLineEnd = withZipper Z.gotoEOL . clearSelection

moveCursorFileStart :: EditorState -> EditorState
moveCursorFileStart = withZipper Z.gotoBOF . clearSelection

moveCursorFileEnd :: EditorState -> EditorState
moveCursorFileEnd = withZipper Z.gotoEOF . clearSelection

moveCursorWordLeft :: EditorState -> EditorState
moveCursorWordLeft = withZipper moveWordStartLeft

moveCursorWordRight :: EditorState -> EditorState
moveCursorWordRight = withZipper moveWordStartRight

moveWordStartLeft :: Z.TextZipper Text -> Z.TextZipper Text
moveWordStartLeft tz = findWordStart (findWordLeft $ Z.moveLeft tz)
  where
    findWordLeft x = case Z.currentChar x of
      Nothing -> x
      Just c ->
        if isSpace c
          then
            let next = Z.moveLeft x
             in if Z.cursorPosition next == Z.cursorPosition x
                  then x
                  else findWordLeft next
          else x

    findWordStart x =
      let prev = Z.moveLeft x
       in if Z.cursorPosition prev == Z.cursorPosition x
            then x
            else case Z.currentChar prev of
              Nothing -> x
              Just c ->
                if not (isSpace c)
                  then findWordStart prev
                  else x

moveWordStartRight :: Z.TextZipper Text -> Z.TextZipper Text
moveWordStartRight tz = findWordStart (findWordRight $ Z.moveRight tz)
  where
    findWordRight x = case Z.currentChar x of
      Nothing ->
        let next = Z.moveRight x
         in if Z.cursorPosition next == Z.cursorPosition x
              then x
              else findWordRight next
      Just c ->
        if isSpace c
          then
            let next = Z.moveRight x
             in if Z.cursorPosition next == Z.cursorPosition x
                  then x
                  else findWordRight next
          else x

    findWordStart x =
      let prev = Z.moveRight x
       in if Z.cursorPosition prev == Z.cursorPosition x
            then x
            else case Z.currentChar prev of
              Nothing -> x
              Just c ->
                if not (isSpace c)
                  then findWordStart prev
                  else x