packages feed

zwirn-0.2.3.1: app/zwirnmill/Editor/Insertion.hs

module Editor.Insertion where

import Brick.Widgets.Edit (decodeUtf8)
import qualified Data.ByteString as B
import Data.Char (isSpace)
import qualified Data.Text as T
import qualified Data.Text.Zipper as Z
import Editor.Core
import Editor.Selection
import Editor.Undo (pushUndo)
import Editor.Util
import Lens.Micro

insertChar :: Char -> EditorState -> EditorState
insertChar '\t' es = withZipper (Z.insertMany $ T.replicate tw " ") (deleteSelection $ pushUndo es)
  where
    tw = es ^. esTabWidth
insertChar '[' es = case getSelectionRange es of
  Nothing -> withZipper (\z -> if maybe True (== ' ') $ Z.currentChar z then Z.moveLeft $ Z.insertMany "[]" z else Z.insertChar '[' z) (deleteSelection $ pushUndo es)
  Just (star, (er, ec)) -> withZipper (Z.moveCursorClosest (currentCursor es) . Z.insertChar ']' . Z.moveCursorClosest (er, ec + 2) . Z.insertChar '[' . Z.moveCursorClosest star) (pushUndo es)
insertChar '(' es = case getSelectionRange es of
  Nothing -> withZipper (\z -> if maybe True (== ' ') $ Z.currentChar z then Z.moveLeft $ Z.insertMany "()" z else Z.insertChar '(' z) (deleteSelection $ pushUndo es)
  Just (star, (er, ec)) -> withZipper (Z.moveCursorClosest (currentCursor es) . Z.insertChar ')' . Z.moveCursorClosest (er, ec + 2) . Z.insertChar '(' . Z.moveCursorClosest star) (pushUndo es)
insertChar '"' es = case getSelectionRange es of
  Nothing -> withZipper (\z -> if maybe True (== ' ') $ Z.currentChar z then Z.moveLeft $ Z.insertMany "\"\"" z else Z.insertChar '"' z) (deleteSelection $ pushUndo es)
  Just (star, (er, ec)) -> withZipper (Z.moveCursorClosest (currentCursor es) . Z.insertChar '"' . Z.moveCursorClosest (er, ec + 2) . Z.insertChar '"' . Z.moveCursorClosest star) (pushUndo es)
insertChar ch es = withZipper (Z.insertChar ch) (deleteSelection $ pushUndo es)

insertNewline :: EditorState -> EditorState
insertNewline = withZipper z . deleteSelection . pushUndo
  where
    z x = Z.insertMany (T.replicate l " ") $ Z.breakLine x
      where
        cur = Z.currentLine x
        l = T.length $ T.takeWhile isSpace cur

deleteCharForward :: EditorState -> EditorState
deleteCharForward es
  | hasSelection es = deleteSelection $ pushUndo es
  | otherwise = withZipper Z.deleteChar $ pushUndo es

deleteCharBack :: EditorState -> EditorState
deleteCharBack es
  | hasSelection es = deleteSelection $ pushUndo es
  | Z.currentChar (es ^. esZipper) == Just ']' && Z.currentChar (Z.moveLeft $ es ^. esZipper) == Just '[' = withZipper (Z.deletePrevChar . Z.deleteChar) $ pushUndo es
  | Z.currentChar (es ^. esZipper) == Just ')' && Z.currentChar (Z.moveLeft $ es ^. esZipper) == Just '(' = withZipper (Z.deletePrevChar . Z.deleteChar) $ pushUndo es
  | Z.currentChar (es ^. esZipper) == Just '"' && Z.currentChar (Z.moveLeft $ es ^. esZipper) == Just '"' = withZipper (Z.deletePrevChar . Z.deleteChar) $ pushUndo es
  | otherwise = withZipper Z.deletePrevChar $ pushUndo es

deleteCurrentLine :: EditorState -> EditorState
deleteCurrentLine = withZipper (Z.killToBOL . Z.killToEOL) . deleteSelection . pushUndo

pasteContent :: B.ByteString -> EditorState -> EditorState
pasteContent cont es = case decodeUtf8 cont of
  Left _ -> es
  Right decoded -> withZipper (Z.insertMany decoded) $ deleteSelection $ pushUndo es