text-zipper-0.10.1/0000755000000000000000000000000013155072030012246 5ustar0000000000000000text-zipper-0.10.1/CHANGELOG0000644000000000000000000000343313155072030013463 0ustar0000000000000000 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) text-zipper-0.10.1/LICENSE0000644000000000000000000000277613155072030013267 0ustar0000000000000000Copyright (c) 2015, Jonathan Daugherty All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jonathan Daugherty nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. text-zipper-0.10.1/Setup.hs0000644000000000000000000000005613155072030013703 0ustar0000000000000000import Distribution.Simple main = defaultMain text-zipper-0.10.1/text-zipper.cabal0000644000000000000000000000267713155072030015541 0ustar0000000000000000name: text-zipper version: 0.10.1 synopsis: A text editor zipper library description: This library provides a zipper and API for editing text. license: BSD3 license-file: LICENSE author: Jonathan Daugherty maintainer: cygnus@foobox.com copyright: (c) 2015 Jonathan Daugherty category: Text build-type: Simple cabal-version: >=1.10 data-files: CHANGELOG homepage: https://github.com/jtdaugherty/text-zipper/ bug-reports: https://github.com/jtdaugherty/text-zipper/issues Source-Repository head type: git location: git://github.com/jtdaugherty/text-zipper.git 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, deepseq 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 text-zipper-0.10.1/src/0000755000000000000000000000000013155072030013035 5ustar0000000000000000text-zipper-0.10.1/src/Data/0000755000000000000000000000000013155072030013706 5ustar0000000000000000text-zipper-0.10.1/src/Data/Text/0000755000000000000000000000000013155072030014632 5ustar0000000000000000text-zipper-0.10.1/src/Data/Text/Zipper.hs0000644000000000000000000003727013155072030016450 0ustar0000000000000000-- |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. -- -- Implementations using 'T.Text' and 'String' are provided. module Data.Text.Zipper ( TextZipper -- *Construction and extraction , mkZipper , textZipper , stringZipper , clearZipper , vectorZipper , getText , currentLine , cursorPosition , lineLengths , getLineLimit -- *Navigation functions , moveCursor , moveRight , moveLeft , moveUp , moveDown , gotoEOL , gotoBOL -- *Inspection functions , currentChar , nextChar , previousChar -- *Editing functions , insertChar , insertMany , deletePrevChar , deleteChar , breakLine , killToEOL , killToBOL , transposeChars ) where import Control.Applicative ((<$>)) import Control.DeepSeq import Data.Char (isPrint) 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 , toRight :: a , above :: [a] , below :: [a] , fromChar :: 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] , lineLimit :: Maybe Int } instance (NFData a) => NFData (TextZipper a) where rnf z = (toLeft z) `deepseq` (toRight z) `deepseq` (above z) `deepseq` (below z) `deepseq` () -- | Get the line limit, if any, for a zipper. getLineLimit :: TextZipper a -> Maybe Int getLineLimit = lineLimit instance (Eq a) => Eq (TextZipper a) where a == b = and [ toLeft a == toLeft b , toRight a == toRight b , above a == above b , below a == below b ] instance (Show a) => Show (TextZipper a) where show tz = concat [ "TextZipper { " , "above = " , show $ above tz , ", below = " , show $ below tz , ", toLeft = " , show $ toLeft tz , ", toRight = " , show $ toRight tz , " }" ] -- |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. -> (Int -> a -> a) -- ^'drop'. -> (Int -> a -> a) -- ^'take'. -> (a -> Int) -- ^'length'. -> (a -> Char) -- ^'last'. -> (a -> a) -- ^'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 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 linesFunc toListF lmt -- |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. 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)@. -- @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. 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'. moveCursor :: (Monoid a) => (Int, Int) -> TextZipper a -> TextZipper a moveCursor (row, col) tz = let t = getText tz in if row < 0 || row >= length t || col < 0 || col > length_ tz (t !! row) then tz else tz { above = take row t , below = drop (row + 1) t , toLeft = take_ tz col (t !! row) , toRight = drop_ tz col (t !! row) } isFirstLine :: TextZipper a -> Bool isFirstLine = null . above isLastLine :: TextZipper a -> Bool isLastLine = (== 0) . length . below nextLine :: TextZipper a -> a nextLine = head . below -- |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. -- -- 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 ch tz = maybe tz id $ insertChar_ ch tz insertChar_ :: (Monoid a) => Char -> TextZipper a -> Maybe (TextZipper a) insertChar_ ch tz | ch == '\n' = breakLine_ tz | isPrint ch = Just $ tz { toLeft = toLeft tz `mappend` (fromChar tz ch) } | otherwise = Nothing -- |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 = let go [] z = z go (c:cs) z = maybe z (go cs) $ insertChar_ c z in go (toList_ tz str) tz -- |Insert a line break at the current cursor position. breakLine :: (Monoid a) => TextZipper a -> TextZipper a breakLine tz = maybe tz id $ breakLine_ tz breakLine_ :: (Monoid a) => TextZipper a -> Maybe (TextZipper a) breakLine_ tz = -- Plus two because we count the current line and the line we are -- about to create; if that number of lines exceeds the limit, -- ignore this operation. let modified = tz { above = above tz ++ [toLeft tz] , toLeft = mempty } in case lineLimit tz of Just lim -> if length (above tz) + length (below tz) + 2 > lim then Nothing else Just modified Nothing -> Just modified -- |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 -- empty, the entire line will be removed. killToEOL :: (Monoid a) => TextZipper a -> TextZipper a killToEOL tz | (null_ tz $ toLeft tz) && (null_ tz $ toRight tz) && (not $ null $ below tz) = tz { toRight = head $ below tz , below = tail $ below tz } | otherwise = tz { toRight = mempty } -- |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 -- 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, -- this combines the line with the line below. deleteChar :: (Monoid a) => TextZipper a -> TextZipper a deleteChar tz -- Can we just remove a char from the current line? | (not $ null_ tz (toRight tz)) = tz { toRight = drop_ tz 1 $ toRight tz } -- Do we need to collapse the previous line onto the current one? | null_ tz (toRight tz) && (not $ null $ below tz) = tz { toRight = head $ below tz , 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 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). moveRight :: (Monoid a) => TextZipper a -> TextZipper a moveRight tz -- Are we able to keep moving right on the current line? | not (null_ tz (toRight tz)) = tz { toLeft = toLeft tz `mappend` (take_ tz 1 $ toRight tz) , toRight = drop_ tz 1 (toRight tz) } -- If we are going to go beyond the end of the current line, can -- we move to the next one? | not $ null (below tz) = tz { above = above tz ++ [toLeft tz] , below = tail $ below tz , toLeft = mempty , toRight = nextLine tz } | 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). moveLeft :: (Monoid a) => TextZipper a -> TextZipper a moveLeft tz -- Are we able to keep moving left on the current line? | not $ null_ tz (toLeft tz) = tz { toLeft = init_ tz $ toLeft tz , toRight = fromChar tz (last_ tz (toLeft tz)) `mappend` toRight tz } -- If we are going to go beyond the beginning of the current line, -- can we move to the end of the previous one? | not $ null (above tz) = tz { above = init $ above tz , below = currentLine tz : below tz , toLeft = last $ above tz , toRight = mempty } | 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 -- row above is shorter, move to the end of that row. moveUp :: (Monoid a) => TextZipper a -> TextZipper a moveUp tz -- Is there a line above at least as long as the current one? | (not $ isFirstLine tz) && (length_ tz $ last $ above tz) >= length_ tz (toLeft tz) = tz { below = currentLine tz : below tz , above = init $ above tz , toLeft = take_ tz (length_ tz $ toLeft tz) (last $ above tz) , toRight = drop_ tz (length_ tz $ toLeft tz) (last $ above tz) } -- Or if there is a line above, just go to the end of it | (not $ isFirstLine tz) = tz { above = init $ above tz , below = currentLine tz : below tz , toLeft = last $ above tz , toRight = mempty } -- 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. moveDown :: (Monoid a) => TextZipper a -> TextZipper a moveDown tz -- Is there a line below at least as long as the current one? | (not $ isLastLine tz) && (length_ tz $ nextLine tz) >= length_ tz (toLeft tz) = tz { below = tail $ below tz , above = above tz ++ [currentLine tz] , toLeft = take_ tz (length_ tz $ toLeft tz) (nextLine tz) , toRight = drop_ tz (length_ tz $ toLeft tz) (nextLine tz) } -- Or if there is a line below, just go to the end of it | (not $ isLastLine tz) = tz { above = above tz ++ [currentLine tz] , below = tail $ below tz , toLeft = nextLine tz , toRight = mempty } -- If nothing else, go to the end of the current line | otherwise = gotoEOL tz -- | 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 lines id -- |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 V.vecLines V.toList -- |Empty a zipper. clearZipper :: (Monoid a) => TextZipper a -> TextZipper a clearZipper tz = tz { toLeft = mempty , toRight = mempty , above = [] , below = [] } -- |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 T.lines T.unpack text-zipper-0.10.1/src/Data/Text/Zipper/0000755000000000000000000000000013155072030016103 5ustar0000000000000000text-zipper-0.10.1/src/Data/Text/Zipper/Generic.hs0000644000000000000000000000313713155072030020017 0ustar0000000000000000{-# 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 text-zipper-0.10.1/src/Data/Text/Zipper/Vector.hs0000644000000000000000000000053113155072030017700 0ustar0000000000000000module 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 text-zipper-0.10.1/src/Data/Text/Zipper/Generic/0000755000000000000000000000000013155072030017457 5ustar0000000000000000text-zipper-0.10.1/src/Data/Text/Zipper/Generic/Words.hs0000644000000000000000000000670213155072030021116 0ustar0000000000000000-- | 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) text-zipper-0.10.1/tests/0000755000000000000000000000000013155072030013410 5ustar0000000000000000text-zipper-0.10.1/tests/Main.hs0000644000000000000000000000005413155072030014627 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-zipper-0.10.1/tests/WordsSpec.hs0000644000000000000000000001316313155072030015661 0ustar0000000000000000{-# 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 - 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