text-zipper-0.8.1/0000755000000000000000000000000012771254174012213 5ustar0000000000000000text-zipper-0.8.1/CHANGELOG0000644000000000000000000000212512771254174013425 0ustar00000000000000000.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.8.1/LICENSE0000644000000000000000000000277612771254174013234 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.8.1/Setup.hs0000644000000000000000000000005612771254174013650 0ustar0000000000000000import Distribution.Simple main = defaultMain text-zipper-0.8.1/text-zipper.cabal0000644000000000000000000000206512771254174015475 0ustar0000000000000000name: text-zipper version: 0.8.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 other-modules: Data.Text.Zipper.Vector build-depends: base < 5, text, vector, deepseq ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010 text-zipper-0.8.1/src/0000755000000000000000000000000012771254174013002 5ustar0000000000000000text-zipper-0.8.1/src/Data/0000755000000000000000000000000012771254174013653 5ustar0000000000000000text-zipper-0.8.1/src/Data/Text/0000755000000000000000000000000012771254174014577 5ustar0000000000000000text-zipper-0.8.1/src/Data/Text/Zipper.hs0000644000000000000000000003501512771254174016410 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 and editing functions , moveCursor , insertChar , insertMany , breakLine , killToEOL , killToBOL , gotoEOL , gotoBOL , deletePrevChar , deleteChar , moveRight , moveLeft , moveUp , moveDown , transposeChars ) where import Control.Applicative ((<$>)) import Control.DeepSeq 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] , 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] -- ^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 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 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. 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) } -- |Insert many characters at the current cursor position. Move the -- cursor one position to the end of the inserted text. insertMany :: (Monoid a) => a -> TextZipper a -> TextZipper a insertMany cs tz = let ls = lines_ tz cs in case lineLimit tz of Nothing -> tz { toLeft = toLeft tz `mappend` cs } Just limit -> -- How many more lines can we add without violating the -- limit? let toInsert = take remainingLines ls remainingLines = max 0 (limit - totalLines) totalLines = length (above tz) + length (below tz) go [] z = z go (a:as) z = go as $ breakLine $ z { toLeft = toLeft z `mappend` a } in go toInsert tz -- |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 } -- |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 -- |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 -- |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 -- |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 text-zipper-0.8.1/src/Data/Text/Zipper/0000755000000000000000000000000012771254174016050 5ustar0000000000000000text-zipper-0.8.1/src/Data/Text/Zipper/Generic.hs0000644000000000000000000000277612771254174017774 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] 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 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 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 textZipper :: GenericTextZipper a => [a] -> Maybe Int -> TextZipper a textZipper = mkZipper singleton drop take length last init null lines text-zipper-0.8.1/src/Data/Text/Zipper/Vector.hs0000644000000000000000000000053112771254174017645 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