diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +0.10 +---- + +- Integrated word editing and navigation functions + courtesy of Hans-Peter Deifel's hledger-iadd project (see + Data.Text.Zipper.Generic.Words) +- Added currentChar, nextChar, and previousChar (thanks @kRITZCREEK) + 0.9 --- diff --git a/src/Data/Text/Zipper.hs b/src/Data/Text/Zipper.hs --- a/src/Data/Text/Zipper.hs +++ b/src/Data/Text/Zipper.hs @@ -25,21 +25,28 @@ , lineLengths , getLineLimit - -- *Navigation and editing functions + -- *Navigation functions , moveCursor + , moveRight + , moveLeft + , moveUp + , moveDown + , gotoEOL + , gotoBOL + + -- *Inspection functions + , currentChar + , nextChar + , previousChar + + -- *Editing functions , insertChar , insertMany + , deletePrevChar + , deleteChar , breakLine , killToEOL , killToBOL - , gotoEOL - , gotoBOL - , deletePrevChar - , deleteChar - , moveRight - , moveLeft - , moveUp - , moveDown , transposeChars ) where @@ -278,6 +285,31 @@ , below = tail $ below tz } | otherwise = tz + +-- |Get the Char on which the cursor currently resides. If the cursor is +-- at the end of the text or the text is empty return @Nothing@. +currentChar :: TextZipper a -> Maybe Char +currentChar tz + | not (null_ tz (toRight tz)) = + Just (last_ tz (take_ tz 1 (toRight tz))) + | otherwise = Nothing + +-- |Get the Char after the cursor position. If the cursor is at the end +-- of a line return the first character of the next line, or if that one +-- is empty as well, return @Nothing@. +nextChar :: (Monoid a) => TextZipper a -> Maybe Char +nextChar tz = currentChar (moveRight tz) + +-- |Get the Char before the cursor position. If the cursor is at the +-- beginning of the text, return @Nothing@ +previousChar :: (Monoid a) => TextZipper a -> Maybe Char +previousChar tz + -- Only return Nothing if we are at the beginning of a line and only empty + -- lines are above + | snd (cursorPosition tz) == 0 && all (null_ tz) (above tz) = + Nothing + | otherwise = + currentChar (moveLeft tz) -- |Move the cursor to the beginning of the current line. gotoBOL :: (Monoid a) => TextZipper a -> TextZipper a diff --git a/src/Data/Text/Zipper/Generic/Words.hs b/src/Data/Text/Zipper/Generic/Words.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Zipper/Generic/Words.hs @@ -0,0 +1,104 @@ +-- | 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) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tests/WordsSpec.hs b/tests/WordsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/WordsSpec.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module WordsSpec (spec) where + +-- This test suite is Copyright (c) Hans-Peter Deifel + +import Test.Hspec +import Test.QuickCheck + +import Data.Char + +import Data.Text.Zipper +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Zipper.Generic.Words + +spec :: Spec +spec = do + moveWordLeftSpec + moveWordRightSpec + deletePrevWordSpec + deleteWordSpec + +moveWordLeftSpec :: Spec +moveWordLeftSpec = describe "moveWordLeft" $ do + it "does nothing at the start of the text" $ + moveWordLeft (zipLoc ["foo bar"] (0, 0)) `isAt` (0, 0) + + it "moves from middle of the word to the start" $ + moveWordLeft (zipLoc ["foo barfoo"] (0, 7)) `isAt` (0, 4) + + it "moves from end to beginning" $ + moveWordLeft (zipLoc ["barfoo"] (0, 6)) `isAt` (0, 0) + + it "stops at beginning of line if word boundary" $ + moveWordLeft (zipLoc ["foo", "bar"] (1, 2)) `isAt` (1, 0) + + it "moves across lines from beginning of line" $ + moveWordLeft (zipLoc ["foo", "bar"] (1, 0)) `isAt` (0, 0) + + it "skips multiple space characters" $ + moveWordLeft (zipLoc ["foo bar"] (0, 6)) `isAt` (0, 0) + + it "skips multiple space characters across lines" $ + moveWordLeft (zipLoc ["foo ", " bar"] (1, 1)) `isAt` (0, 0) + + it "always lands on the start of a word" $ property $ \(textlist :: [Text]) cursor -> + isAtWordStart (moveWordLeft (zipLoc textlist cursor)) + +moveWordRightSpec :: Spec +moveWordRightSpec = describe "moveWordRight" $ do + it "does nothing at the end of the text" $ + moveWordRight (zipLoc ["foo bar"] (0, 7)) `isAt` (0, 7) + + it "moves from middle of the word to its end" $ + moveWordRight (zipLoc ["barfoo foo"] (0, 2)) `isAt`(0, 6) + + it "moves from beginning to end" $ + moveWordRight (zipLoc ["barfoo"] (0, 0)) `isAt` (0, 6) + + it "stops at end of line if word boundary" $ + moveWordRight (zipLoc ["foo", "bar"] (0, 1)) `isAt` (0, 3) + + it "moves across lines from end of line" $ + moveWordRight (zipLoc ["foo", "bar"] (0, 3)) `isAt` (1, 3) + + it "skips multiple space characters" $ + moveWordRight (zipLoc ["foo bar"] (0, 4)) `isAt` (0, 10) + + it "skips multiple space characters across lines" $ + moveWordRight (zipLoc ["foo ", " bar"] (0, 4)) `isAt` (1, 5) + + it "always lands at the end of a word" $ property $ \(textlist :: [Text]) cursor -> + isAtWordEnd (moveWordRight (zipLoc textlist cursor)) + +deletePrevWordSpec :: Spec +deletePrevWordSpec = describe "deletePrevWord" $ do + it "does the same cursor movement as moveWordLeft" $ property $ \(textlist :: [Text]) cursor -> + let zip = zipLoc textlist cursor + in deletePrevWord zip `isAt` (cursorPosition (moveWordLeft zip)) + + it "has the same prefix than moveWordLeft" $ property $ \textlist cursor -> + let zip = zipLoc textlist cursor + in deleteToEnd (deletePrevWord zip) === deleteToEnd (moveWordLeft zip) + + it "has the same suffix than before" $ property $ \textlist cursor -> + let zip = zipLoc textlist cursor + in deleteToBeginning (deletePrevWord zip) === deleteToBeginning zip + +deleteWordSpec :: Spec +deleteWordSpec = describe "deleteWord" $ do + it "does no cursor movement" $ property $ \textlist cursor -> + let zip = zipLoc textlist cursor + in deleteWord zip `isAt` cursorPosition zip + + it "has the same prefix than before" $ property $ \textlist cursor -> + let zip = zipLoc textlist cursor + in deleteToEnd (deleteWord zip) === deleteToEnd zip + + it "has the same suffix than moveWordRight" $ property $ \textlist cursor -> + let zip = zipLoc textlist cursor + in deleteToBeginning (deleteWord zip) === deleteToBeginning (moveWordRight zip) + +-- Helpers + +-- | Creates a zipper with initial content and cursor location +zipLoc :: [Text] -> (Int, Int) -> TextZipper Text +zipLoc content location = moveCursor location $ textZipper content Nothing + +-- | Set the expectation that the given zipper is at the given cursor +-- location +isAt :: TextZipper a -> (Int, Int) -> Expectation +isAt zipper loc = cursorPosition zipper `shouldBe` loc + +isAtWordEnd :: TextZipper Text -> Property +isAtWordEnd zipper = counterexample (show zipper) $ + let + (row, col) = cursorPosition zipper + numLines = length (getText zipper) + curLine = currentLine zipper + in + (col == T.length curLine && row == numLines) + || ((col == T.length curLine || isSpace (T.index curLine col)) -- next is space + && (col == 0 || not (isSpace (T.index curLine (col-1))))) -- previous is word + +isAtWordStart :: TextZipper Text -> Property +isAtWordStart zipper = counterexample (show zipper) $ + let + (row, col) = cursorPosition zipper + curLine = currentLine zipper + in + (row == 0 && col == 0) + || ((col == 0 || isSpace (T.index curLine (col-1))) -- previous is space + && (col == T.length curLine || not (isSpace (T.index curLine col)))) -- next is word + +-- | Delete to the very end of a zipper +deleteToEnd :: TextZipper Text -> TextZipper Text +deleteToEnd zipper = + let + (row, _) = cursorPosition zipper + numLines = length (getText zipper) + in + if row == numLines-1 then + killToEOL zipper + else + deleteToEnd (deleteChar (killToEOL zipper)) + +deleteToBeginning :: TextZipper Text -> TextZipper Text +deleteToBeginning zipper = case cursorPosition zipper of + (0, _) -> killToBOL zipper + _ -> deleteToBeginning (deletePrevChar (killToBOL zipper)) + +instance Arbitrary Text where + arbitrary = T.pack <$> arbitrary diff --git a/text-zipper.cabal b/text-zipper.cabal --- a/text-zipper.cabal +++ b/text-zipper.cabal @@ -1,5 +1,5 @@ name: text-zipper -version: 0.9 +version: 0.10 synopsis: A text editor zipper library description: This library provides a zipper and API for editing text. license: BSD3 @@ -22,6 +22,7 @@ exposed-modules: Data.Text.Zipper Data.Text.Zipper.Generic + Data.Text.Zipper.Generic.Words other-modules: Data.Text.Zipper.Vector @@ -33,3 +34,15 @@ ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010 + +test-suite text-zipper-tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + other-modules: WordsSpec + default-language: Haskell2010 + build-depends: base, + text, + hspec, + QuickCheck, + text-zipper