Words.hs

-- | Implements word movements.
--
-- Copyright (c) Hans-Peter Deifel
module Data.Text.Zipper.Generic.Words
  ( moveWordLeft
  , moveWordRight
  , deletePrevWord
  , deleteWord
  )
where

import Data.Char

import Data.Text.Zipper
import qualified Data.Text.Zipper.Generic as TZ

-- | Move one word to the left.
--
-- A word is defined as a consecutive string not satisfying isSpace.
-- This function always leaves the cursor at the beginning of a word
-- (except at the very start of the text).
moveWordLeft :: TZ.GenericTextZipper a => TextZipper a -> TextZipper a
moveWordLeft = doWordLeft False moveLeft

-- | Delete the previous word.
--
-- Does the same as 'moveWordLeft' but deletes characters instead of
-- simply moving past them.
deletePrevWord :: (Eq a, TZ.GenericTextZipper a) => TextZipper a -> TextZipper a
deletePrevWord = doWordLeft False deletePrevChar

doWordLeft :: TZ.GenericTextZipper a
           => Bool
           -> (TextZipper a -> TextZipper a)
           -> TextZipper a
           -> TextZipper a
doWordLeft inWord transform zipper = case charToTheLeft zipper of
    Nothing -> zipper  -- start of text
    Just c
        | isSpace c && not inWord ->
          doWordLeft False transform (transform zipper)
        | not (isSpace c) && not inWord ->
          doWordLeft True transform zipper -- switch to skipping letters
        | not (isSpace c) && inWord ->
          doWordLeft True transform (transform zipper)
        | otherwise ->
          zipper -- Done

-- | Move one word to the right.
--
-- A word is defined as a consecutive string not satisfying isSpace.
-- This function always leaves the cursor at the end of a word (except
-- at the very end of the text).
moveWordRight :: TZ.GenericTextZipper a => TextZipper a -> TextZipper a
moveWordRight = doWordRight False moveRight

-- | Delete the next word.
--
-- Does the same as 'moveWordRight' but deletes characters instead of
-- simply moving past them.
deleteWord :: TZ.GenericTextZipper a => TextZipper a -> TextZipper a
deleteWord = doWordRight False deleteChar

doWordRight :: TZ.GenericTextZipper a
            => Bool
            -> (TextZipper a -> TextZipper a)
            -> TextZipper a
            -> TextZipper a
doWordRight inWord transform zipper = case charToTheRight zipper of
    Nothing -> zipper -- end of text
    Just c
        | isSpace c && not inWord ->
          doWordRight False transform (transform zipper)
        | not (isSpace c) && not inWord ->
          doWordRight True transform zipper -- switch to skipping letters
        | not (isSpace c) && inWord ->
          doWordRight True transform (transform zipper)
        | otherwise ->
          zipper -- Done

-- Helpers

charToTheLeft :: TZ.GenericTextZipper a => TextZipper a -> Maybe Char
charToTheLeft zipper = case cursorPosition zipper of
  (0, 0) -> Nothing  -- Very start of text, no char left
  (_, 0) -> Just '\n' -- Start of line, simulate newline
  (_, x) -> Just (TZ.toList (currentLine zipper) !! (x-1))

charToTheRight :: TZ.GenericTextZipper a => TextZipper a -> Maybe Char
charToTheRight zipper
  | null (getText zipper) = Nothing
  | otherwise =
    let
      (row, col) = cursorPosition zipper
      content = getText zipper
      curLine = content !! row
      numLines = length content
    in
      if row == numLines - 1 && col == (TZ.length curLine) then
        Nothing -- very end
      else if col == (TZ.length curLine) then
        Just '\n' -- simulate newline
      else
        Just (TZ.toList curLine !! col)