text-zipper-0.13/0000755000000000000000000000000007346545000012121 5ustar0000000000000000text-zipper-0.13/CHANGELOG.md0000644000000000000000000000433007346545000013732 0ustar0000000000000000 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) text-zipper-0.13/LICENSE0000644000000000000000000000277607346545000013142 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.13/Setup.hs0000644000000000000000000000005607346545000013556 0ustar0000000000000000import Distribution.Simple main = defaultMain text-zipper-0.13/src/Data/Text/0000755000000000000000000000000007346545000014505 5ustar0000000000000000text-zipper-0.13/src/Data/Text/Zipper.hs0000644000000000000000000004323407346545000016320 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 , 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 , 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) 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. 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) } -- | 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 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 | ch == '\n' = breakLine tz | isPrint ch = tz { toLeft = toLeft tz `mappend` (fromChar tz ch) } | otherwise = tz -- | 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 -- 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 tz else modified Nothing -> 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 } -- | 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 | (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 } -- | 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, -- 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 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? | 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.13/src/Data/Text/Zipper/0000755000000000000000000000000007346545000015756 5ustar0000000000000000text-zipper-0.13/src/Data/Text/Zipper/Generic.hs0000644000000000000000000000313707346545000017672 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.13/src/Data/Text/Zipper/Generic/0000755000000000000000000000000007346545000017332 5ustar0000000000000000text-zipper-0.13/src/Data/Text/Zipper/Generic/Words.hs0000644000000000000000000000670207346545000020771 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.13/src/Data/Text/Zipper/Vector.hs0000644000000000000000000000053107346545000017553 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.13/tests/0000755000000000000000000000000007346545000013263 5ustar0000000000000000text-zipper-0.13/tests/Main.hs0000644000000000000000000000005407346545000014502 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-zipper-0.13/tests/WordsSpec.hs0000644000000000000000000001443307346545000015535 0ustar0000000000000000{-# 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-0.13/text-zipper.cabal0000644000000000000000000000270007346545000015377 0ustar0000000000000000name: text-zipper version: 0.13 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.md 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