text-zipper 0.5 → 0.13
raw patch · 8 files changed
Files
- CHANGELOG.md +132/−0
- src/Data/Text/Zipper.hs +210/−62
- src/Data/Text/Zipper/Generic.hs +65/−0
- src/Data/Text/Zipper/Generic/Words.hs +104/−0
- src/Data/Text/Zipper/Vector.hs +14/−0
- tests/Main.hs +1/−0
- tests/WordsSpec.hs +177/−0
- text-zipper.cabal +21/−1
+ CHANGELOG.md view
@@ -0,0 +1,132 @@++0.13+----++Bug fixes:+ * The zipper constructors now ignores non-printable characters (see+ also #13)+ * `insertMany` now no longer drops the input following a non-printable+ character (#13)++0.12+----++API changes:+ * Added `moveCursorClosest` to allow cursor placement as near as+ possible to a specified location.++0.11+----++API changes:+ * Added `gotoBOF`, `gotoEOF`, `killToBOF`, and `killToEOF` functions+ (thanks Itai Y. Efrat)++0.10.1+------++ * WordSpec: fix a test verification bug (fixed #11)+ * WordSpec: generation of random text should never include newlines++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+---++- insertChar and insertMany now only insert printable characters and+ newlines (subject to text zipper line limits)+- The GenericTextZipper class now requires a new method,+ toList :: a -> [Char]++0.8.3+-----++- Fixed insertMany accidental addition of trailing newline++0.8.2+-----++- Fixed insertMany for zippers with no line limit++0.8.1+-----++- Added Github links and CHANGELOG to package++0.8+---++- Added 'transposeChars' function++0.7.1+-----++- Generic: import everything from Monoid for older GHCs++0.7+---++- API changes: Add Generic module to abstract over text container types++0.6.1+-----++- Make insertMany respect the zipper's line limit++0.6+---++- Add insertMany for faster bulk insertion++0.5+---++- Added killToBOL function (thanks Hans-Peter Deifel)+- Enabled -Wall+- Added dependency on deepseq+- Added NFData instance for TextZipper++0.4+---++- Added clearZipper+- Added isFirstLine (thanks Kwang Yul Seo)+- Renamed lastLine to isLastLine (thanks Kwang Yul Seo)++0.3.1+-----++- Fixed export of vectorZipper++0.3+---++- Added vectorZipper for zipping over vectors of characters++0.2.1+-----++- Exported getLineLimit to permit obtaining a zipper's line limit++0.2+---++- Added support for limiting the number of lines in the zipper+- insertChar "\n" is now equivalent to breakLine+- Improved Show instance for TextZipper++0.1.1+-----++- Updated package metadata++0.1+---++Initial release (originally split off from vty-ui)
src/Data/Text/Zipper.hs view
@@ -1,19 +1,19 @@--- |This module provides a two-dimensional text zipper data structure.+-- | This module provides a two-dimensional text zipper data structure. -- This structure represents a body of text and an editing cursor -- which can be moved throughout the text, along with a set of editing -- transformations. ----- Text zippers are generalized over the set of data types that might--- be used to store lists of characters (e.g., 'String', 'T.Text',--- etc.). As a result, the most general way to create a text zipper--- is to use 'mkZipper' and provide all of the functions required to--- manipulate the underlying text data.+-- Text zippers are generalized over the set of data types that might be+-- used to store lists of characters (e.g., 'String', 'T.Text', etc.).+-- As a result, the most general way to create a text zipper is to use+-- 'mkZipper' and provide all of the functions required to manipulate+-- the underlying text data. -- -- Implementations using 'T.Text' and 'String' are provided. module Data.Text.Zipper ( TextZipper - -- *Construction and extraction+ -- * Construction and extraction , mkZipper , textZipper , stringZipper@@ -25,28 +25,45 @@ , lineLengths , getLineLimit - -- *Navigation and editing functions+ -- * Navigation functions , moveCursor- , insertChar- , breakLine- , killToEOL- , killToBOL- , gotoEOL- , gotoBOL- , deletePrevChar- , deleteChar+ , moveCursorClosest , moveRight , moveLeft , moveUp , moveDown+ , gotoEOL+ , gotoBOL+ , gotoEOF+ , gotoBOF++ -- * Inspection functions+ , currentChar+ , nextChar+ , previousChar++ -- * Editing functions+ , insertChar+ , insertMany+ , deletePrevChar+ , deleteChar+ , breakLine+ , killToEOL+ , killToBOL+ , killToEOF+ , killToBOF+ , transposeChars ) where import Control.Applicative ((<$>)) import Control.DeepSeq+import Data.Char (isPrint)+import Data.List (foldl') import Data.Monoid import qualified Data.Text as T import qualified Data.Vector as V+import qualified Data.Text.Zipper.Vector as V data TextZipper a = TZ { toLeft :: a@@ -60,6 +77,8 @@ , last_ :: a -> Char , init_ :: a -> a , null_ :: a -> Bool+ , lines_ :: a -> [a]+ , toList_ :: a -> [Char] , lineLimit :: Maybe Int } @@ -94,9 +113,9 @@ , " }" ] --- |Create a zipper using a custom text storage type. Takes the--- initial text as well as all of the functions necessary to--- manipulate the underlying text values.+-- | Create a zipper using a custom text storage type. Takes the initial+-- text as well as all of the functions necessary to manipulate the+-- underlying text values. mkZipper :: (Monoid a) => (Char -> a) -- ^A singleton constructor.@@ -112,45 +131,51 @@ -- ^'init'. -> (a -> Bool) -- ^'null'.+ -> (a -> [a])+ -- ^'lines'.+ -> (a -> [Char])+ -- ^'toList'. -> [a] -- ^The initial lines of text. -> Maybe Int -- ^Limit to this many lines of text ('Nothing' means no limit). -> TextZipper a-mkZipper fromCh drp tk lngth lst int nl ls lmt =+mkZipper fromCh drp tk lngth lst int nl linesFunc toListF ls lmt = let limitedLs = case lmt of Nothing -> ls Just n -> take n ls (first, rest) = if null limitedLs then (mempty, mempty) else (head limitedLs, tail limitedLs)- in TZ mempty first [] rest fromCh drp tk lngth lst int nl lmt+ numLines = length ls+ insertLine z (i, l) = (if i < numLines - 1 then breakLine else id) $ insertMany l z+ loadInitial z = foldl' insertLine z $ zip [0..] (first:rest)+ in loadInitial $ TZ mempty mempty mempty mempty fromCh drp tk lngth lst int nl linesFunc toListF lmt --- |Get the text contents of the zipper.+-- | Get the text contents of the zipper. getText :: (Monoid a) => TextZipper a -> [a] getText tz = concat [ above tz , [currentLine tz] , below tz ] --- |Return the lengths of the lines in the zipper.+-- | Return the lengths of the lines in the zipper. lineLengths :: (Monoid a) => TextZipper a -> [Int] lineLengths tz = (length_ tz) <$> concat [ above tz , [currentLine tz] , below tz ] --- |Get the cursor position of the zipper; returns @(row, col)@.+-- | Get the cursor position of the zipper; returns @(row, col)@. -- @row@ ranges from @[0..num_rows-1]@ inclusive; @col@ ranges from--- @[0..length of current line]@ inclusive. Column values equal to--- line width indicate a cursor that is just past the end of a line of--- text.+-- @[0..length of current line]@ inclusive. Column values equal to line+-- width indicate a cursor that is just past the end of a line of text. cursorPosition :: TextZipper a -> (Int, Int) cursorPosition tz = (length $ above tz, length_ tz $ toLeft tz) --- |Move the cursor to the specified row and column. Invalid cursor--- positions will be ignored. Valid cursor positions range as--- described for 'cursorPosition'.+-- | Move the cursor to the specified row and column. Invalid cursor+-- positions will be ignored. Valid cursor positions range as described+-- for 'cursorPosition'. moveCursor :: (Monoid a) => (Int, Int) -> TextZipper a -> TextZipper a moveCursor (row, col) tz = let t = getText tz@@ -165,6 +190,22 @@ , toRight = drop_ tz col (t !! row) } +-- | Move the cursor to the specified row and column. Invalid cursor+-- positions will be reinterpreted as the closest valid position. Valid+-- cursor positions range as described for 'cursorPosition'.+moveCursorClosest :: (Monoid a) => (Int, Int) -> TextZipper a -> TextZipper a+moveCursorClosest (row, col) tz =+ let t = getText tz+ bestRow = min (max 0 $ length t - 1) $ max 0 row+ bestCol = if bestRow < length t+ then min (length_ tz (t !! bestRow)) $ max 0 col+ else 0+ in tz { above = take bestRow t+ , below = drop (bestRow + 1) t+ , toLeft = take_ tz bestCol (t !! bestRow)+ , toRight = drop_ tz bestCol (t !! bestRow)+ }+ isFirstLine :: TextZipper a -> Bool isFirstLine = null . above @@ -174,17 +215,30 @@ nextLine :: TextZipper a -> a nextLine = head . below --- |The line of text on which the zipper's cursor currently resides.+-- | The line of text on which the zipper's cursor currently resides. currentLine :: (Monoid a) => TextZipper a -> a currentLine tz = (toLeft tz) `mappend` (toRight tz) --- |Insert a character at the current cursor position. Move the--- cursor one position to the right.+-- | Insert a character at the current cursor position.+--+-- If the character is a newline, break the current line.+--+-- If the character is non-printable, ignore it.+--+-- Otherwise insert the character and move the cursor one position to+-- the right. insertChar :: (Monoid a) => Char -> TextZipper a -> TextZipper a-insertChar '\n' tz = breakLine tz-insertChar ch tz = tz { toLeft = toLeft tz `mappend` (fromChar tz ch) }+insertChar ch tz+ | ch == '\n' = breakLine tz+ | isPrint ch = tz { toLeft = toLeft tz `mappend` (fromChar tz ch) }+ | otherwise = tz --- |Insert a line break at the current cursor position.+-- | Insert many characters at the current cursor position. Move the+-- cursor to the end of the inserted text.+insertMany :: (Monoid a) => a -> TextZipper a -> TextZipper a+insertMany str tz = foldl' (flip insertChar) tz $ toList_ tz str++-- | Insert a line break at the current cursor position. breakLine :: (Monoid a) => TextZipper a -> TextZipper a breakLine tz = -- Plus two because we count the current line and the line we are@@ -198,14 +252,29 @@ then tz else modified Nothing -> modified--- |Move the cursor to the end of the current line.++-- | Move the cursor to the end of the current line. gotoEOL :: (Monoid a) => TextZipper a -> TextZipper a gotoEOL tz = tz { toLeft = currentLine tz , toRight = mempty } --- |Remove all text from the cursor position to the end of the current--- line. If the cursor is at the beginning of a line and the line is+-- | Move the cursor to the end of a text zipper.+gotoEOF :: (Monoid a) => TextZipper a -> TextZipper a+gotoEOF tz =+ tz { toLeft = end+ , toRight = mempty+ , above = top+ , below = mempty+ }+ where+ tx = getText tz+ (top, end) = if null tx+ then (mempty, mempty)+ else (init tx, last tx)++-- | Remove all text from the cursor position to the end of the current+-- line. If the cursor is at the beginning of a line and the line is -- empty, the entire line will be removed. killToEOL :: (Monoid a) => TextZipper a -> TextZipper a killToEOL tz@@ -217,21 +286,38 @@ | otherwise = tz { toRight = mempty } --- |Remove all text from the cursor position to the beginning of the+-- | Remove all text from the cursor position to the beginning of the -- current line. killToBOL :: Monoid a => TextZipper a -> TextZipper a killToBOL tz = tz { toLeft = mempty } --- |Delete the character preceding the cursor position, and move the+-- | Remove all text from the cursor position to the end of the text+-- zipper. If the cursor is at the beginning of a line and the line is+-- empty, the entire line will be removed.+killToEOF :: (Monoid a) => TextZipper a -> TextZipper a+killToEOF tz =+ tz { toRight = mempty+ , below = mempty+ }++-- | Remove all text from the cursor position to the beginning of the+-- text zipper.+killToBOF :: Monoid a => TextZipper a -> TextZipper a+killToBOF tz =+ tz { toLeft = mempty+ , above = mempty+ }++-- | Delete the character preceding the cursor position, and move the -- cursor backwards by one character. deletePrevChar :: (Eq a, Monoid a) => TextZipper a -> TextZipper a deletePrevChar tz | moveLeft tz == tz = tz | otherwise = deleteChar $ moveLeft tz --- |Delete the character at the cursor position. Leaves the cursor--- position unchanged. If the cursor is at the end of a line of text,+-- | Delete the character at the cursor position. Leaves the cursor+-- position unchanged. If the cursor is at the end of a line of text, -- this combines the line with the line below. deleteChar :: (Monoid a) => TextZipper a -> TextZipper a deleteChar tz@@ -246,15 +332,54 @@ } | otherwise = tz --- |Move the cursor to the beginning of the current line.+-- | 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 gotoBOL tz = tz { toLeft = mempty , toRight = currentLine tz } --- |Move the cursor right by one position. If the cursor is at the--- end of a line, the cursor is moved to the first position of the--- following line (if any).+-- | Move the cursor to the beginning of a text zipper.+gotoBOF :: (Monoid a) => TextZipper a -> TextZipper a+gotoBOF tz =+ tz { toLeft = mempty+ , toRight = first+ , above = mempty+ , below = rest+ }+ where+ tx = getText tz+ (first, rest) = if null tx+ then (mempty, mempty)+ else (head tx, tail tx)++-- | Move the cursor right by one position. If the cursor is at the end+-- of a line, the cursor is moved to the first position of the following+-- line (if any). moveRight :: (Monoid a) => TextZipper a -> TextZipper a moveRight tz -- Are we able to keep moving right on the current line?@@ -273,9 +398,9 @@ } | otherwise = tz --- |Move the cursor left by one position. If the cursor is at the--- beginning of a line, the cursor is moved to the last position of--- the preceding line (if any).+-- | Move the cursor left by one position. If the cursor is at the+-- beginning of a line, the cursor is moved to the last position of the+-- preceding line (if any). moveLeft :: (Monoid a) => TextZipper a -> TextZipper a moveLeft tz -- Are we able to keep moving left on the current line?@@ -294,8 +419,8 @@ } | otherwise = tz --- |Move the cursor up by one row. If there no are rows above the--- current one, move to the first position of the current row. If the+-- | Move the cursor up by one row. If there no are rows above the+-- current one, move to the first position of the current row. If the -- row above is shorter, move to the end of that row. moveUp :: (Monoid a) => TextZipper a -> TextZipper a moveUp tz@@ -317,9 +442,9 @@ -- If nothing else, go to the beginning of the current line | otherwise = gotoBOL tz --- |Move the cursor down by one row. If there are no rows below the--- current one, move to the last position of the current row. If the--- row below is shorter, move to the end of that row.+-- | Move the cursor down by one row. If there are no rows below the+-- current one, move to the last position of the current row. If the row+-- below is shorter, move to the end of that row. moveDown :: (Monoid a) => TextZipper a -> TextZipper a moveDown tz -- Is there a line below at least as long as the current one?@@ -340,17 +465,40 @@ -- If nothing else, go to the end of the current line | otherwise = gotoEOL tz --- |Construct a zipper from list values.+-- | Transpose the character before the cursor with the one at the+-- cursor position and move the cursor one position to the right. If+-- the cursor is at the end of the current line, transpose the current+-- line's last two characters.+transposeChars :: (Monoid a) => TextZipper a -> TextZipper a+transposeChars tz+ | null_ tz (toLeft tz) = tz+ | null_ tz (toRight tz) =+ if length_ tz (toLeft tz) < 2+ then tz+ else let prefixLen = length_ tz (toLeft tz) - 2+ prefix = take_ tz prefixLen (toLeft tz)+ lastTwo = drop_ tz prefixLen (toLeft tz)+ a = take_ tz 1 lastTwo+ b = drop_ tz 1 lastTwo+ in tz { toLeft = prefix <> b <> a+ }+ | otherwise = tz { toLeft = (init_ tz $ toLeft tz) <>+ (take_ tz 1 $ toRight tz) <>+ (fromChar tz $ last_ tz $ toLeft tz)+ , toRight = (drop_ tz 1 $ toRight tz)+ }++-- | Construct a zipper from list values. stringZipper :: [String] -> Maybe Int -> TextZipper String stringZipper =- mkZipper (:[]) drop take length last init null+ mkZipper (:[]) drop take length last init null lines id --- |Construct a zipper from vectors of characters.+-- | Construct a zipper from vectors of characters. vectorZipper :: [V.Vector Char] -> Maybe Int -> TextZipper (V.Vector Char) vectorZipper =- mkZipper V.singleton V.drop V.take V.length V.last V.init V.null+ mkZipper V.singleton V.drop V.take V.length V.last V.init V.null V.vecLines V.toList --- |Empty a zipper.+-- | Empty a zipper. clearZipper :: (Monoid a) => TextZipper a -> TextZipper a clearZipper tz = tz { toLeft = mempty@@ -359,7 +507,7 @@ , below = [] } --- |Construct a zipper from 'T.Text' values.+-- | Construct a zipper from 'T.Text' values. textZipper :: [T.Text] -> Maybe Int -> TextZipper T.Text textZipper =- mkZipper T.singleton T.drop T.take T.length T.last T.init T.null+ mkZipper T.singleton T.drop T.take T.length T.last T.init T.null T.lines T.unpack
+ src/Data/Text/Zipper/Generic.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleInstances #-}+module Data.Text.Zipper.Generic+ ( GenericTextZipper(..)+ , Data.Text.Zipper.Generic.textZipper+ )+where++import qualified Prelude+import Prelude hiding (drop, take, length, last, init, null, lines)+import qualified Data.Text as T+import qualified Data.Text.Zipper.Vector as V+import qualified Data.Vector as V++import Data.Monoid++import Data.Text.Zipper++class Monoid a => GenericTextZipper a where+ singleton :: Char -> a+ drop :: Int -> a -> a+ take :: Int -> a -> a+ length :: a -> Int+ last :: a -> Char+ init :: a -> a+ null :: a -> Bool+ lines :: a -> [a]+ toList :: a -> [Char]++instance GenericTextZipper [Char] where+ singleton = (:[])+ drop = Prelude.drop+ take = Prelude.take+ length = Prelude.length+ last = Prelude.last+ init = Prelude.init+ null = Prelude.null+ lines = Prelude.lines+ toList = id++instance GenericTextZipper T.Text where+ singleton = T.singleton+ drop = T.drop+ take = T.take+ length = T.length+ last = T.last+ init = T.init+ null = T.null+ lines = T.lines+ toList = T.unpack++instance GenericTextZipper (V.Vector Char) where+ singleton = V.singleton+ drop = V.drop+ take = V.take+ length = V.length+ last = V.last+ init = V.init+ null = V.null+ lines = V.vecLines+ toList = V.toList++textZipper :: GenericTextZipper a =>+ [a] -> Maybe Int -> TextZipper a+textZipper =+ mkZipper singleton drop take length last init null lines toList
+ 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)
+ src/Data/Text/Zipper/Vector.hs view
@@ -0,0 +1,14 @@+module Data.Text.Zipper.Vector+ ( vecLines+ )+where++import qualified Data.Vector as V++vecLines :: V.Vector Char -> [V.Vector Char]+vecLines v | V.null v = []+ | otherwise = case V.elemIndex '\n' v of+ Nothing -> [v]+ Just i -> let (h, t) = V.splitAt i v+ in h : vecLines t+
+ tests/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/WordsSpec.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module WordsSpec (spec) where++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+ constructorSpec+ insertCharSpec+ insertManySpec+ moveWordLeftSpec+ moveWordRightSpec+ deletePrevWordSpec+ deleteWordSpec++constructorSpec :: Spec+constructorSpec = describe "constructor" $ do+ it "inserts only printable characters at construction time" $+ (stringZipper ["abc\x1b def"] Nothing) `shouldBe` (stringZipper ["abc def"] Nothing)++insertCharSpec :: Spec+insertCharSpec = describe "insertChar" $ do+ it "ignores an insert of a non-printable character" $+ let z = stringZipper [] Nothing+ in (insertChar '\x1b' z) `shouldBe` z++insertManySpec :: Spec+insertManySpec = describe "insertMany" $ do+ it "ignores an insert of a non-printable character" $+ let z = stringZipper ["abc"] Nothing+ in (insertMany "ghi\x1bjkl" z) `shouldBe` (insertMany "ghijkl" z)++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 - 1)+ || ((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 = do+ ls <- lines <$> arbitrary+ return $ T.pack $ case ls of+ (l:_) -> l+ _ -> mempty
text-zipper.cabal view
@@ -1,5 +1,5 @@ name: text-zipper-version: 0.5+version: 0.13 synopsis: A text editor zipper library description: This library provides a zipper and API for editing text. license: BSD3@@ -10,6 +10,9 @@ category: Text build-type: Simple cabal-version: >=1.10+data-files: CHANGELOG.md+homepage: https://github.com/jtdaugherty/text-zipper/+bug-reports: https://github.com/jtdaugherty/text-zipper/issues Source-Repository head type: git@@ -18,7 +21,12 @@ library exposed-modules: Data.Text.Zipper+ Data.Text.Zipper.Generic+ Data.Text.Zipper.Generic.Words + other-modules:+ Data.Text.Zipper.Vector+ build-depends: base < 5, text, vector,@@ -26,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