yi-rope 0.1.0.1 → 0.2.0.0
raw patch · 5 files changed
+489/−486 lines, 5 filesdep −HUnitdep −bytestringdep −cautious-file
Dependencies removed: HUnit, bytestring, cautious-file, filepath, random, rope, utf8-string
Files
- bench/MainBenchmarkSuite.hs +108/−132
- src/Yi/OldRope.hs +0/−244
- src/Yi/Rope.hs +339/−44
- test/Yi/RopeSpec.hs +36/−47
- yi-rope.cabal +6/−19
bench/MainBenchmarkSuite.hs view
@@ -1,152 +1,128 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-} module Main where -import qualified Yi.Rope as R-import qualified Yi.OldRope as O-import Criterion.Main+import Control.DeepSeq+import Criterion.Main import qualified Criterion.Main as C-import Control.DeepSeq-import Data.List (foldl')+import Data.Text (unlines, Text, replicate)+import Prelude hiding (unlines)+import qualified Yi.Rope as F -type Bench a = Input -> Name -> a -> C.Benchmark-type Input = String-type Name = String +longText :: Text+longText = force . Data.Text.unlines+ $ Prelude.replicate 1000 "Lorem Спасибопожалусто dolor 中文測試 amet"+{-# NOINLINE longText #-}++longTextTree :: F.YiString+longTextTree = force . F.fromText . Data.Text.unlines+ $ Prelude.replicate 1000 "Lorem Спасибопожалусто dolor 中文測試 amet"+{-# NOINLINE longTextTree #-}++longFRope :: F.YiString+longFRope = force (F.fromText longText)+{-# NOINLINE longFRope #-}++wideText :: Text+wideText = force . unlines+ $ Prelude.replicate 10+ $ Data.Text.replicate 100 "Lorem Спасибопожалусто dolor 中文測試 amet "+{-# NOINLINE wideText #-}++shortText :: Text+shortText = force . unlines+ $ Prelude.replicate 3 "Lorem Спасибопожалусто dolor 中文測試 amet"+{-# NOINLINE shortText #-}++tinyText :: Text+tinyText = force $ "Lorem Спасибопожалусто dolor 中文測試 amet"+{-# NOINLINE tinyText #-}++wideFRope :: F.YiString+wideFRope = force (F.fromText wideText)+{-# NOINLINE wideFRope #-}+ benchOnText :: NFData b => a -> String -> (a -> b) -> Benchmark benchOnText text name f = C.bench name $ C.nf f text -linesplitbench :: IO ()-linesplitbench = defaultMain- [- -- benchOnText longORope "long O.splitAtLine 10" (O.splitAtLine 10)- -- , benchOnText longRRope "long R.splitAtLine 10" (R.splitAtLine 10)- -- , benchOnText wideORope "wide O.splitAtLine 10" (O.splitAtLine 10)- -- , benchOnText wideRRope "wide R.splitAtLine 10" (R.splitAtLine 10)- -- , benchOnText longORope "long O.splitAtLine 100" (O.splitAtLine 100)- -- , benchOnText longRRope "long R.splitAtLine 100" (R.splitAtLine 100)- -- , benchOnText wideORope "wide O.splitAtLine 100" (O.splitAtLine 100)- -- ,- benchOnText wideRRope "wide R.splitAtLine 100" (R.splitAtLine 100)- ]+benchSplitAt :: NFData a => a -> String+ -> (Int -> a -> (a, a))+ -> C.Benchmark+benchSplitAt text name f+ = C.bench name+ $ C.nf (\x -> Prelude.foldr ((fst .) . f) x [1000, 999 .. 1]) text -lengthbench :: IO ()-lengthbench = defaultMain- [ benchOnText longORope "long O.length" O.length- , benchOnText longRRope "long R.length" R.length- , benchOnText wideORope "wide O.length" O.length- , benchOnText wideRRope "wide R.length" R.length- ]+benchTakeDrop :: NFData a => a -> String -> (Int -> a -> a) -> C.Benchmark+benchTakeDrop text name f+ = C.bench name+ $ C.nf (\x -> foldr f x [1000, 999 .. 1]) text -main :: IO ()-main = defaultMain- [ benchOnText longORope "long O.countNewLines" O.countNewLines- , benchOnText longRRope "long R.countNewLines" R.countNewLines- , benchOnText wideORope "wide O.countNewLines" O.countNewLines- , benchOnText wideRRope "wide R.countNewLines" R.countNewLines- , benchOnText longORope "long O.split \\n" (O.split 10)- , benchOnText longRRope "long R.split \\n" (R.split 10)- , benchOnText wideORope "wide O.split \\n" (O.split 10)- , benchOnText wideRRope "wide R.split \\n" (R.split 10)- , benchOnText longORope "long O.splitAt 5" (O.splitAt 5)- , benchOnText longRRope "long R.splitAt 5" (R.splitAt 5)- , benchOnText wideORope "wide O.splitAt 5" (O.splitAt 5)- , benchOnText wideRRope "wide R.splitAt 5" (R.splitAt 5)- , benchOnText longORope "long O.splitAt 700" (O.splitAt 700)- , benchOnText longRRope "long R.splitAt 700" (R.splitAt 700)- , benchOnText wideORope "wide O.splitAt 700" (O.splitAt 700)- , benchOnText wideRRope "wide R.splitAt 700" (R.splitAt 700)- , benchOnText longORope "long O.splitAtLine 10" (O.splitAtLine 10)- , benchOnText longRRope "long R.splitAtLine 10" (R.splitAtLine 10)- , benchOnText wideORope "wide O.splitAtLine 10" (O.splitAtLine 10)- , benchOnText wideRRope "wide R.splitAtLine 10" (R.splitAtLine 10)- , benchOnText longORope "long O.splitAtLine 100" (O.splitAtLine 100)- , benchOnText longRRope "long R.splitAtLine 100" (R.splitAtLine 100)- , benchOnText wideORope "wide O.splitAtLine 100" (O.splitAtLine 100)- , benchOnText wideRRope "wide R.splitAtLine 100" (R.splitAtLine 100)- , benchOnText longORope "long O.drop 5" (O.drop 5)- , benchOnText longRRope "long R.drop 5" (R.drop 5)- , benchOnText wideORope "wide O.drop 5" (O.drop 5)- , benchOnText wideRRope "wide R.drop 5" (R.drop 5)- , benchOnText longORope "long O.drop 150" (O.drop 150)- , benchOnText longRRope "long R.drop 150" (R.drop 150)- , benchOnText wideORope "wide O.drop 150" (O.drop 150)- , benchOnText wideRRope "wide R.drop 150" (R.drop 150)- , benchOnText longORope "long O.take 5" (O.take 5)- , benchOnText longRRope "long R.take 5" (R.take 5)- , benchOnText wideORope "wide O.take 5" (O.take 5)- , benchOnText wideRRope "wide R.take 5" (R.take 5)- , benchOnText longORope "long O.take 150" (O.take 150)- , benchOnText longRRope "long R.take 150" (R.take 150)- , benchOnText wideORope "wide O.take 150" (O.take 150)- , benchOnText wideRRope "wide R.take 150" (R.take 150)- , benchOnText longORope "long O.toReverseString" O.toReverseString- , benchOnText longRRope "long R.toReverseString" R.toReverseString- , benchOnText wideORope "wide O.toReverseString" O.toReverseString- , benchOnText wideRRope "wide R.toReverseString" R.toReverseString- , benchOnText longORope "long O.toString" O.toString- , benchOnText longRRope "long R.toString" R.toString- , benchOnText wideORope "wide O.toString" O.toString- , benchOnText wideRRope "wide R.toString" R.toString- , benchOnText longORope "long O.null" O.null- , benchOnText longRRope "long R.null" R.null- , benchOnText wideORope "wide O.null" O.null- , benchOnText wideRRope "wide R.null" R.null- , benchOnText longORope "long O.empty" (const O.empty)- , benchOnText longRRope "long R.empty" (const R.empty)- , benchOnText wideORope "wide O.empty" (const O.empty)- , benchOnText wideRRope "wide R.empty" (const R.empty)- , benchOnText longORope "long O.length" O.length- , benchOnText longRRope "long R.length" R.length- , benchOnText wideORope "wide O.length" O.length- , benchOnText wideRRope "wide R.length" R.length- , benchOnText longORope "long O.reverse" O.reverse- , benchOnText longRRope "long R.reverse" R.reverse- , benchOnText wideORope "wide O.reverse" O.reverse- , benchOnText wideRRope "wide R.reverse" R.reverse- , benchOnText longORope "long O.append" (\x -> O.append x x)- , benchOnText longRRope "long R.append" (\x -> R.append x x)- , benchOnText wideORope "wide O.append" (\x -> O.append x x)- , benchOnText wideRRope "wide R.append" (\x -> R.append x x)- , benchOnText longORope "long O.concat 10" (\x -> O.concat (replicate 10 x))- , benchOnText longRRope "long R.concat 10" (\x -> R.concat (replicate 10 x))- , benchOnText wideORope "wide O.concat 10" (\x -> O.concat (replicate 10 x))- , benchOnText wideRRope "wide R.concat 10" (\x -> R.concat (replicate 10 x))- , benchOnText longORope "long O.concat 100" (\x -> O.concat (replicate 100 x))- , benchOnText longRRope "long R.concat 100" (\x -> R.concat (replicate 100 x))- , benchOnText wideORope "wide O.concat 100" (\x -> O.concat (replicate 100 x))- , benchOnText wideRRope "wide R.concat 100" (\x -> R.concat (replicate 100 x))- ]+-- | Chunk sizes to test with.+chunkSizes :: [Int]+chunkSizes = [1200] -instance NFData R.Rope where- rnf r = R.toString r `deepseq` ()+wideTexts :: (Int -> String, [(Int, F.YiString)])+wideTexts = (\x -> "wide " ++ show x, mkTextSample wideText) -instance NFData O.Rope where- rnf r = O.toString r `deepseq` ()+longTexts :: (Int -> String, [(Int, F.YiString)])+longTexts = (\x -> "long " ++ show x, mkTextSample longText) -longText :: String-longText = force . unlines- $ replicate 1000 "Lorem Спасибопожалусто dolor 中文測試 amet"-{-# NOINLINE longText #-}+shortTexts :: (Int -> [Char], [(Int, F.YiString)])+shortTexts = (\x -> "short " ++ show x, mkTextSample shortText) -longRRope :: R.Rope-longRRope = force (R.fromString longText)-{-# NOINLINE longRRope #-}+tinyTexts :: (Int -> String, [(Int, F.YiString)])+tinyTexts = (\x -> "tiny " ++ show x, mkTextSample tinyText) -longORope :: O.Rope-longORope = force (O.fromString longText)-{-# NOINLINE longORope #-}+mkTextSample :: Text -> [(Int, F.YiString)]+mkTextSample s = force $ zipWith mkTexts chunkSizes (Prelude.repeat s)+ where+ mkTexts :: Int -> Text -> (Int, F.YiString)+ mkTexts x t = (x, F.fromText' x t) -wideText :: String-wideText = force . unlines- $ replicate 10 . concat- $ replicate 100 "Lorem Спасибопожалусто dolor 中文測試 amet "-{-# NOINLINE wideText #-}+allTexts :: [(Int -> String, [(Int, F.YiString)])]+allTexts = [longTexts {-, wideTexts, shortTexts, tinyTexts -}] -wideORope :: O.Rope-wideORope = force (O.fromString wideText)-{-# NOINLINE wideORope #-}+-- | Sample usage:+--+-- > mkGroup "drop" F.drop allTexts benchOnText+mkGroup :: String -- ^ Group name+ -> f -- ^ Function being benchmarked+ -> [(Int -> String, [(Int, F.YiString)])]+ -> (F.YiString -> String -> f -> Benchmark)+ -> Benchmark+mkGroup n f subs r = bgroup n tests+ where+ mkTest s (l, t) = r t (s l) f+ tests = Prelude.concat $ map (\(s, t) -> map (mkTest s) t) subs -wideRRope :: R.Rope-wideRRope = force (R.fromString wideText)-{-# NOINLINE wideRRope #-}+onTextGroup :: NFData a => String -> (F.YiString -> a) -> Benchmark+onTextGroup n f = mkGroup n f allTexts benchOnText++onIntGroup :: String -> (Int -> F.YiString -> F.YiString) -> Benchmark+onIntGroup n f = mkGroup n f allTexts benchTakeDrop++onSplitGroup :: String+ -> (Int -> F.YiString -> (F.YiString, F.YiString))+ -> Benchmark+onSplitGroup n f = mkGroup n f allTexts benchSplitAt++main :: IO ()+main = defaultMain+ [ onIntGroup "drop" F.drop+ , onIntGroup "take" F.take+ , onTextGroup "countNewLines" F.countNewLines+ , onTextGroup "lines" F.lines+ , onSplitGroup "splitAt" F.splitAt+ , onSplitGroup "splitAtLine" F.splitAtLine+ , onTextGroup "toReverseText" F.toReverseText+ , onTextGroup "toText" F.toText+ , onTextGroup "length" F.length+ , onTextGroup "reverse" F.reverse+ , onTextGroup "null" F.null+ , onTextGroup "empty" $ const F.empty+ , onTextGroup "append" (\x -> F.append x x)+ , onTextGroup "concat x100" $ F.concat . Prelude.replicate 100+ ]
− src/Yi/OldRope.hs
@@ -1,244 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module : Yi.OldRope--- License : GPL-2--- Maintainer : yi-devel@googlegroups.com--- Stability : experimental--- Portability : portable------ This module defines a Rope representation.------ While the representation are ByteStrings stored in a finger tree,--- the indices are actually in number of characters.------ This is currently based on utf8-string, but a couple of other--- packages might be better: text, compact-string.------ At the moment none of them has a lazy implementation, which forces--- us to always export plain Strings. (Utf8-string does not have a--- proper newtype)------ __Important__: The reason this module exists is to allow--- benchmarking and behaviour checks against a new implementation. As--- of today (10th September 2014), Yi imports this module. Notably,--- this module will be going away and Yi will start using "Yi.Rope"--- instead in the near future.--module Yi.OldRope (- Rope,-- -- * Conversions to Rope- fromString,-- -- * Conversions from Rope- toString, toReverseString,-- -- * List-like functions- null, empty, take, drop, length, reverse, countNewLines,-- split, splitAt, splitAtLine,-- append, concat,-- -- * IO- readFile, writeFile,-- -- * Low level functions- splitAtChunkBefore- ) where--import Data.Binary-import Data.ByteString (ByteString)-import qualified Data.ByteString as B (append, concat)-import qualified Data.ByteString as Byte-import qualified Data.ByteString.Lazy as LB (toChunks, fromChunks, null,- readFile, split)-import qualified Data.ByteString.Lazy.UTF8 as LB-import qualified Data.ByteString.UTF8 as B-import Data.Char (ord)-import qualified Data.FingerTree as T-import Data.FingerTree hiding (null, empty, reverse, split)-import qualified Data.List as L-import Data.Monoid-import Data.String (IsString(..))-import Prelude hiding (null, head, tail, length, take, drop, splitAt,- head, tail, foldl, reverse, readFile,- writeFile, concat)-import System.IO.Cautious (writeFileL)--defaultChunkSize :: Int-defaultChunkSize = 128 -- in chars! (chunkSize requires this to be <= 256)---- The FingerTree does not store measurements for single chunks, which--- means that the length of chunks often have to be recomputed.-mkChunk :: ByteString -> Chunk-mkChunk s = Chunk (fromIntegral $ B.length s) s-data Chunk = Chunk { chunkSize :: {-# UNPACK #-} !Word8- , fromChunk :: {-# UNPACK #-} !ByteString- } deriving (Eq, Show)--data Size = Indices { charIndex :: {-# UNPACK #-} !Int- , lineIndex :: {-# UNPACK #-} !Int- -- ^ lineIndex is lazy because we do not often- -- want the line count. However, we need this to- -- avoid stack overflows on large files!- } deriving Show--instance Monoid Size where- mempty = Indices 0 0- mappend (Indices c1 l1) (Indices c2 l2) = Indices (c1+c2) (l1+l2)--newtype Rope = Rope { fromRope :: FingerTree Size Chunk }- deriving (Eq, Show)--(-|) :: Chunk -> FingerTree Size Chunk -> FingerTree Size Chunk-b -| t | chunkSize b == 0 = t- | otherwise = b <| t--(|-) :: FingerTree Size Chunk -> Chunk -> FingerTree Size Chunk-t |- b | chunkSize b == 0 = t- | otherwise = t |> b---- Newlines are preserved by UTF8 encoding and decoding-newline :: Word8-newline = fromIntegral (ord '\n')--instance Measured Size Chunk where- measure (Chunk l s) =- Indices (fromIntegral l) -- note that this is the length in- -- characters, not bytes.- (Byte.count newline s)---- | The 'Foldable' instance of 'FingerTree' only defines 'foldMap',--- so the 'foldr' needed for 'toList' is inefficient, and can cause--- stack overflows. So, we roll our own (somewhat inefficient) version--- of 'toList' to avoid this.-toList :: Measured v a => FingerTree v a -> [a]-toList t = case viewl t of- c :< cs -> c : toList cs- EmptyL -> []--toLazyByteString :: Rope -> LB.ByteString-toLazyByteString = LB.fromChunks . fmap fromChunk . toList . fromRope--reverse :: Rope -> Rope-reverse = Rope . fmap' (mkChunk . B.fromString . L.reverse . B.toString . fromChunk) . T.reverse . fromRope--toReverseString :: Rope -> String-toReverseString = concatMap (L.reverse . B.toString . fromChunk) . toList . T.reverse . fromRope--toString :: Rope -> String-toString = LB.toString . toLazyByteString--fromLazyByteString :: LB.ByteString -> Rope-fromLazyByteString = Rope . toTree T.empty- where- toTree acc b | LB.null b = acc- | otherwise = let (h,t) = LB.splitAt (fromIntegral defaultChunkSize) b- chunk = mkChunk $ B.concat $ LB.toChunks h- in acc `seq` chunk `seq` toTree (acc |> chunk) t--instance IsString Rope where- fromString = Rope . toTree T.empty- where- toTree acc [] = acc- toTree acc b = let (h,t) = L.splitAt defaultChunkSize b- chunk = mkChunk $ B.fromString h- in acc `seq` chunk `seq` toTree (acc |> chunk) t--null :: Rope -> Bool-null (Rope a) = T.null a--empty :: Rope-empty = Rope T.empty---- | Get the length of the string. (This information cached, so O(1)--- amortized runtime.)-length :: Rope -> Int-length = charIndex . measure . fromRope---- | Count the number of newlines in the strings. (This information--- cached, so O(1) amortized runtime.)-countNewLines :: Rope -> Int-countNewLines = lineIndex . measure . fromRope---- | Append two strings by merging the two finger trees.-append :: Rope -> Rope -> Rope-append (Rope a) (Rope b) = Rope $- case T.viewr a of- EmptyR -> b- l :> Chunk len x -> case T.viewl b of- EmptyL -> a- Chunk len' x' :< r ->- if fromIntegral len + fromIntegral len' < defaultChunkSize- then l >< singleton (Chunk (len + len') (x `B.append` x')) >< r- else a >< b--concat :: [Rope] -> Rope-concat = L.foldl' append empty--take, drop :: Int -> Rope -> Rope-take n = fst . splitAt n-drop n = snd . splitAt n---- | Split the string at the specified position.-splitAt :: Int -> Rope -> (Rope, Rope)-splitAt n (Rope t) =- case T.viewl c of- Chunk len x :< r | n' /= 0 ->- let (lx, rx) = B.splitAt n' x- in (Rope $ l |> Chunk (fromIntegral n') lx,- Rope $ Chunk (len - fromIntegral n') rx -| r)- _ -> (Rope l, Rope c)- where- (l, c) = T.split ((> n) . charIndex) t- n' = n - charIndex (measure l)---- | Split the rope on a chunk, so that the desired--- position lies within the first chunk of the second rope.-splitAtChunkBefore :: Int -> Rope -> (Rope, Rope)-splitAtChunkBefore n (Rope t) =- let (l, c) = T.split ((> n) . charIndex) t in (Rope l, Rope c)---- | Split before the specified line. Lines are indexed from 0.-splitAtLine :: Int -> Rope -> (Rope, Rope)-splitAtLine n | n <= 0 = \r -> (empty, r)- | otherwise = splitAtLine' (n-1)---- | Split after the specified line. Lines are indexed from 0.-splitAtLine' :: Int -> Rope -> (Rope, Rope)-splitAtLine' n (Rope t) =- case T.viewl c of- ch@(Chunk _ x) :< r ->- let (lx, rx) = cutExcess excess x- excess = lineIndex (measure l) + lineIndex (measure ch) - n - 1- in (Rope $ l |- mkChunk lx, Rope $ mkChunk rx -| r)- _ -> (Rope l, Rope c)- where- (l, c) = T.split ((n <) . lineIndex) t--split :: Word8 -> Rope -> [Rope]-split c = map fromLazyByteString . LB.split c . toLazyByteString--cutExcess :: Int -> ByteString -> (ByteString, ByteString)-cutExcess i s =- let idx = gt i $ L.reverse $ Byte.elemIndices newline s- in Byte.splitAt (idx+1) s -- take one extra byte to that the newline- -- is found on the left.- where gt _ [] = Byte.length s- gt 0 (x:_ ) = x- gt n (_:xs) = gt (n-1) xs---instance Binary Rope where- put = put . toString- get = fromString `fmap` get--writeFile :: FilePath -> Rope -> IO ()-writeFile f = writeFileL f . toLazyByteString--readFile :: FilePath -> IO Rope-readFile f = fromLazyByteString `fmap` LB.readFile f
src/Yi/Rope.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- |@@ -7,64 +11,355 @@ -- Stability : experimental -- Portability : portable ----- A work in progress module that aims to be a more efficient--- replacement for "Yi.OldRope". For now, please import "Yi.OldRope"!-module Yi.Rope (Rope, fromString, toString, toReverseString, null, empty,- Yi.Rope.take, Yi.Rope.drop, Yi.Rope.length, reverse,- countNewLines, Yi.Rope.split, Yi.Rope.splitAt,- Yi.Rope.splitAtLine, Yi.Rope.append, Yi.Rope.concat,- Yi.Rope.readFile, Yi.Rope.writeFile)- where+-- This module defines a @rope@ data structure for use in Yi. This+-- specific implementation uses a fingertree over Text.+--+-- In contrast to our old implementation, we can now reap all the+-- benefits of Text: automatic unicode handling and blazing fast+-- implementation on underlying strings. This frees us from a lot of+-- book-keeping. We don't lose out on not using ByteString directly+-- because the old implementation encoded it into UTF8 anyway, making+-- it unsuitable for storing anything but text. -import qualified Codec.Binary.UTF8.Generic as G+module Yi.Rope (+ Yi.Rope.YiString,++ -- * Conversions to YiString+ Yi.Rope.fromString, Yi.Rope.fromText,+ Yi.Rope.fromString', Yi.Rope.fromText',++ -- * Conversions from YiString+ Yi.Rope.toString, Yi.Rope.toReverseString,+ Yi.Rope.toText, Yi.Rope.toReverseText,++ -- * List-like functions+ Yi.Rope.null, Yi.Rope.empty, Yi.Rope.take, Yi.Rope.drop,+ Yi.Rope.length, Yi.Rope.reverse, Yi.Rope.countNewLines,++ Yi.Rope.lines, Yi.Rope.lines',+ Yi.Rope.splitAt, Yi.Rope.splitAtLine,++ Yi.Rope.append, Yi.Rope.concat,++ -- * IO+ Yi.Rope.readFile, Yi.Rope.writeFile++ ) where++import Control.Applicative ((<$>))+import Control.DeepSeq import Data.Binary-import qualified Data.ByteString.Lazy as LB (readFile, split, count)+import qualified Data.FingerTree as T+import Data.FingerTree hiding (null, empty, reverse, split)+import qualified Data.List as L import Data.Monoid-import Data.Rope-import qualified Prelude as P-import Prelude hiding (null, take, drop, reverse)-import System.IO.Cautious (writeFileL)+import Data.String (IsString(..))+import qualified Data.Text as TX+import qualified Data.Text.IO as TF (writeFile, readFile) -toReverseString :: Rope -> String-toReverseString = P.reverse . toString+-- | Used to cache the size of the strings.+data Size = Indices { charIndex :: {-# UNPACK #-} !Int+ -- ^ How many characters under here?+ , lineIndex :: {-# UNPACK #-} !Int+ -- ^ How many lines under here?+ } deriving (Eq, Show) -reverse :: Rope -> Rope-reverse = fromString . P.reverse . toString+-- | A chunk storing the string of the type it is indexed by. It+-- caches the length of stored string.+data YiChunk = Chunk { chunkSize :: {-# UNPACK #-} !Int+ , _fromChunk :: {-# UNPACK #-} !TX.Text+ } deriving (Show, Eq) -countNewLines :: Rope -> Int-countNewLines = fromIntegral . LB.count 10 . toLazyByteString+-- | Makes a chunk from a given string. We allow for an arbitrary+-- length function here to allow us to bypass the calculation with+-- 'const' in case the length is known ahead of time. In most cases,+-- the use of this is+--+-- > mkChunk 'TX.Text.length' someText+mkChunk :: (TX.Text -> Int) -- ^ The length function to use.+ -> TX.Text+ -> YiChunk+mkChunk l t = Chunk (l t) t -split :: Word8 -> Rope -> [Rope]-split c = map fromLazyByteString . LB.split c . toLazyByteString+-- | Transform the chunk content. It's vital that the transformation+-- preserves the length of the content.+overChunk :: (TX.Text -> TX.Text) -- ^ Length-preserving content transformation.+ -> YiChunk -> YiChunk+overChunk f (Chunk l t) = Chunk l (f t) -splitAt :: Int -> Rope -> (Rope, Rope)-splitAt = G.splitAt+instance Monoid Size where+ mempty = Indices 0 0+ Indices c l `mappend` Indices c' l' = Indices (c + c') (l + l') --- | Split before the specified line. Lines are indexed from 0.-splitAtLine :: Int -> Rope -> (Rope, Rope)-splitAtLine n r | n <= 0 = (mempty, r)+instance Measured Size YiChunk where+ measure (Chunk l t) = Indices l (TX.count "\n" t)++-- | A 'YiString' is a 'FingerTree' with cached column and line counts+-- over chunks of 'TX.Text'.+newtype YiString = YiString { fromRope :: FingerTree Size YiChunk }+ deriving (Show, Eq)++instance NFData Size where+ rnf (Indices !c !l) = c `seq` l `seq` ()++instance NFData YiChunk where+ rnf (Chunk !i !t) = i `seq` rnf t++instance NFData YiString where+ rnf = rnf . toText++(-|) :: YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk+b -| t | chunkSize b == 0 = t+ | otherwise = b <| t++(|-) :: FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk+t |- b | chunkSize b == 0 = t+ | otherwise = t |> b++-- | Default size chunk to use. Currently @1200@ as this is what+-- benchmarks suggest.+--+-- This makes the biggest difference with 'lines'-like and+-- 'concat'-like functions. Bigger chunks make 'concat' (much) faster+-- but 'lines' slower. In general it seems that we benefit more from+-- larger chunks and 1200 seems to be the sweet spot.+defaultChunkSize :: Int+defaultChunkSize = 1200++-- | Reverse the whole underlying string.+--+-- This involves reversing the order of the chunks as well as content+-- of the chunks. We use a little optimisation here that re-uses the+-- content of each chunk but this exposes a potential problem: after+-- many transformations, our chunks size might become quite varied+-- (but never more than the default size), perhaps we should+-- periodically rechunk the tree to recover nice sizes?+reverse :: YiString -> YiString+reverse = YiString . fmap' (overChunk TX.reverse) . T.reverse . fromRope++-- | See 'fromText'.+fromString :: String -> YiString+fromString = fromText . TX.pack++-- | See 'fromText''.+fromString' :: Int -> String -> YiString+fromString' n = fromText' n . TX.pack++-- | See 'toText'.+toString :: YiString -> String+toString = TX.unpack . toText++-- | See 'toReverseText'.+toReverseString :: YiString -> String+toReverseString = Prelude.reverse . toString++-- | This is like 'fromText' but it allows the user to specify the+-- chunk size to be used. Uses 'defaultChunkSize' if the given+-- size is <= 0.+fromText' :: Int -> TX.Text -> YiString+fromText' n | n <= 0 = fromText' defaultChunkSize+ | otherwise = YiString . r T.empty . f+ where+ f = TX.chunksOf n++ -- Convert the given string into chunks in the tree. We have a+ -- special case for a single element case: because we split on+ -- predetermined chunk size, we know that all chunks but the last+ -- one will be the specified size so we can optimise here instead+ -- of having to recompute chunk size at creation.+ r :: FingerTree Size YiChunk -> [TX.Text] -> FingerTree Size YiChunk+ r tr [] = tr+ r tr [!ts] = tr |- mkChunk TX.length ts+ r tr (!t:ts) = let r' = tr |- mkChunk (const n) t+ in r r' ts++-- | Converts a 'TX.Text' into a 'YiString' using+-- 'defaultChunkSize'-sized chunks for the underlying tree.+fromText :: TX.Text -> YiString+fromText = fromText' defaultChunkSize++-- | Consider whether you really need to use this!+toText :: YiString -> TX.Text+toText = TX.concat . go . fromRope+ where+ go :: FingerTree Size YiChunk -> [TX.Text]+ go t = case viewl t of+ Chunk _ !c :< cs -> c : go cs+ EmptyL -> []++-- | Spits out the underlying string, reversed.+--+-- Note that this is actually slightly faster than manually unrolling+-- the tree from the end, 'TX.reverse'ing each chunk and+-- 'TX.concat'ing, at least with -O2 which you really need to be using+-- with 'TX.Text' anyway.+toReverseText :: YiString -> TX.Text+toReverseText = TX.reverse . toText++instance IsString YiString where+ fromString = Yi.Rope.fromString++-- | Checks if the given 'YiString' is actually empty.+null :: YiString -> Bool+null = T.null . fromRope++-- | Creates an empty 'YiString'.+empty :: YiString+empty = YiString T.empty++-- | Length of the whole underlying string.+--+-- Amortized constant time.+length :: YiString -> Int+length = charIndex . measure . fromRope++-- | Count the number of newlines in the underlying string. This is+-- actually amortized constant time as we cache this information in+-- the underlying tree.+countNewLines :: YiString -> Int+countNewLines = lineIndex . measure . fromRope++-- | Append two 'YiString's.+append :: YiString -> YiString -> YiString+append (YiString t) (YiString t') = YiString $ t T.>< t'++-- | Concat a list of 'YiString's.+concat :: [YiString] -> YiString+concat = L.foldl' append empty++-- | Splits the string at given character position.+--+-- If @position <= 0@ then the left string is empty and the right string+-- contains everything else.+--+-- If @position >= length of the string@ then the left string contains+-- everything and the right string is empty.+--+-- Implementation note: the way this works is by splitting the+-- underlying finger at a closest chunk that goes *over* the given+-- position (see 'T.split'). This either results in a perfect split at+-- which point we're done or more commonly, it leaves as few+-- characters short and we need to take few characters from the first+-- chunk of the right side of the split. We do precisely that.+--+-- All together, this split is only as expensive as underlying+-- 'T.split', the cost of splitting a chunk into two and the cost+-- consing and snocing one chunk to each string. As the chunks are+-- short, the split fairly cheap and cons/snoc constant time, this+-- turns out pretty fast all together.+splitAt :: Int -> YiString -> (YiString, YiString)+splitAt n (YiString t) = case viewl s of+ Chunk _ x :< ts | n' /= 0 ->+ let (lx, rx) = TX.splitAt n' x+ in (YiString $ f |> mkChunk TX.length lx,+ YiString $ mkChunk TX.length rx -| ts)+ _ -> (YiString f, YiString s)+ where+ (f, s) = T.split ((> n) . charIndex) t+ n' = n - charIndex (measure f)++-- | Takes the first n given characters.+take :: Int -> YiString -> YiString+take n = fst . Yi.Rope.splitAt n++-- | Drops the first n characters.+drop :: Int -> YiString -> YiString+drop n = snd . Yi.Rope.splitAt n++-- | Splits the underlying string before the given line number.+-- Zero-indexed lines.+--+-- Splitting at line <= 0 gives you an empty string. Splitting at+-- @n > 0@ gives you the first n lines.+--+-- Also see 'splitAtLine''.+splitAtLine :: Int -> YiString -> (YiString, YiString)+splitAtLine n r | n <= 0 = (empty, r) | otherwise = splitAtLine' (n - 1) r --- | Split after the specified line. Lines are indexed from 0.-splitAtLine' :: Int -> Rope -> (Rope, Rope)-splitAtLine' n r = let ls = P.take (n + 1) (G.lines' r)- in G.splitAt (sum $ map G.length ls) r+-- | Splits the underlying string after the given line number.+-- Zero-indexed lines.+--+-- Splitting at line <= 0 gives you the first line. Splitting at+-- @n > 0@ gives you the first n + 1 lines.+--+-- The implementation is similar to that of 'splitAt' except we are+-- now looking for extra newlines in the next chunk rather than extra+-- characters.+splitAtLine' :: Int -> YiString -> (YiString, YiString)+splitAtLine' p (YiString tr) = case viewl s of+ ch@(Chunk _ x) :< r ->+ let excess = lineIndex (measure f) + lineIndex (measure ch) - p - 1+ (lx, rx) = cutExcess excess x+ in (YiString $ f |- mkChunk TX.length lx,+ YiString $ mkChunk TX.length rx -| r)+ _ -> (YiString f, YiString s)+ where+ (f, s) = T.split ((p <) . lineIndex) tr -append :: Rope -> Rope -> Rope-append = (<>)+ cutExcess :: Int -> TX.Text -> (TX.Text, TX.Text)+ cutExcess n t = case TX.length t of+ 0 -> (TX.empty, TX.empty)+ _ -> let ns = TX.count "\n" t+ ls = TX.lines t+ front = TX.unlines $ Prelude.take (ns - n) ls+ back = TX.drop (TX.length front) t+ in if n >= ns+ then (t, TX.empty)+ else (front, back) -concat :: [Rope] -> Rope-concat = mconcat+-- | This is like 'lines'' but it does *not* preserve newlines.+--+-- Specifically, we just strip the newlines from the result of+-- 'lines''.+--+-- This behaves slightly differently than the old split: the number of+-- resulting strings here is equal to the number of newline characters+-- in the underlying string. This is much more consistent than the old+-- behaviour which blindly used @ByteString@s split and stitched the+-- result back together which was inconsistent with the rest of the+-- interface which worked with number of newlines.+lines :: YiString -> [YiString]+lines = map dropNl . lines'+ where+ dropNl (YiString t) = case viewr t of+ ts :> ch@(Chunk l tx) ->+ YiString $ ts |- if TX.null tx+ then ch+ else case TX.last tx of+ '\n' -> Chunk (l - 1) (TX.init tx)+ _ -> ch+ EmptyR -> YiString T.empty -writeFile :: FilePath -> Rope -> IO ()-writeFile f = writeFileL f . toLazyByteString+-- | Splits the 'YiString' into a list of 'YiString' each containing a+-- line.+--+-- Note that in old implementation this allowed an arbitrary character+-- to split on. If you want to do that, manually convert 'toText' and+-- use 'TX.splitOn' to suit your needs. This case is optimised for+-- newlines only which seems to have been the only use of the original+-- function.+--+-- The newlines are preserved so this should hold:+--+-- > 'toText' . 'concat' . 'lines'' ≡ 'toText'+--+-- but the underlying structure might change: notably, chunks will+-- most likely change sizes.+lines' :: YiString -> [YiString]+lines' t = let (YiString f, YiString s) = splitAtLine' 0 t+ in if T.null s+ then if T.null f then [] else [YiString f]+ else YiString f : lines' (YiString s) -readFile :: FilePath -> IO Rope-readFile f = fromLazyByteString `fmap` LB.readFile f+-- | To serialise a 'YiString', we turn it into a regular 'String'+-- first.+instance Binary YiString where+ put = put . toString+ get = Yi.Rope.fromString <$> get -drop, take :: Int -> Rope -> Rope-take i = fst . G.splitAt i-drop i = snd . G.splitAt i+writeFile :: FilePath -> YiString -> IO ()+writeFile f = TF.writeFile f . toText -length :: Rope -> Int-length = G.length+readFile :: FilePath -> IO YiString+readFile f = fromText <$> TF.readFile f
test/Yi/RopeSpec.hs view
@@ -1,58 +1,47 @@-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} module Yi.RopeSpec (main, spec) where +import qualified Data.Text as T import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck.Instances ()-import qualified Yi.OldRope as O import qualified Yi.Rope as R -main ∷ IO ()+main :: IO () main = hspec spec -infixr 2 `isLike`-isLike :: (Show a, Eq a) => (R.Rope -> a) -> (O.Rope -> a)- -> String -> Expectation-f `isLike` g = \s -> f (R.fromString s) `shouldBe` g (O.fromString s)--infixr 2 `stringIsLike`-stringIsLike :: (String -> R.Rope) -> (String -> O.Rope)- -> String -> Expectation-f `stringIsLike` g = \s -> (R.toString . f $ s) `shouldBe` (O.toString . g $ s)--infixr 2 `sIsLike`-sIsLike :: (R.Rope -> R.Rope) -> (O.Rope -> O.Rope) -> String -> Expectation-f `sIsLike` g = R.toString . f `isLike` O.toString . g--infixr 2 `ssIsLike`+infix 1 `isLike`+-- | Converts the input to R.YiString before comparing results.+isLike :: (Show a, Eq a) => (R.YiString -> a)+ -> (T.Text -> a)+ -> T.Text+ -> Expectation+f `isLike` g = \t -> (f . R.fromText) t `shouldBe` g t -ssIsLike :: (R.Rope -> R.Rope) -> (O.Rope -> O.Rope) -> String -> Expectation-f `ssIsLike` g = \s ->- (R.toString . f . R.fromString) s `shouldBe` (O.toString . g . O.fromString) s+infix 1 `isLikeT`+-- | Applies given function over underlying 'R.YiString'.+isLikeT :: (R.YiString -> R.YiString)+ -> (T.Text -> T.Text)+ -> T.Text+ -> Expectation+f `isLikeT` g = \t -> (R.toText . f . R.fromText) t `shouldBe` g t -spec ∷ Spec-spec = do- describe "Comparisons" $ do- prop "toString" $ R.toString `isLike` O.toString- prop "toReverseString" $ R.toReverseString `isLike` O.toReverseString- prop "null" $ R.null `isLike` O.null- prop "empty" $ const R.empty `stringIsLike` const O.empty- prop "take" $ \i -> R.take i `sIsLike` O.take i- prop "drop" $ \i -> R.drop i `sIsLike` O.drop i- prop "length" $ R.length `isLike` O.length- prop "reverse" $ R.reverse `sIsLike` O.reverse- prop "countNewLines" $ R.countNewLines `isLike` O.countNewLines- prop "split"- $ \i -> map R.toString . R.split i `isLike` map O.toString . O.split i- prop "fst . splitAt" $ \i -> fst . R.splitAt i `sIsLike` fst . O.splitAt i- prop "snd . splitAt" $ \i -> snd . R.splitAt i `sIsLike` snd . O.splitAt i- prop "fst . splitAtLine"- $ \i -> fst . R.splitAtLine i `sIsLike` fst . O.splitAtLine i- prop "snd . splitAtLine"- $ \i -> snd . R.splitAtLine i `sIsLike` snd . O.splitAtLine i- prop "append"- $ \s -> R.append (R.fromString s) `ssIsLike` O.append (O.fromString s)- prop "concat" $ \s -> (R.toString . R.concat . map R.fromString) s- `shouldBe`- (O.toString . O.concat . map O.fromString) s+spec :: Spec+spec = modifyMaxSize (const 1000) $ do+ describe "Working with YiString is just like working with Text" $ do+ prop "id ~ id" $ id `isLikeT` id+ prop "R.take ~ T.take" $ \i -> R.take i `isLikeT` T.take i+ prop "R.drop ~ T.drop" $ \i -> R.drop i `isLikeT` T.drop i+ prop "R.reverse ~ T.reverse" $ R.reverse `isLikeT` T.reverse+ prop "R.length ~ T.length" $ R.length `isLike` T.length+ prop "R.null ~ T.null" $ R.null `isLike` T.null+ prop "R.countNewLines ~ T.count \\n" $ R.countNewLines `isLike` T.count "\n"+ prop "R.empty ~ T.empty" $ R.toText R.empty `shouldBe` T.empty+ prop "fst . R.splitAt ~ fst . T.splitAt" $ \i ->+ fst . R.splitAt i `isLikeT` fst . T.splitAt i+ prop "snd . R.splitAt ~ snd . T.splitAt" $ \i ->+ snd . R.splitAt i `isLikeT` snd . T.splitAt i+ prop "R.append ~ T.append" $ \t ->+ R.append (R.fromText t) `isLikeT` T.append t+ prop "R.concat ~ T.concat" $ \s ->+ (R.toText . R.concat . map R.fromText) s `shouldBe` T.concat s
yi-rope.cabal view
@@ -1,5 +1,5 @@ name: yi-rope-version: 0.1.0.1+version: 0.2.0.0 synopsis: A rope data structure used by Yi description: A rope data structure used by Yi license: GPL-3@@ -13,59 +13,46 @@ library exposed-modules: Yi.Rope- Yi.OldRope build-depends: base >=4.5 && <5 , binary- , bytestring- , cautious-file+ , deepseq , fingertree- , rope- , utf8-string >= 0.3.1+ , text hs-source-dirs: src default-language: Haskell2010 - test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Spec.hs hs-source-dirs: test- ghc-options: -Wall-+ ghc-options: -funbox-strict-fields -Wall -O2 other-modules: Yi.RopeSpec build-depends: base- , binary- , bytestring- , filepath , hspec- , yi-rope- , HUnit , QuickCheck == 2.* , quickcheck-instances- , criterion- , random , text+ , yi-rope benchmark bench type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: MainBenchmarkSuite.hs hs-source-dirs: bench- ghc-options: -Wall+ ghc-options: -funbox-strict-fields -Wall -O2 build-depends: base >=4.5 && <5 , criterion- , random , deepseq , yi-rope- source-repository head type: git