text-zipper (empty) → 0.1
raw patch · 4 files changed
+364/−0 lines, 4 filesdep +basedep +textsetup-changed
Dependencies added: base, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Data/Text/Zipper.hs +311/−0
- text-zipper.cabal +21/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Text/Zipper.hs view
@@ -0,0 +1,311 @@+-- |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.+--+-- A default implementation using 'T.Text' is provided.+module Data.Text.Zipper+ ( TextZipper++ -- *Construction and extraction+ , mkZipper+ , textZipper+ , stringZipper+ , getText+ , currentLine+ , cursorPosition+ , lineLengths++ -- *Navigation and editing functions+ , moveCursor+ , insertChar+ , breakLine+ , killToEOL+ , gotoEOL+ , gotoBOL+ , deletePrevChar+ , deleteChar+ , moveRight+ , moveLeft+ , moveUp+ , moveDown+ )+where++import Control.Applicative ((<$>))+import Data.Monoid+import qualified Data.Text as T++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+ }++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]+ -- ^The initial lines of text.+ -> TextZipper a+mkZipper fromCh drp tk lngth lst int nl ls =+ let (first, rest) = if null ls+ then (mempty, mempty)+ else (head ls, tail ls)+ in TZ mempty first [] rest fromCh drp tk lngth lst int nl++-- |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)+ }++lastLine :: TextZipper a -> Bool+lastLine = (== 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 ch tz = tz { toLeft = toLeft tz `mappend` (fromChar tz ch) }++-- |Insert a line break at the current cursor position.+breakLine :: (Monoid a) => TextZipper a -> TextZipper a+breakLine tz =+ tz { above = above tz ++ [toLeft tz]+ , toLeft = mempty+ }++-- |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+ }++-- |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 $ null (above 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 $ null (above 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 $ lastLine 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 $ null (below 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++-- |Construct a zipper from list values.+stringZipper :: [String] -> TextZipper String+stringZipper =+ mkZipper (:[]) drop take length last init null++-- |Construct a zipper from 'T.Text' values.+textZipper :: [T.Text] -> TextZipper T.Text+textZipper =+ mkZipper T.singleton T.drop T.take T.length T.last T.init T.null
+ text-zipper.cabal view
@@ -0,0 +1,21 @@+name: text-zipper+version: 0.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++library+ exposed-modules:+ Data.Text.Zipper++ build-depends: base < 5,+ text+ hs-source-dirs: src+ default-language: Haskell2010