text-zipper 0.9 → 0.10
raw patch · 6 files changed
+323/−10 lines, 6 filesdep +QuickCheckdep +hspecdep +text-zipperdep ~base
Dependencies added: QuickCheck, hspec, text-zipper
Dependency ranges changed: base
Files
- CHANGELOG +8/−0
- src/Data/Text/Zipper.hs +41/−9
- src/Data/Text/Zipper/Generic/Words.hs +104/−0
- tests/Main.hs +1/−0
- tests/WordsSpec.hs +155/−0
- text-zipper.cabal +14/−1
CHANGELOG view
@@ -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 ---
src/Data/Text/Zipper.hs view
@@ -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
+ src/Data/Text/Zipper/Generic/Words.hs view
@@ -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)
+ tests/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/WordsSpec.hs view
@@ -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
text-zipper.cabal view
@@ -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