Line.hs

module Editor.Line where

import Data.Char
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Zipper as Z
import Editor.Core
import Editor.Undo
import Editor.Util
import Lens.Micro

replaceCurrentLine :: Text -> Z.TextZipper Text -> Z.TextZipper Text
replaceCurrentLine x z = case Z.currentLine z of
  "" -> Z.insertMany x z
  _ -> Z.killToEOL $ Z.insertMany x $ Z.killToBOL z

duplicateCurrentLine :: EditorState -> EditorState
duplicateCurrentLine = withZipper z . clearSelection . pushUndo
  where
    z x = Z.moveCursorClosest (r + 1, c) $ Z.insertMany currentText withNewline
      where
        currentText = Z.currentLine x
        (r, c) = Z.cursorPosition x
        withNewline = Z.insertChar '\n' $ Z.gotoEOL x

swapLineUp :: EditorState -> EditorState
swapLineUp = withZipper z . clearSelection . pushUndo
  where
    z x = Z.moveCursorClosest (r - 1, c) $ replaceCurrentLine replaceText $ Z.moveUp $ replaceCurrentLine upperText x
      where
        (r, c) = Z.cursorPosition x
        currentText = Z.currentLine x
        upperText = Z.currentLine (Z.moveUp x)
        replaceText
          | T.null currentText && T.null upperText = ""
          | T.null currentText = "\n"
          | otherwise = currentText

swapLineDown :: EditorState -> EditorState
swapLineDown = withZipper z . clearSelection . pushUndo
  where
    z x = Z.moveCursorClosest (r + 1, c) $ replaceCurrentLine replaceText $ Z.moveDown $ replaceCurrentLine lowerText x
      where
        (r, c) = Z.cursorPosition x
        currentText = Z.currentLine x
        lowerText = Z.currentLine (Z.moveDown x)
        replaceText
          | T.null currentText && T.null lowerText = ""
          | T.null currentText = "\n"
          | otherwise = currentText

toggleCommentCurrentLine :: Text -> EditorState -> EditorState
toggleCommentCurrentLine prefix = withZipper func
  where
    func z = case deletePrefix prefix $ moveFirstWordStart z of
      (z', True) -> Z.moveCursor (r, c - l) $ (if Just ' ' == Z.currentChar z' then Z.deleteChar else id) z'
      (z', False) -> Z.moveCursor (r, c + l) $ Z.insertMany (prefix <> " ") z'
      where
        l = T.length $ prefix <> " "
        (r, c) = Z.cursorPosition z

moveFirstWordStart :: Z.TextZipper Text -> Z.TextZipper Text
moveFirstWordStart z = go $ Z.gotoBOL z
  where
    go x = case Z.currentChar x of
      Nothing -> x
      Just c -> if isSpace c then go $ Z.moveRight x else x

deletePrefix :: Text -> Z.TextZipper Text -> (Z.TextZipper Text, Bool)
deletePrefix prefix z = T.foldl func (z, True) prefix
  where
    func (_, False) _ = (z, False)
    func (x, True) c = case Z.currentChar x of
      Nothing -> (z, False)
      (Just c') -> (if c == c' then Z.deleteChar x else z, c == c')

unindentCurrentLine :: EditorState -> EditorState
unindentCurrentLine es = withZipper z $ clearSelection $ pushUndo es
  where
    z x = Z.moveCursor (r, c - tw) dropped
      where
        dropped = dropN tw isSpace $ Z.gotoBOL x
        tw = es ^. esTabWidth
        (r, c) = Z.cursorPosition x
        dropN 0 _ zi = zi
        dropN i f zi = case Z.currentChar zi of
          Nothing -> zi
          Just cc -> if f cc then dropN (i - 1) f $ Z.deleteChar zi else zi