diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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) 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 @@ -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 diff --git a/src/Data/Text/Zipper/Generic.hs b/src/Data/Text/Zipper/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Zipper/Generic.hs @@ -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 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/src/Data/Text/Zipper/Vector.hs b/src/Data/Text/Zipper/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Zipper/Vector.hs @@ -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 + 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,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 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.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