Selection.hs

module Editor.Selection where

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

getSelectionRange :: EditorState -> Maybe ((Int, Int), (Int, Int))
getSelectionRange es = getSelectionOrdered (currentCursor es) (es ^. esSelection)

getSelectionOrdered :: (Int, Int) -> Maybe (Int, Int) -> Maybe ((Int, Int), (Int, Int))
getSelectionOrdered cursor msel = normaliseSelection cursor <$> msel
  where
    normaliseSelection (r1, c1) (r2, c2)
      | r1 < r2 = ((r1, c1), (r2, c2))
      | r1 == r2 && c1 <= c2 = ((r1, c1), (r2, c2))
      | otherwise = ((r2, c2), (r1, c1 - 1))

inSelection :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> Bool
inSelection (a, b) cursor msel = case getSelectionOrdered cursor msel of
  Nothing -> False
  Just (x, y) -> inSpan (a, b) x y

deleteSelection :: EditorState -> EditorState
deleteSelection es = case getSelectionRange es of
  Nothing -> es
  Just (p, end) -> clearSelection $ es & esZipper .~ final
    where
      z = es ^. esZipper
      movedZ = Z.moveCursor p z
      charCount = totalCharsBetween movedZ end + 1
      final = iterate Z.deleteChar movedZ !! charCount

totalCharsBetween :: Z.TextZipper Text -> (Int, Int) -> Int
totalCharsBetween tz target = go 0 tz
  where
    go count currentTz
      | Z.cursorPosition currentTz == target = count
      | currentTz == Z.moveRight currentTz = count
      | otherwise = go (count + 1) (Z.moveRight currentTz)

selectedText :: EditorState -> Maybe Text
selectedText es = case getSelectionRange es of
  Nothing -> Nothing
  Just (begin, end) -> Just $ fst $ go ("", Z.moveCursor begin $ es ^. esZipper)
    where
      go (accum, z)
        | Z.cursorPosition z == end = (T.reverse (T.cons c accum), z)
        | otherwise = go (T.cons c accum, Z.moveRight z)
        where
          c = fromMaybe '\n' (Z.currentChar z)

extendSelection :: (Z.TextZipper Text -> Z.TextZipper Text) -> EditorState -> EditorState
extendSelection f es =
  let es' = withZipper f es
      cursor = currentCursor es
      next = currentCursor es'
      actual = if fst cursor > fst next || snd next < snd cursor then (fst cursor, snd cursor - 1) else cursor
      anchor = fromMaybe actual (es' ^. esSelection)
   in es' & esSelection ?~ anchor

extendSelectionUp :: EditorState -> EditorState
extendSelectionUp = extendSelection Z.moveUp

extendSelectionDown :: EditorState -> EditorState
extendSelectionDown = extendSelection Z.moveDown

extendSelectionLeft :: EditorState -> EditorState
extendSelectionLeft = extendSelection Z.moveLeft

extendSelectionRight :: EditorState -> EditorState
extendSelectionRight = extendSelection Z.moveRight

extendSelectionLineStart :: EditorState -> EditorState
extendSelectionLineStart = extendSelection Z.gotoBOL

extendSelectionLineEnd :: EditorState -> EditorState
extendSelectionLineEnd = extendSelection Z.gotoEOL

extendSelectionTo :: (Int, Int) -> EditorState -> EditorState
extendSelectionTo p = extendSelection (Z.moveCursor p)

selectAll :: EditorState -> EditorState
selectAll es =
  es
    & esZipper %~ Z.gotoEOF
    & esSelection ?~ (0, 0)