-- | 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 :: TextZipper a -> TextZipper a
moveWordLeft = Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
False TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
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 :: TextZipper a -> TextZipper a
deletePrevWord = Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
False TextZipper a -> TextZipper a
forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
deletePrevChar

doWordLeft :: TZ.GenericTextZipper a
           => Bool
           -> (TextZipper a -> TextZipper a)
           -> TextZipper a
           -> TextZipper a
doWordLeft :: Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
inWord TextZipper a -> TextZipper a
transform TextZipper a
zipper = case TextZipper a -> Maybe Char
forall a. GenericTextZipper a => TextZipper a -> Maybe Char
charToTheLeft TextZipper a
zipper of
    Maybe Char
Nothing -> TextZipper a
zipper  -- start of text
    Just Char
c
        | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inWord ->
          Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
False TextZipper a -> TextZipper a
transform (TextZipper a -> TextZipper a
transform TextZipper a
zipper)
        | Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inWord ->
          Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
True TextZipper a -> TextZipper a
transform TextZipper a
zipper -- switch to skipping letters
        | Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Bool
inWord ->
          Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordLeft Bool
True TextZipper a -> TextZipper a
transform (TextZipper a -> TextZipper a
transform TextZipper a
zipper)
        | Bool
otherwise ->
          TextZipper a
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 :: TextZipper a -> TextZipper a
moveWordRight = Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordRight Bool
False TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
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 :: TextZipper a -> TextZipper a
deleteWord = Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
forall a.
GenericTextZipper a =>
Bool
-> (TextZipper a -> TextZipper a) -> TextZipper a -> TextZipper a
doWordRight Bool
False TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
deleteChar

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

-- Helpers

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

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