packages feed

text-rope-zipper (empty) → 0.1.0.0

raw patch · 11 files changed

+863/−0 lines, 11 filesdep +QuickCheckdep +basedep +hspec

Dependencies added: QuickCheck, base, hspec, text, text-rope, text-rope-zipper

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for text-rope-zipper++## 0.1.0.0  -- 2024-01-15++* First version.
+ LICENCE.md view
@@ -0,0 +1,13 @@+Copyright 2024 ners <ners@gmx.ch>++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++  http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ README.md view
@@ -0,0 +1,5 @@+# text-rope-zipper++A [zipper] for `text-rope`, allowing efficient Unicode text traversals in 2D.++[zipper]: https://wiki.haskell.org/Zipper
+ src/Data/Text/Lazy/Zipper.hs view
@@ -0,0 +1,158 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}++-- TODO: explicit export list for Data.Text.Lazy.Zipper+module Data.Text.Lazy.Zipper where++import Data.Int (Int64)+import Data.String (IsString (fromString))+import Data.Text.Lazy (Text)+import Data.Text.Lazy qualified as Text+import GHC.Generics (Generic)+import Util+import Prelude++type Position = Word++data TextZipper = TextZipper+    { beforeCursor :: !Text+    -- ^ The text appearing before the cursor+    , afterCursor :: !Text+    -- ^ The text appearing after the cursor+    , cursor :: !Position+    -- ^ The cursor's position in the line of text, i.e. the length of 'beforeCursor'+    }+    deriving stock (Generic, Eq, Show)++-- | Modify the cursor position, updating the 'TextZipper' according to the+-- change.+moveCursor :: (Position -> Position) -> TextZipper -> TextZipper+moveCursor f t = case compare newCursor t.cursor of+    GT ->+        let (before, after)+                | absDelta > fromIntegral @Int64 maxBound = (t.afterCursor, "")+                | otherwise = Text.splitAt (fromIntegral absDelta) t.afterCursor+         in TextZipper+                { beforeCursor = t.beforeCursor <> before+                , afterCursor = after+                , cursor = t.cursor + fromIntegral (Text.length before)+                }+    LT ->+        let (before, after)+                | absDelta > fromIntegral @Int64 maxBound = ("", t.beforeCursor)+                | otherwise = splitAtEnd (fromIntegral absDelta) t.beforeCursor+         in TextZipper+                { beforeCursor = before+                , afterCursor = after <> t.afterCursor+                , cursor = t.cursor - fromIntegral (Text.length after)+                }+    EQ -> t+  where+    newCursor = f t.cursor+    absDelta+        | newCursor > t.cursor = newCursor - t.cursor+        | otherwise = t.cursor - newCursor+    splitAtEnd len t = (Text.dropEnd len t, Text.takeEnd len t)++-- | Set the position of the Cursor to a specific value. The state of the TextZipper+-- will be updated to match the new position.+setCursor :: Position -> TextZipper -> TextZipper+setCursor i = moveCursor $ const i++instance Monoid TextZipper where+    mempty = TextZipper{beforeCursor = mempty, afterCursor = mempty, cursor = 0}++instance Semigroup TextZipper where+    a <> b = a{afterCursor = a.afterCursor <> toText b}++-- | Whether the 'TextZipper' has a trailing newline. A trailing newline is+-- present if the last character of the line is a '\\n' character.+hasTrailingNewline :: TextZipper -> Bool+hasTrailingNewline TextZipper{..} = has afterCursor || Text.null afterCursor && has beforeCursor+  where+    has (Text.unsnoc -> Just (_, '\n')) = True+    has _ = False++-- | Helper function to remove the last character of the provided text iff it is+-- a trailing newline.+removeTrailingNewline :: Text -> Text+removeTrailingNewline (Text.unsnoc -> Just (t, '\n')) = t+removeTrailingNewline t = t++-- | Whether the provided 'TextZipper' is empty.+null :: TextZipper -> Bool+null TextZipper{..} = Text.null beforeCursor && Text.null afterCursor++-- | The length of the entire 'TextZipper' structure.+length :: TextZipper -> Int64+length TextZipper{..} = Text.length beforeCursor + Text.length afterCursor++-- | Convert a 'TextZipper' to 'Text'. Effectively 'beforeCursor <> afterCursor', but slightly more efficient in edge cases.+toText :: TextZipper -> Text+toText TextZipper{..}+    | Text.null afterCursor = beforeCursor+    | otherwise = beforeCursor <> afterCursor++-- | Create a 'TextZipper' from a 'Text' source, with the cursor at the end of it.+fromText :: Text -> TextZipper+fromText = flip fromParts mempty++instance IsString TextZipper where+    fromString = fromText . fromString++-- | Create a 'TextZipper' from a 'Text' source, with the cursor at the specified position.+fromTextAt :: Text -> Position -> TextZipper+fromTextAt t (max 0 -> fromIntegral -> i) = uncurry fromParts $ Text.splitAt i t++-- | Create a 'TextZipper' by concatenating two 'Text' components, with the cursor between them.+fromParts :: Text -> Text -> TextZipper+fromParts beforeCursor afterCursor =+    TextZipper+        { cursor = fromIntegral $ Text.length beforeCursor+        , ..+        }++-- | Insert 'Text' before the current Cursor position, updating its position+-- according to the provided 'Text'\'s length.+insert :: Text -> TextZipper -> TextZipper+insert t TextZipper{..} =+    TextZipper+        { beforeCursor = beforeCursor <> t+        , cursor = cursor + fromIntegral (Text.length t)+        , ..+        }++splitBefore :: TextZipper -> (TextZipper, Maybe Char)+splitBefore t@TextZipper{..} =+    case Text.unsnoc beforeCursor of+        Nothing -> (t, Nothing)+        Just (beforeCursor, c) -> (TextZipper{cursor = cursor - 1, ..}, Just c)++splitAfter :: TextZipper -> (TextZipper, Maybe Char)+splitAfter t@TextZipper{..} =+    case Text.uncons afterCursor of+        Nothing -> (t, Nothing)+        Just (c, afterCursor) -> (TextZipper{..}, Just c)++-- | Delete the first character before the cursor, if any.+deleteBefore :: TextZipper -> TextZipper+deleteBefore = fst . splitBefore++-- | Delete the first character after the cursor, if any.+deleteAfter :: TextZipper -> TextZipper+deleteAfter = fst . splitAfter++-- | Decrement the cursor.+moveBackward :: TextZipper -> TextZipper+moveBackward = moveCursor boundedPred++-- | Increment the cursor.+moveForward :: TextZipper -> TextZipper+moveForward = moveCursor boundedSucc++-- | Move the cursor to the beginning of the text.+moveStart :: TextZipper -> TextZipper+moveStart = setCursor minBound++-- | Move the cursor to the end of the text.+moveEnd :: TextZipper -> TextZipper+moveEnd = setCursor maxBound
+ src/Data/Text/Rope/Zipper.hs view
@@ -0,0 +1,305 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}++module Data.Text.Rope.Zipper+    ( RopeZipper (..)+    , Position (..)+    , null+    , cursor+    , moveCursor+    , setCursor+    , lines+    , lengthInLines+    , toRope+    , toText+    , fromParts+    , fromRope+    , fromText+    , splitFirstLine+    , splitLastLine+    , insertRope+    , insertText+    , insertChar+    , deleteBefore+    , deleteAfter+    , moveForward+    , moveBackward+    , moveUp+    , moveDown+    , moveToLineStart+    , moveToLineEnd+    , moveToFirstLine+    , moveToLastLine+    )+where++import Data.Ord (clamp)+import Data.String (IsString (fromString))+import Data.Text (Text)+import Data.Text qualified as Strict+import Data.Text.Lazy qualified as Lazy+import Data.Text.Lazy.Zipper (TextZipper (TextZipper))+import Data.Text.Lazy.Zipper qualified as TextZipper+import Data.Text.Rope (Position (..), Rope)+import Data.Text.Rope qualified as Rope+import GHC.Generics (Generic)+import GHC.Records qualified as GHC+import Util+import Prelude hiding (lines, null)++-- | A RopeZipper is similar in concept to a 'TextZipper', but tracks the+-- lines before the cursor, lines after the cursor, and the current line of the+-- cursor (as a 'TextZipper'). In essence, it is a 2D extension of 'TextZipper'.+data RopeZipper = RopeZipper+    { linesBefore :: !Rope+    -- ^ The lines before the cursor+    , currentLine :: !TextZipper+    -- ^ The line the cursor is on+    , linesAfter :: !Rope+    -- ^ The lines after the cursor+    , stickyCol :: !TextZipper.Position+    -- ^ The last requested cursor column. This is used to remember the+    -- column when moving between ends of lines of different lengths.+    }+    deriving stock (Generic, Eq, Show)++instance Monoid RopeZipper where+    mempty :: RopeZipper+    mempty =+        RopeZipper+            { linesBefore = mempty+            , currentLine = mempty+            , linesAfter = mempty+            , stickyCol = 0+            }++-- | '(<>)' appends the content of the second zipper after the first; the cursor+-- of the first is preserved while the cursor of the second is ignored.+instance Semigroup RopeZipper where+    (<>) :: RopeZipper -> RopeZipper -> RopeZipper+    a <> b | not (Rope.null a.linesAfter) = a{linesAfter = a.linesAfter <> toRope b}+    RopeZipper{..} <> b =+        let+            (firstLine, linesAfter) = splitFirstLine $ toRope b+         in+            RopeZipper+                { currentLine = currentLine <> TextZipper.fromText firstLine+                , ..+                }++-- | Whether the whole 'RopeZipper' structure is empty.+null :: RopeZipper -> Bool+null RopeZipper{..} = Rope.null linesBefore && TextZipper.null currentLine && Rope.null linesAfter++-- | Get the current cursor position of the 'RopeZipper'.+cursor :: RopeZipper -> Position+cursor RopeZipper{..} =+    Position+        { posLine = (Rope.lengthAsPosition linesBefore).posLine+        , posColumn = currentLine.cursor+        }++instance GHC.HasField "cursor" RopeZipper Position where+    getField = cursor++-- | Move the cursor relative to its current position.+moveCursor :: (Position -> Position) -> RopeZipper -> RopeZipper+moveCursor f r+    -- for a positive change where the current line has a trailing newline OR+    -- there are lines after the current line+    | (newY > oldY)+        && (TextZipper.hasTrailingNewline r.currentLine || not (Rope.null r.linesAfter)) =+        let (before, currentLine, linesAfter) = splitAtLine (absDy - 1) r.linesAfter+         in RopeZipper+                { linesBefore = r.linesBefore <> currentLineAsRope <> before+                , stickyCol = withStickyCol $ min currentLine.cursor+                , ..+                }+    -- for a negative change that puts the line of the cursor at the start+    | newY < oldY && newY == 0 =+        let ( flip TextZipper.fromTextAt (if absDx /= 0 then newX else r.stickyCol) ->+                    moveBackFromNewline -> currentLine+                , linesAfter+                ) = splitFirstLine $ r.linesBefore <> currentLineAsRope <> r.linesAfter+         in RopeZipper+                { linesBefore = mempty+                , currentLine+                , stickyCol = withStickyCol $ min currentLine.cursor+                , ..+                }+    -- for a negative change that doesn't put the line of the cursor at the start+    | newY < oldY && not (Rope.null r.linesBefore) =+        let (linesBefore, currentLine, after) =+                splitAtLine+                    ((Rope.lengthAsPosition r.linesBefore).posLine - absDy)+                    r.linesBefore+         in RopeZipper+                { linesAfter = after <> currentLineAsRope <> r.linesAfter+                , stickyCol = withStickyCol $ min currentLine.cursor+                , ..+                }+    -- in any other circumstance, just move the cursor within the line and reset+    -- the current cursor pos+    | otherwise =+        let currentLine = moveBackFromNewline $ TextZipper.setCursor newX r.currentLine+         in r+                { currentLine+                , stickyCol =+                    if (r.stickyCol > currentLine.cursor && absDx > 0)+                        || (absDy /= 0 && absDx == 0)+                        then r.stickyCol+                        else currentLine.cursor+                }+  where+    Position{posLine = oldY, posColumn = oldX} = r.cursor+    Position{posLine = newY, posColumn = newX} = f r.cursor+    absDy = absDelta newY oldY+    absDx = absDelta newX oldX+    withStickyCol f = if absDx == 0 then r.stickyCol else f newX++    currentLineAsRope = Rope.fromText . Lazy.toStrict . TextZipper.toText $ r.currentLine+    splitAtLine :: Word -> Rope -> (Rope, TextZipper, Rope)+    splitAtLine n rope =+        let (before, after) = Rope.splitAtLine (clamp (0, (Rope.lengthAsPosition rope).posLine) n) rope+            (current, after') = splitFirstLine after+            stickyCol = if absDx /= 0 then newX else r.stickyCol+         in (before, moveBackFromNewline $ TextZipper.fromTextAt current stickyCol, after')++-- | Move the cursor to the given absolute position.+setCursor :: Position -> RopeZipper -> RopeZipper+setCursor c = moveCursor (const c)++lines :: RopeZipper -> [Text]+lines = Rope.lines . toRope++lengthInLines :: RopeZipper -> Word+lengthInLines r@RopeZipper{..} = before + current + after+  where+    before = posLine . cursor $ r+    current = if TextZipper.null currentLine then 0 else 1+    after = Rope.lengthInLines linesAfter++toRope :: RopeZipper -> Rope+toRope RopeZipper{..} =+    mconcat+        [ linesBefore+        , Rope.fromText $ Lazy.toStrict $ TextZipper.toText currentLine+        , linesAfter+        ]++toText :: RopeZipper -> Text+toText = Rope.toText . toRope++fromParts :: Rope -> Rope -> RopeZipper+fromParts r1 r2 = RopeZipper{..}+  where+    (linesBefore, beforeCursor) = splitLastLine r1+    (afterCursor, linesAfter) = splitFirstLine r2+    currentLine = TextZipper.fromParts beforeCursor afterCursor+    stickyCol = currentLine.cursor++fromRope :: Rope -> RopeZipper+fromRope = flip fromParts mempty++fromText :: Text -> RopeZipper+fromText = fromRope . Rope.fromText++instance IsString RopeZipper where+    fromString = fromText . fromString++splitFirstLine :: Rope -> (Lazy.Text, Rope)+splitFirstLine r = (Lazy.fromStrict $ Rope.toText firstLine, linesAfter)+  where+    (firstLine, linesAfter) = Rope.splitAtLine 1 r++splitLastLine :: Rope -> (Rope, Lazy.Text)+splitLastLine r = (linesBefore, Lazy.fromStrict $ Rope.toText lastLine)+  where+    (linesBefore, lastLine) = Rope.splitAtLine (Rope.lengthAsPosition r).posLine r++split2ndLastLine :: Rope -> (Rope, Lazy.Text)+split2ndLastLine r+    | numLines < 1 = ("", Lazy.fromStrict $ Rope.toText r)+    | otherwise = (linesBefore, Lazy.fromStrict $ Rope.toText lastLine)+  where+    numLines = (Rope.lengthAsPosition r).posLine+    (linesBefore, lastLine) = Rope.splitAtLine (numLines - 1) r++insertRope :: Rope -> RopeZipper -> RopeZipper+insertRope rope@(Rope.lengthAsPosition -> Rope.Position{posLine = 0}) r =+    r{currentLine, stickyCol = currentLine.cursor}+  where+    currentLine = TextZipper.insert (Lazy.fromStrict $ Rope.toText rope) r.currentLine+insertRope (fromRope -> t) r =+    r{linesBefore, currentLine, stickyCol = currentLine.cursor}+  where+    linesBefore =+        r.linesBefore+            <> Rope.fromText (Lazy.toStrict r.currentLine.beforeCursor)+            <> t.linesBefore+    currentLine = t.currentLine <> TextZipper.fromText r.currentLine.afterCursor++insertText :: Text -> RopeZipper -> RopeZipper+insertText = insertRope . Rope.fromText++insertChar :: Char -> RopeZipper -> RopeZipper+insertChar = insertText . Strict.singleton++deleteBefore :: RopeZipper -> RopeZipper+deleteBefore r@RopeZipper{currentLine = TextZipper{beforeCursor = Lazy.null -> False}} =+    r{currentLine, stickyCol = currentLine.cursor}+  where+    currentLine = TextZipper.deleteBefore r.currentLine+deleteBefore r = RopeZipper{linesAfter = r.linesAfter, ..}+  where+    (linesBefore, TextZipper.removeTrailingNewline -> beforeCursor) = split2ndLastLine r.linesBefore+    currentLine = TextZipper.fromParts beforeCursor r.currentLine.afterCursor+    stickyCol = currentLine.cursor++deleteAfter :: RopeZipper -> RopeZipper+deleteAfter r@RopeZipper{currentLine = TextZipper{afterCursor = "\n"}} = RopeZipper{..}+  where+    linesBefore = r.linesBefore+    (afterCursor, linesAfter) = splitFirstLine r.linesAfter+    currentLine = TextZipper.fromParts r.currentLine.beforeCursor afterCursor+    stickyCol = currentLine.cursor+deleteAfter RopeZipper{..} = RopeZipper{currentLine = TextZipper.deleteAfter currentLine, ..}++-- | Move the cursor to the previous character of the current row, if there is one. Does not change lines.+moveBackward :: RopeZipper -> RopeZipper+moveBackward = moveCursor $ \c -> c{posColumn = boundedPred c.posColumn}++-- | Move the cursor to the next character of the current line, if there is one. Does not change lines.+moveForward :: RopeZipper -> RopeZipper+moveForward = moveCursor $ \c -> c{posColumn = boundedSucc c.posColumn}++-- | Move the cursor to the previous line, trying to preserve the column.+moveUp :: RopeZipper -> RopeZipper+moveUp = moveCursor $ \c -> c{posLine = boundedPred c.posLine}++-- | Move the cursor to the next line, trying to preserve the column.+moveDown :: RopeZipper -> RopeZipper+moveDown = moveCursor $ \c -> c{posLine = boundedSucc c.posLine}++-- | Move the cursor to the start of the current line.+moveToLineStart :: RopeZipper -> RopeZipper+moveToLineStart = moveCursor $ \c -> c{posColumn = minBound}++-- | Move the cursor to the end of the current line.+moveToLineEnd :: RopeZipper -> RopeZipper+moveToLineEnd = moveCursor $ \c -> c{posColumn = maxBound}++-- | Move the cursor to the first line, trying to preserve the column.+moveToFirstLine :: RopeZipper -> RopeZipper+moveToFirstLine = moveCursor $ \c -> c{posLine = minBound}++-- | Move the cursor to the last line, trying to preserve the column.+moveToLastLine :: RopeZipper -> RopeZipper+moveToLastLine = moveCursor $ \c -> c{posLine = maxBound}++-- If the cursor is after the final character and the final character is a newline,+-- move backwards once.+moveBackFromNewline :: TextZipper -> TextZipper+moveBackFromNewline t+    | TextZipper.hasTrailingNewline t && Lazy.null t.afterCursor =+        TextZipper.moveBackward t+    | otherwise = t
+ src/Util.hs view
@@ -0,0 +1,22 @@+module Util where++import Data.Ord (clamp)+import Prelude++boundedSucc :: (Eq a, Bounded a, Enum a) => a -> a+boundedSucc e+    | e == maxBound = e+    | otherwise = succ e++boundedPred :: (Eq a, Bounded a, Enum a) => a -> a+boundedPred e+    | e == minBound = e+    | otherwise = pred e++boundedAdd :: Int -> Word -> Word+boundedAdd delta = fromIntegral . clamp @Int (0, maxBound) . (+ delta) . fromIntegral++absDelta :: (Num a, Ord a) => a -> a -> a+absDelta a b+    | a > b = a - b+    | otherwise = b - a
+ test/Data/Text/Lazy/ZipperSpec.hs view
@@ -0,0 +1,67 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Data.Text.Lazy.ZipperSpec where++import Data.Text.Lazy qualified as Text+import Data.Text.Lazy.Zipper+import Data.Text.Lazy.Zipper qualified as Zipper+import Util++data Move = Backward | Forward | Start | End | Rel !Int | Abs !Position+    deriving stock (Eq, Show)++instance Arbitrary Move where+    arbitrary =+        oneof+            [ pure Backward+            , pure Forward+            , pure Start+            , pure End+            , Rel <$> arbitrary+            , Abs <$> arbitrary+            ]++moveZipper :: Move -> TextZipper -> TextZipper+moveZipper Forward = moveForward+moveZipper Backward = moveBackward+moveZipper Start = moveStart+moveZipper End = moveEnd+moveZipper (Rel i) = moveCursor $ boundedAdd i+moveZipper (Abs i) = setCursor i++spec :: Spec+spec = parallel $ modifyMaxSuccess (* 100) do+    it "fromText is a right inverse of toText" $ property $ \t -> do+        let zipper = fromText t+        toText zipper `shouldBe` t+        Zipper.length zipper `shouldBe` Text.length t++    it "concatenates" $ property $ \t1 t2 -> do+        fromText t1 <> fromText t2 `shouldBe` fromParts t1 t2++    it "inserts" $ property $ \t1 t2 t3 ->+        insert t2 (fromParts t1 t3) `shouldBe` fromParts (t1 <> t2) t3++    it "deletes before" $ property $ \t1 (Text.singleton -> c) t2 ->+        deleteBefore (fromParts (t1 <> c) t2) `shouldBe` fromParts t1 t2++    it "deletes after" $ property $ \t1 (Text.singleton -> c) t2 ->+        deleteAfter (fromParts t1 (c <> t2)) `shouldBe` fromParts t1 t2++    it "moves" $ property $ \t1 t2 move -> do+        let zipper = fromParts t1 t2+        let zipperLength = fromIntegral . Zipper.length $ zipper+        zipper.cursor `shouldBe` fromIntegral (Text.length t1)+        zipper.cursor `shouldBe` fromIntegral (Text.length zipper.beforeCursor)+        let moveCursor' =+                clamp (0, zipperLength) . case move of+                    Backward -> boundedAdd (-1)+                    Forward -> boundedAdd 1+                    Start -> const minBound+                    End -> const maxBound+                    Rel i -> boundedAdd i+                    Abs i -> const i+        let zipper' = moveZipper move zipper+        zipper'.cursor `shouldBe` moveCursor' zipper.cursor+        zipper'.cursor `shouldBe` fromIntegral (Text.length zipper'.beforeCursor)+        toText zipper `shouldBe` toText zipper'
+ test/Data/Text/Rope/ZipperSpec.hs view
@@ -0,0 +1,148 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Data.Text.Rope.ZipperSpec where++import Data.Text qualified as Text+import Data.Text.Lazy.Zipper qualified as TextZipper+import Data.Text.Rope qualified as Rope+import Data.Text.Rope.Zipper+import Data.Text.Rope.Zipper qualified as RopeZipper+import Util++rawOutput :: (HasCallStack) => Property -> IO ()+rawOutput =+    quickCheckWithResult stdArgs >=> \case+        Success{} -> pure ()+        Failure{output} -> expectationFailure output+        GaveUp{output} -> expectationFailure output+        NoExpectedFailure{output} -> expectationFailure output++data Move+    = Backward+    | Forward+    | Up+    | Down+    | LineStart+    | LineEnd+    | FirstLine+    | LastLine+    | Rel !(Int, Int)+    | Abs !Position+    deriving stock (Eq, Show)++instance Arbitrary Position where+    arbitrary = do+        posLine <- arbitrary+        posColumn <- arbitrary+        pure Position{..}++instance Arbitrary Move where+    arbitrary =+        oneof+            [ pure Backward+            , pure Forward+            , pure LineStart+            , pure LineEnd+            , Rel <$> arbitrary+            , Abs <$> arbitrary+            ]++newtype VerticalMove = VerticalMove Move+    deriving newtype (Eq, Show)++instance Arbitrary VerticalMove where+    arbitrary = VerticalMove <$> elements [Up, Down, FirstLine, LastLine]++moveZipper :: Move -> RopeZipper -> RopeZipper+moveZipper Forward = moveForward+moveZipper Backward = moveBackward+moveZipper Up = moveUp+moveZipper Down = moveDown+moveZipper LineStart = moveToLineStart+moveZipper LineEnd = moveToLineEnd+moveZipper FirstLine = moveToFirstLine+moveZipper LastLine = moveToLastLine+moveZipper (Rel (dy, dx)) = moveCursor $ \Position{..} ->+    Position+        { posLine = boundedAdd dy posLine+        , posColumn = boundedAdd dx posColumn+        }+moveZipper (Abs c) = setCursor c++positionToPair :: Position -> (Int, Int)+positionToPair Position{..} = (fromIntegral posLine, fromIntegral posColumn)++pairToPosition :: (Int, Int) -> Position+pairToPosition (y, x) =+    Position+        { posLine = fromIntegral $ max 0 y+        , posColumn = fromIntegral $ max 0 x+        }++spec :: Spec+spec = parallel $ modifyMaxSuccess (* 100) do+    it "fromText is a right inverse of toText" $ property $ \t -> do+        toText (fromText t) `shouldBe` t++    it "fromRope is a right inverse of toRope" $ property $ \r -> do+        toRope (fromRope r) `shouldBe` r++    it "concatenates" $ property $ \r1 r2 -> do+        fromRope r1 <> fromRope r2 `shouldBe` fromParts r1 r2+        toRope (fromParts r1 r2) `shouldBe` r1 <> r2++    it "concatenates newline" $ property $ \zipper -> do+        splitFirstLine "\n" `shouldBe` ("\n", "")+        toRope (zipper <> "\n") `shouldBe` toRope zipper <> "\n"++    it "inserts" $ property $ \r1 r2 r3 -> do+        insertRope r2 (fromParts r1 r3) `shouldBe` fromParts (r1 <> r2) r3++    it "deletes before" $ property $ \r1 (Text.singleton -> Rope.fromText -> c) r2 ->+        deleteBefore (fromParts (r1 <> c) r2) `shouldBe` fromParts r1 r2++    it "deletes after" $ property $ \r1 (Text.singleton -> Rope.fromText -> c) r2 ->+        deleteAfter (fromParts r1 (c <> r2)) `shouldBe` fromParts r1 r2++    it "moves" $ property $ \t1 t2 move -> do+        let zipper = fromParts (Rope.fromText t1) (Rope.fromText t2)+            cursor =+                Position+                    { posLine = fromIntegral $ Text.count "\n" t1+                    , posColumn = fromIntegral . Text.length . snd $ Text.breakOnEnd "\n" t1+                    }+        zipper.cursor `shouldBe` cursor+        let t = t1 <> t2+            numLines = Text.count "\n" t + 1+            clampRow = clamp (0, numLines - 1)+            lineLength y = maybe 0 Text.length $ Text.lines t !? y+            clampCol (clampRow -> y, x) = (y, clamp (0, lineLength y) x)+            moveCursor' (positionToPair -> (y, x)) = pairToPosition . clampCol $ case move of+                Backward -> (y, x - 1)+                Forward -> (y, x + 1)+                Up -> (y - 1, x)+                Down -> (y + 1, x)+                LineStart -> (y, minBound)+                LineEnd -> (y, maxBound)+                FirstLine -> (minBound, x)+                LastLine -> (maxBound, x)+                Rel (dy, dx) -> (y + dy, x + dx)+                Abs pos -> positionToPair pos+        let zipper' = moveZipper move zipper+        zipper'.cursor `shouldBe` moveCursor' zipper.cursor+        toRope zipper `shouldBe` toRope zipper'++    it "counts lines correctly" $ property $ \zipper -> do+        lengthInLines zipper+            `shouldBe` (fromIntegral . length . RopeZipper.lines) zipper++    it "sticks the last requested column" $ property $ \zipper (VerticalMove move) -> do+        let zipper' = moveZipper move zipper+        let lineLen' =+                fromIntegral+                    $ TextZipper.length zipper'.currentLine+                    - if TextZipper.hasTrailingNewline zipper'.currentLine then 1 else 0+        let expectedColumn = min zipper.cursor.posColumn lineLen'+        zipper'.cursor.posColumn `shouldBe` expectedColumn+        moveCursor (\p -> p{posLine = zipper.cursor.posLine}) zipper' `shouldBe` zipper
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-prepositive-qualified-module #-}
+ test/Util.hs view
@@ -0,0 +1,62 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Util+    ( module Prelude+    , module Control.Arrow+    , module Control.Monad+    , module Data.Function+    , module Data.Maybe+    , module Data.Ord+    , module Data.String+    , module Debug.Trace+    , module Test.Hspec+    , module Test.Hspec.QuickCheck+    , module Test.QuickCheck+    , (!?)+    , boundedAdd+    )+where++import Control.Arrow+import Control.Monad+import Data.Function+import Data.Maybe+import Data.Ord (clamp)+import Data.String+import Data.Text qualified as Strict+import Data.Text.Lazy qualified as Lazy+import Data.Text.Lazy.Zipper (TextZipper)+import Data.Text.Lazy.Zipper qualified as TextZipper+import Data.Text.Rope (Rope)+import Data.Text.Rope qualified as Rope+import Data.Text.Rope.Zipper (RopeZipper)+import Data.Text.Rope.Zipper qualified as RopeZipper+import Debug.Trace+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Prelude++instance Arbitrary Strict.Text where+    arbitrary = fromString <$> listOf (elements "abcdefg\n")++instance Arbitrary Lazy.Text where+    arbitrary = Lazy.fromStrict <$> arbitrary++instance Arbitrary Rope where+    arbitrary = Rope.fromText <$> arbitrary++instance Arbitrary TextZipper where+    arbitrary = TextZipper.fromParts <$> arbitrary <*> arbitrary++instance Arbitrary RopeZipper where+    arbitrary = RopeZipper.fromParts <$> arbitrary <*> arbitrary++infixr 9 !?++-- | Get element n of a list, or Nothing. Like `!!` but safe.+(!?) :: [a] -> Int -> Maybe a+(!?) xs i = listToMaybe $ drop i xs++boundedAdd :: Int -> Word -> Word+boundedAdd delta = fromIntegral . clamp @Int (0, maxBound) . (+ delta) . fromIntegral
+ text-rope-zipper.cabal view
@@ -0,0 +1,77 @@+cabal-version:       3.0+name:                text-rope-zipper+version:             0.1.0.0+synopsis:            2D text zipper based on text-rope+homepage:            https://github.com/ners/text-rope-zipper/blob/master/README.md+license:             Apache-2.0+license-file:        LICENCE.md+author:              ners+maintainer:          ners@gmx.ch+bug-reports:         https://github.com/ners/lsp-client/issues+category:            Text+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.md+tested-with:         GHC == { 9.2, 9.4, 9.6, 9.8 }++source-repository head+  type:     git+  location: https://github.com/ners/text-rope-zipper++common common+    default-language: GHC2021+    ghc-options:+        -Weverything+        -Wno-unsafe+        -Wno-missing-safe-haskell-mode+        -Wno-missing-export-lists+        -Wno-missing-import-lists+        -Wno-missing-kind-signatures+        -Wno-all-missed-specialisations+    default-extensions:+        ApplicativeDo+        BlockArguments+        DataKinds+        DefaultSignatures+        DeriveAnyClass+        DeriveGeneric+        DerivingStrategies+        DerivingVia+        ExplicitNamespaces+        LambdaCase+        NoFieldSelectors+        NoImplicitPrelude+        OverloadedLabels+        OverloadedRecordDot+        OverloadedStrings+        RecordWildCards+        RecursiveDo+        TypeFamilies+        ViewPatterns+    build-depends:+        base >= 4.16 && < 5,+        text,+        text-rope >= 0.2 && < 0.3,++library+    import:           common+    hs-source-dirs:   src+    exposed-modules:+        Data.Text.Lazy.Zipper,+        Data.Text.Rope.Zipper,+    other-modules:+        Util,++test-suite spec+    import:           common+    ghc-options:      -threaded+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Spec.hs+    build-depends:+        QuickCheck,+        hspec,+        text-rope-zipper,+    other-modules:+        Data.Text.Lazy.ZipperSpec,+        Data.Text.Rope.ZipperSpec,+        Util,