rope 0.1 → 0.2

raw patch · 11 files changed

+279/−690 lines, 11 filesdep −mtlPVP ok

version bump matches the API change (PVP)

Dependencies removed: mtl

API changes (from Hackage documentation)

Files

• Data/Rope.hs +29/−39
• Data/Rope/Body.hs +8/−8
• Data/Rope/Internal.hs +208/−318
• Data/Rope/Unpackable.hs +0/−120
• Data/Rope/Util/Bifunctor.hs +0/−22
• Data/Rope/Util/Comonad.hs +0/−11
• Data/Rope/Util/Coproduct.hs +0/−84
• Data/Rope/Util/Product.hs +0/−77
• Data/Rope/Util/Reducer.hs +1/−1
• LICENSE +30/−1
• rope.cabal +3/−9

@@ -1,38 +1,33 @@-module Data.Rope -    ( +module Data.Rope (      -- * Size       Rope-    , length    -- :: Rope m -> Int-    , null      -- :: Rope m -> Bool-    -- * Splicing-    , Reducer(..)+    , length    -- :: Rope -> Int+    , null      -- :: Rope -> Bool     -- * Slicing-    , Annotation(..)-    , elide     -- :: Annotation m => Int -> Int -> Rope m -> Rope m-    , splitAt   -- :: Annotation m => Int -> Rope m -> (Rope m, Rope m)-    , take      -- :: Annotation m => Int -> Rope m -> Rope m-    , drop      -- :: Annotation m => Int -> Rope m -> Rope m+    , Breakable(..)+    , splitAt   -- :: Int -> Rope -> (Rope, Rope)+    , take      -- :: Int -> Rope -> Rope+    , drop      -- :: Int -> Rope -> Rope     -- * Walking-    , Unpackable(..)-    -- * Packing 'Rope'-    -- ** Polymorphic construction-    , Packable(..)-    -- ** Explicit construction-    , empty              -- :: Monoid m => Rope m-    , fromByteString     -- :: Annotation m => ByteString -> Rope m-    , fromChunks         -- :: Annotation m => [ByteString] -> Rope m-    , fromLazyByteString -- :: Annotation m => L.ByteString -> Rope m-    , fromWords          -- :: Annotation m => [Word8] -> Rope m-    , fromChar           -- :: Annotation m => Char -> Rope m-    , fromWord8          -- :: Annotation m => Word8 -> Rope m-    , fromString         -- :: Annotation m => String -> Rope m+    -- ** construction+    , Reducer(..)+    , empty              -- :: Rope+    , fromByteString     -- :: ByteString -> Rope+    , fromChunks         -- :: [ByteString] -> Rope+    , fromLazyByteString -- :: L.ByteString -> Rope+    , fromWords          -- :: [Word8] -> Rope+    , fromChar           -- :: Char -> Rope+    , fromWord8          -- :: Word8 -> Rope+    , fromString         -- :: String -> Rope     -- * Deconstructing 'Rope's-    , toChunks           -- :: Rope m -> [ByteString]-    , toLazyByteString   -- :: Rope m -> L.ByteString-    , toString           -- :: Rope m -> String+    , Unpackable(..)+    , toChunks           -- :: Rope -> [ByteString]+    , toLazyByteString   -- :: Rope -> L.ByteString+    , toString           -- :: Rope -> String     ) where  import Prelude hiding (null,head,length,drop,take,splitAt, last)+import Data.Rope.Util.Reducer (Reducer(..)) import Data.Rope.Internal      ( Rope     , empty@@ -45,16 +40,11 @@     , fromChar     , fromWord8     , fromString+    , toString+    , toChunks     , toLazyByteString-    , Packable(..)-    , Annotation(..)-    , elide, splitAt, take, drop)-import Data.Rope.Unpackable (Unpackable(..))-import Data.Rope.Util.Reducer (Reducer(..))-import Data.ByteString (ByteString)--toString :: Rope m -> String-toString = unpack--toChunks :: Rope m -> [ByteString]-toChunks = unpack+    , Breakable(..)+    , Unpackable(..)+    , splitAt+    , take+    , drop)

@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, TypeSynonymInstances #-} module Data.Rope.Body     ( Body-    , Count(..)+    , Offset(..)     , Chunk(..)     , measureBody     , cons'@@ -16,21 +16,21 @@ import Data.Rope.Util.Reducer import Data.ByteString (ByteString, null, length) -newtype Count = Count { getCount :: Int } deriving (Eq,Ord,Num,Show,Read,Enum,Data,Typeable)+newtype Offset = Offset { getOffset :: Int } deriving (Eq,Ord,Num,Show,Read,Enum,Data,Typeable) -instance Monoid Count where+instance Monoid Offset where     mempty = 0     mappend = (+)  newtype Chunk = Chunk { unchunk :: ByteString } deriving (Eq,Ord,Show,Read,Data,Typeable) -instance Measured Count Chunk where-    measure = Count . length . unchunk+instance Measured Offset Chunk where+    measure = Offset . length . unchunk -type Body = FingerTree Count Chunk +type Body = FingerTree Offset Chunk  -measureBody :: Measured Count a => FingerTree Count a -> Int-measureBody = getCount . measure+measureBody :: Measured Offset a => FingerTree Offset a -> Int+measureBody = getOffset . measure  cons' :: ByteString -> Body -> Body b `cons'` t | null b = t

@@ -1,200 +1,156 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, UndecidableInstances, TypeOperators #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, UndecidableInstances, TypeOperators, DeriveDataTypeable #-} module Data.Rope.Internal     ( Rope(..)     -- * Construction-    , cons8                 -- :: (ByteString `Reducer` m) => Word8 -> Rope m -> Rope m-    , empty                 -- :: Monoid m => Rope m -    , fromChunks            -- :: (ByteString `Reducer` m) => [ByteString] -> Rope m-    , fromByteString        -- :: (ByteString `Reducer` m) => ByteString -> Rope m -    , fromLazyByteString    -- :: (ByteString `Reducer` m) => L.ByteString -> Rope m -    , fromString            -- :: (ByteString `Reducer` m) => String -> Rope m-    , fromWords             -- :: (ByteString `Reducer` m) => [Word8] -> Rope m-    , fromChar              -- :: (ByteString `Reducer` m) => Char -> Rope m-    , fromWord8             -- :: (ByteString `Reducer` m) => Word8 -> Rope m+    , pack                  -- :: a `Reducer` Rope => a -> Roe+    , empty                 -- :: Rope+    , fromChunks            -- :: [ByteString] -> Rope+    , fromByteString        -- :: ByteString -> Rope+    , fromLazyByteString    -- :: L.ByteString -> Rope+    , fromString            -- :: String -> Rope+    , fromWords             -- :: [Word8] -> Rope+    , fromChar              -- :: Char -> Rope+    , fromWord8             -- :: Word8 -> Rope     -- * Analysis-    , length                -- :: Rope m -> Int-    , null                  -- :: Rope m -> Bool-    , body                  -- :: Rope a -> Body+    , length                -- :: Rope -> Int+    , null                  -- :: Rope -> Bool     -- * Deconstruction-    , toChunks              -- :: Rope m -> [S.ByteString]-    , toLazyByteString      -- :: Rope m -> L.ByteString+    , toChunks              -- :: Rope -> [ByteString]+    , toString              -- :: Rope -> String+    , toLazyByteString      -- :: Rope -> L.ByteString     -- * Cutting -    , Annotation(..)-    , elide     , splitAt     , take     , drop-    , uncons8-    , unsnoc8+    -- * Unpacking+    , Unpackable(..)+    , Breakable(..)+    -- Utility      , w2c-    -- * Pasting-    , Packable(..)-    , break8-    , findIndexOrEnd+    , findIndexOrEnd        -- :: (Word8 -> Bool) -> ByteString -> Int     ) where -import Prelude hiding (length, foldl, null, length, splitAt, take, drop, fst, snd) +import Prelude hiding (head, last, length, foldl, null, length, splitAt, take, drop, break, span)+import qualified Prelude+ import Control.Applicative hiding (empty)-import Control.Monad.Writer.Class (MonadWriter, tell, pass, listen) -import Data.Data (Data(..), DataType, Constr, Fixity(..), mkConstr, mkDataType, constrIndex, gcast1)-import Data.Typeable (TyCon, Typeable1(..), mkTyCon, mkTyConApp)+import Data.Data (Data(..), DataType, Constr, Fixity(..), mkConstr, mkDataType, constrIndex)+import Data.Typeable (Typeable(..))  import Data.FingerTree (ViewL(..),ViewR(..),viewl,viewr,(<|),(|>), Measured(..), (><)) import qualified Data.FingerTree as F (empty, split, null, singleton) -import Data.Foldable (Foldable, foldl) import qualified Data.Foldable as F -import Data.Traversable (Traversable)-import qualified Data.Traversable as T- import Data.Monoid  import Data.Rope.Body--- import Data.Rope.Util.Bifunctor-import Data.Rope.Util.Comonad import Data.Rope.Util.Reducer (Reducer, cons, snoc, unit)-import Data.Rope.Util.Product--- import Data.Rope.Util.Coproduct  import Data.Word (Word8) --- import Codec.Binary.UTF8.Generic (UTF8Bytes)--- import qualified Codec.Binary.UTF8.Generic as UTF8Bytes- import GHC.Base (unsafeChr)--- import GHC.IOBase--- import GHC.Ptr (Ptr(..))  import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable (peek) -import qualified Data.ByteString as S (null, splitAt, take, drop, length, singleton)+import qualified Data.ByteString as S (null, splitAt, take, drop, length, singleton, unpack, last) import Data.ByteString.Internal (ByteString(..), inlinePerformIO) import qualified Data.ByteString.Unsafe as S (unsafeTail, unsafeHead)-import qualified Data.ByteString.UTF8 as U--- import qualified Data.ByteString.Char8 as SC (pack)-import qualified Data.ByteString.Lazy as L (ByteString, pack, fromChunks, drop, take, splitAt, toChunks)-import qualified Data.ByteString.Lazy.UTF8 as LU+import qualified Data.ByteString.UTF8 as U (fromString)+import qualified Data.ByteString.Lazy as L (ByteString, pack, fromChunks, toChunks, elemIndex)+import qualified Data.ByteString.Lazy.UTF8 as LU (fromString, toString) --- a Buffer is a fingertree of non-empty chunks-data Rope a = Rope !Body a-    deriving (Show)+import Codec.Binary.UTF8.Generic (UTF8Bytes)+import qualified Codec.Binary.UTF8.Generic as UTF8Bytes -body :: Rope a -> Body-body (Rope b _) = b-{-# INLINE body #-}+-- a Buffer is a fingertree of non-empty chunks+newtype Rope = Rope { body :: Body } +    deriving (Show, Typeable) -instance Monoid a => Monoid (Rope a) where+instance Monoid Rope where     mempty = empty-    Rope t m `mappend` Rope t' m' = Rope (t >< t') (m `mappend` m')+    Rope t `mappend` Rope t' = Rope (t >< t') -instance Eq a => Eq (Rope a) where+instance Eq Rope where     a == b = measure (body a) == measure (body b)            && toLazyByteString a == toLazyByteString b -          && extract a == extract b -instance Measured Count (Rope a) where-    measure (Rope m _) = measure m --instance Functor Rope where-    fmap f (Rope b a) = Rope b (f a)---- monadic and applicative rope actions build up a fingertree as a result, and can be used like a fast string writer-instance Applicative Rope where-    pure = Rope mempty-    Rope m f <*> Rope m' a = Rope (m `mappend` m') (f a)--instance Monad Rope where-    return = Rope mempty-    Rope m a >>= f = let Rope m' b = f a in Rope (m `mappend` m') b-    -instance MonadWriter (Rope ()) Rope where-    tell (Rope m _) = Rope m ()-    listen (Rope m a) = Rope m (a, Rope m ())-    pass (Rope m (a,f)) = Rope (body (f (Rope m ()))) a---- on the other hand, the context-comonadic actions on ropes can be used to provide slicing of annotated ropes--- however, these two structures are largely unrelated, so make sure you know the purpose of your rope!--instance Comonad Rope where-    extract (Rope _ a) = a -    duplicate (Rope b a) = Rope b (Rope b a)-    extend f r = Rope (body r) (f r)+instance Ord Rope where+    a `compare` b = toLazyByteString a `compare` toLazyByteString b -instance Foldable Rope where-    foldr f z (Rope _ a) = f a z-    foldr1 _ (Rope _ a) = a -    foldl f z (Rope _ a) = f z a-    foldl1 _ (Rope _ a) = a-    foldMap f (Rope _ a) = f a+instance Measured Offset Rope where+    measure = measure . body -instance Traversable Rope where-    traverse f (Rope b a) = Rope b <$> f a+pack :: Reducer a Rope => a -> Rope+pack = unit+{-# INLINE pack #-} -empty :: Monoid m => Rope m-empty = Rope F.empty mempty+empty :: Rope+empty = Rope F.empty+{-# INLINE empty #-} -fromChunks :: (ByteString `Reducer` m) => [ByteString] -> Rope m-fromChunks = foldr (\l (Rope t m) -> Rope (l `cons'` t) (l `cons` m)) mempty+fromChunks :: [ByteString] -> Rope+fromChunks = foldr (\l (Rope t) -> Rope (l `cons'` t)) mempty {-# INLINE fromChunks #-} -toChunks :: Rope m -> [ByteString]+toChunks :: Rope -> [ByteString] toChunks r = unchunk <$> F.toList (body r) {-# INLINE toChunks #-} -toLazyByteString :: Rope m -> L.ByteString+toLazyByteString :: Rope -> L.ByteString toLazyByteString = L.fromChunks . toChunks {-# INLINE toLazyByteString #-} -length :: Rope m -> Int+toString :: Rope -> String+toString = unpack++length :: Rope -> Int length = measureBody . body {-# INLINE length #-} -null :: Rope m -> Bool+null :: Rope -> Bool null = F.null . body {-# INLINE null #-} -fromByteString :: (ByteString `Reducer` m) => ByteString -> Rope m +fromByteString :: ByteString -> Rope fromByteString b | S.null b = mempty -                 | otherwise = Rope (F.singleton (Chunk b)) (unit b)+                 | otherwise = Rope (F.singleton (Chunk b)) {-# INLINE fromByteString #-}  -- NB this requires a strict bytestring reducer, but a lazy bytestring-fromLazyByteString :: (ByteString `Reducer` m) => L.ByteString -> Rope m -fromLazyByteString = foldr (\l (Rope t m) -> Rope (Chunk l <| t) (l `cons` m)) mempty . L.toChunks+fromLazyByteString :: L.ByteString -> Rope+fromLazyByteString = foldr (\l (Rope t) -> Rope (Chunk l <| t)) mempty . L.toChunks {-# INLINE fromLazyByteString #-}  -- utf8 encode chunks of the string-fromString :: (ByteString `Reducer` m) => String -> Rope m+fromString :: String -> Rope fromString = fromLazyByteString . LU.fromString {-# INLINE fromString #-} -fromWords :: (ByteString `Reducer` m) => [Word8] -> Rope m+fromWords :: [Word8] -> Rope fromWords = fromLazyByteString . L.pack {-# INLINE fromWords #-} -fromChar :: (ByteString `Reducer` m) => Char -> Rope m-fromChar c = Rope (F.singleton (Chunk b)) (unit b)-    where b = U.fromString [c]+fromChar :: Char -> Rope+fromChar c = Rope (F.singleton (Chunk (U.fromString [c]))) {-# INLINE fromChar #-} -fromWord8 :: (ByteString `Reducer` m) => Word8 -> Rope m-fromWord8 b = Rope (F.singleton (Chunk s)) (unit s)-    where s = S.singleton b+fromWord8 :: Word8 -> Rope+fromWord8 b = Rope (F.singleton (Chunk (S.singleton b))) {-# INLINE fromWord8 #-} -cons8 :: (ByteString `Reducer` m) => Word8 -> Rope m -> Rope m-cons8 a (Rope t m) = case viewl t of-    Chunk c :< cs | S.length c < 16 -> Rope (Chunk (mappend b c) <| cs) (cons b m)-    _                               -> Rope (Chunk b <| t) (cons b m)+cons8 :: Word8 -> Rope -> Rope+cons8 a (Rope t) = case viewl t of+    Chunk c :< cs | S.length c < 16 -> Rope (Chunk (mappend b c) <| cs)+    _                               -> Rope (Chunk b <| t)     where b = S.singleton a {-# INLINE cons8 #-} -instance (Annotation a, Data a) => Data (Rope a) where+instance Data Rope where     gfoldl f z r = case uncons8 r of         Nothing -> z empty         Just (x,xs) -> z cons8 `f` x `f` xs @@ -209,7 +165,6 @@        | otherwise = consConstr      dataTypeOf _ = ropeDataType-    dataCast1 f = gcast1 f  emptyConstr, consConstr :: Constr emptyConstr = mkConstr ropeDataType "empty" [] Prefix@@ -218,138 +173,38 @@ ropeDataType :: DataType ropeDataType = mkDataType "Data.Rope.Internal.Rope" [emptyConstr, consConstr] -ropeTc :: TyCon-ropeTc = mkTyCon "Rope"--instance Typeable1 Rope  where -    typeOf1 _ = mkTyConApp ropeTc []---- HTTP--- import Network.BufferType--- import Network.TCP--class (ByteString `Reducer` a) => Annotation a where-    elide' :: Int -> Int -> Rope a -> a--- TODO---    elide' f l ra = fst (extract rlmr) `mappend` drop l (snd <$> rlmr) where---        rlmr = splitAt f (duplicate ra)--    splitAt' :: Int -> Rope a -> (a, a)--    take' :: Int -> Rope a -> a-    take' n = fst . splitAt' n--    drop' :: Int -> Rope a -> a-    drop' n = snd . splitAt' n --elide :: Annotation a => Int -> Int -> Rope a -> Rope a-elide f l = elide' f l . duplicate--splitAt :: Annotation a => Int -> Rope a -> (Rope a, Rope a)-splitAt n = splitAt' n . duplicate--take :: Annotation a => Int -> Rope a -> Rope a-take n = take' n . duplicate--drop :: Annotation a => Int -> Rope a -> Rope a-drop n = drop' n . duplicate--instance Annotation () where-    elide' _ _ _ = () -    splitAt' _ _ = ((),())-    take' _ _ = ()-    drop' _ _ = ()---- Int -> Int -> Rope (a,b) -> (a,b))--- Int -> Int -> Rope (a,b) -> ((a,a),(b,b))-instance (Annotation a, Annotation b) => Annotation (a, b) where-    elide' x y = bothC (elide' x y) (elide' x y)-    splitAt' x (Rope t (a,b)) = ((a',b'),(a'',b'')) where-        (a',a'') = splitAt' x (Rope t a)-        (b',b'') = splitAt' x (Rope t b)-    take' x = bothC (take' x) (take' x) -    drop' x = bothC (drop' x) (drop' x)--instance (Annotation a, Annotation b) => Annotation (a :*: b) where-    elide' x y = bothC (elide' x y) (elide' x y)-    splitAt' x (Rope t (a :*: b)) = ((a' :*: b'),(a'' :*: b'')) where-        (a',a'') = splitAt' x (Rope t a)-        (b',b'') = splitAt' x (Rope t b)-    take' x = bothC (take' x) (take' x) -    drop' x = bothC (drop' x) (drop' x)-{---- relies on the fact that ropes are cozippable having only one 'hole'-eitherC :: Coproduct s => (Rope a -> b) -> (Rope c -> d) -> Rope (s a c) -> s b d-eitherC f g (Rope t sab) = bimap (f . Rope t) (g . Rope t) sab---- TODO---instance (Annotation a, Annotation b) => Annotation (Either a b) where-    elide' x y = eitherC (elide' x y) (elide' x y)-    splitAt' x = eitherC (splitAt' x) (splitAt' x)-    take' x = eitherC (take' x) (take' x)-    drop' x = eitherC (drop' x) (drop' x)--instance (Annotation a, Annotation b) => Annotation (a :+ b) where-    elide' x y = eitherC (elide' x y) (elide' x y)-    splitAt' x = eitherC (splitAt' x) (splitAt' x)-    take' x = eitherC (take' x) (take' x)-    drop' x = eitherC (drop' x) (drop' x)--instance (Annotation a, Annotation b) => Annotation (a :+: b) where-    elide' x y = eitherC (elide' x y) (elide' x y)-    splitAt' x = eitherC (splitAt' x) (splitAt' x)-    take' x = eitherC (take' x) (take' x)-    drop' x = eitherC (drop' x) (drop' x)--}--instance Annotation ByteString where-    elide' = undefined-    splitAt' n rb = S.splitAt n (extract rb)-    take' n rb = S.take n (extract rb)-    drop' n rb = S.drop n (extract rb)--instance Annotation L.ByteString where-    elide' = undefined-    splitAt' n rb = L.splitAt (fromIntegral n) (extract rb)-    take' n rb = L.take (fromIntegral n) (extract rb)-    drop' n rb = L.drop (fromIntegral n) (extract rb)--instance Annotation Body where-    elide' = undefined-    splitAt' 0 rf = (mempty, extract rf)-    splitAt' n rf -        | n >= measureBody f = (f, mempty)-        | otherwise = (x `snoc'` y', y'' `cons'` z)+splitAt :: Int -> Rope -> (Rope,Rope)+splitAt n (Rope f)+        | n <= 0 = (mempty, Rope f)+        | n >= measureBody f = (Rope f, mempty)+        | otherwise = (Rope (x `snoc'` y'), Rope (y'' `cons'` z))         where-            f = extract rf-            (x,yz) = F.split (> Count n) (extract rf)+            (x,yz) = F.split (> Offset n) f             Chunk y :< z = viewl yz             (y', y'') = S.splitAt (n - measureBody x) y -instance Annotation a => Annotation (Rope a) where-    elide' = undefined-    splitAt' n rra = (Rope t a, Rope t' a') where-        (t,t') = splitAt' n (body <$> rra)-        (a,a') = splitAt' n (extract rra)+take :: Int -> Rope -> Rope+take n = fst . splitAt n+{-# INLINE take #-} -{---- DO NOT USE! For testing purposes only. You'll have terrible O(n^2) asymptotics!-instance Ord k => Annotation (Map Int v) where-    splitAt k a = (l, M.mapKeysMonotonic (subtract k) $ maybe id (M.insert k) r) where (l,m,r) = M.splitLookup k (extract a)+drop :: Int -> Rope -> Rope+drop n = snd . splitAt n+{-# INLINE drop #-} --- DO NOT USE! For testing purposes only. You'll have terrible O(n^2) asymptotics!-instance Ord k => Annotation (Set Int) where-    splitAt k s = (l, S.mapKeysMonotonic (subtract k) $ maybe id S.insert r) where-        (l,m,r) = S.splitLookup k (extract a)--}+class Breakable a where+    break :: (a -> Bool) -> Rope -> (Rope, Rope)+    span :: (a -> Bool) -> Rope -> (Rope, Rope)+    takeWhile :: (a -> Bool) -> Rope -> Rope+    dropWhile :: (a -> Bool) -> Rope -> Rope -break8 :: Annotation m => (Word8 -> Bool) -> Rope m -> (Rope m, Rope m)-break8 f r = (Rope t' a', Rope t'' a'')+    span f = break (not . f)+    takeWhile f = fst . span f+    dropWhile f = snd . span f++break8 :: (Word8 -> Bool) -> Rope -> (Rope, Rope)+break8 f r = (Rope t', Rope t'')     where          (t',t'') = break' (body r)-        (a',a'') = splitAt' (measureBody t') r          break' ccs = case viewl ccs of            EmptyL -> (F.empty, F.empty)            Chunk c :< cs -> case findIndexOrEnd f c of @@ -357,7 +212,11 @@                 n | n < S.length c -> (F.singleton (Chunk (S.take n c)), Chunk (S.drop n c) <| cs)                   | otherwise      -> let (cs', cs'') = break' cs                                       in (Chunk c <| cs', cs'')+{-# INLINE break8 #-} +instance Breakable Word8 where+    break = break8+ findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int findIndexOrEnd k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0   where@@ -369,105 +228,136 @@                                 else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndexOrEnd #-} -uncons8 :: Annotation m => Rope m -> Maybe (Word8, Rope m)+uncons8 :: Rope -> Maybe (Word8, Rope) uncons8 r = case viewl (body r) of-    Chunk c :< cs -> Just (S.unsafeHead c, Rope (S.unsafeTail c `cons'` cs) (drop' 1 r))+    Chunk c :< cs -> Just (S.unsafeHead c, Rope (S.unsafeTail c `cons'` cs))     _ -> Nothing+{-# INLINE uncons8 #-} -unsnoc8 :: Annotation m => Rope m -> Maybe (Rope m, Word8)+unsnoc8 :: Rope -> Maybe (Rope, Word8) unsnoc8 r = case viewr (body r) of-    cs :> Chunk c -> Just (Rope (cs `snoc'` S.unsafeTail c) (take' (length r - 1) r), S.unsafeHead c)+    cs :> Chunk c -> Just (Rope (cs `snoc'` S.unsafeTail c), S.unsafeHead c)     _ -> Nothing---{--instance Annotation m => UTF8Bytes (Rope m) Int where-    bsplit n = splitAt n-    bdrop n = drop n -    buncons = uncons8-    elemIndex = undefined-    null = undefined-    pack = undefined-    tail r = case viewl (body r) of-        Chunk a :< as -> Rope (S.unsafeTail a `cons'` as) (drop' 1 r)-        EmptyL -> error "Codec.Binary.UTF8.Generic.UTF8Bytes.tail (Kata.Rope m): error empty list"--}+{-# INLINE unsnoc8 #-}  w2c :: Word8 -> Char w2c = unsafeChr . fromIntegral+{-# INLINE w2c #-} -{---- towards interoperating directly with Network.HTTP--- unfortunately the machinery needed to implement HStream isn't exported, so this doesn't get us anywhere-instance Annotation m => BufferType (Rope m) where-    bufferOps = BufferOp-        { buf_hGet = \h i -> singleton <$> buf_hGet lazyBufferOp h i-        , buf_hGetContents = \h -> singleton <$> buf_hGetContents lazyBufferOp h-        , buf_hPut = \h b -> buf_hPut lazyBufferOp h (toLazy b)-        , buf_hGetLine = \h -> singleton <$> buf_hGetLine lazyBufferOp h-        , buf_empty = mempty-        , buf_append = mappend-        , buf_concat = mconcat-        , buf_fromStr = fromLazyByteString . buf_fromStr lazyBufferOp-        , buf_toStr = buf_toStr lazyBufferOp . toLazy-        , buf_snoc = snoc-        , buf_splitAt = splitAt-        , buf_span = \f -> break8 (not . f . w2c)-        , buf_isLineTerm = (unit (SC.pack "\r\n") ==)-        , buf_isEmpty = null-        }--}+instance Reducer Char Rope where+    unit = fromChar+    cons a (Rope t) = case viewl t of+        Chunk c :< cs | S.length c < 16 -> Rope (Chunk (mappend b c) <| cs)+        _ -> Rope (Chunk b <| t)+        where b = U.fromString [a]+    snoc (Rope t) a = case viewr t of+        cs :> Chunk c | S.length c < 16 -> Rope (cs |> Chunk (mappend c b))+        _ -> Rope (t |> Chunk b)+        where b = U.fromString [a] -class Packable a where-    pack  :: Annotation m => a -> Rope m-    packl :: Annotation m => a -> Rope m -> Rope m-    packr :: Annotation m => Rope m -> a -> Rope m+instance Reducer Word8 Rope where+    unit = fromWord8+    cons = cons8 +    snoc (Rope t) a = case viewr t of+        cs :> Chunk c | S.length c < 16 -> Rope (cs |> Chunk (mappend c b))+        _ -> Rope (t |> Chunk b)+        where b = S.singleton a -    packl a r = pack a `mappend` r-    packr r a = r `mappend` pack a+instance Reducer Rope Rope where+    unit = id -instance Packable Char where-    pack = fromChar-    packl a (Rope t m) = case viewl t of-        Chunk c :< cs | S.length c < 16 -> Rope (Chunk (mappend b c) <| cs) (cons b m)-        _ -> Rope (Chunk b <| t) (cons b m)-        where b = U.fromString [a]+instance Reducer String Rope where+    unit = fromString -    packr (Rope t m) a = case viewr t of-        cs :> Chunk c | S.length c < 16 -> Rope (cs |> Chunk (mappend c b)) (snoc m b)-        _ -> Rope (t |> Chunk b) (snoc m b)-        where b = U.fromString [a]+instance Reducer [Word8] Rope where+    unit = fromWords -instance Packable Word8 where-    pack = fromWord8-    packl = cons8 +instance Reducer ByteString Rope where+    unit = fromByteString -    packr (Rope t m) a = case viewr t of-        cs :> Chunk c | S.length c < 16 -> Rope (cs |> Chunk (mappend c b)) (snoc m b)-        _ -> Rope (t |> Chunk b) (snoc m b)-        where b = S.singleton a+instance Reducer L.ByteString Rope where+    unit = fromLazyByteString --- note this isn't a no-op, you can change annotations!-instance Annotation n => Packable (Rope n) where-    pack (Rope t _) = Rope t (foldl (\a b -> a `snoc` unchunk b) mempty t)+instance Reducer Chunk Rope where+    unit = fromByteString . unchunk  -instance Packable String where-    pack = fromString -instance Packable [Word8] where-    pack = fromWords+instance UTF8Bytes Rope Int where+    bsplit = splitAt +    bdrop = drop +    buncons f = case viewl (body f) of+        Chunk c :< cs -> Just (S.unsafeHead c, Rope (S.unsafeTail c `cons' ` cs))+        EmptyL -> Nothing+    tail (Rope f) = case viewl f of+        Chunk c :< cs -> Rope (S.unsafeTail c `cons'`cs)+        EmptyL -> errorEmptyList "tail"+    elemIndex b = fmap fromIntegral . L.elemIndex b . L.fromChunks . map unchunk . F.toList . body+    pack = Rope . foldr (\l r -> Chunk l <| r) F.empty . L.toChunks . L.pack+    empty = Rope F.empty+    null = F.null . body -instance Packable ByteString where-    pack = fromByteString -instance Packable L.ByteString where-    pack = fromLazyByteString+class Unpackable a where+    unpack :: Rope -> [a] -instance Packable Chunk where-    pack = fromByteString . unchunk +    head :: Rope -> a+    head = Prelude.head . unpack -instance (Packable a, Annotation m) => Reducer a (Rope m) where-    unit = pack-    cons = packl-    snoc = packr+    last :: Rope -> a++    uncons :: Rope -> Maybe (a, Rope)+    unsnoc :: Rope -> Maybe (Rope, a)++instance Unpackable Word8 where+    unpack = concatMap (S.unpack . unchunk) . F.toList . body+    head t = case viewl (body t) of+        Chunk a :< _ -> S.unsafeHead a+        EmptyL -> errorEmptyList "head"+    last t = case viewr (body t) of+        _ :> Chunk a -> S.last a+        EmptyR -> errorEmptyList "last"+    uncons = uncons8+    unsnoc = unsnoc8++instance Unpackable Char where+    unpack = LU.toString . toLazyByteString+    head = Prelude.head . unpack+    last = undefined -- TODO+    uncons r@(Rope t) = case UTF8Bytes.decode (Rope t) of +        Nothing -> Nothing+        Just (a,n) -> Just (a, drop n r)+    unsnoc = undefined -- TODO++instance Unpackable ByteString where+    unpack = map unchunk . F.toList . body+    head r = case viewl (body r) of+        Chunk a :< _ -> a+        _ -> errorEmptyList "head"+    last r = case viewr (body r) of+        _ :> Chunk a -> a+        _ -> errorEmptyList "last" +    uncons r = case viewl (body r) of+        Chunk a :< as -> Just (a, Rope as)+        EmptyL -> Nothing+    unsnoc r = case viewr (body r) of+        as :> Chunk a -> Just (Rope as, a)+        EmptyR -> Nothing++instance Unpackable Chunk where+    unpack = F.toList . body+    head r = case viewl (body r) of+        a :< _ -> a+        _ -> errorEmptyList "head"+    last r = case viewr (body r) of+        _ :> a -> a+        _ -> errorEmptyList "last"+    uncons r = case viewl (body r) of+        Chunk a :< as -> Just (Chunk a, Rope as)+        EmptyL -> Nothing+    unsnoc r = case viewr (body r) of+        as :> Chunk a -> Just (Rope as, Chunk a)+        EmptyR -> Nothing++errorEmptyList :: String -> a+errorEmptyList t = error $ "Data.Rope.Unpackable." ++ t ++ ": empty list"   

@@ -1,120 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-module Data.Rope.Unpackable-    ( Unpackable(..)-    ) where--import Prelude hiding (head, last, drop)-import qualified Prelude--import Data.Word (Word8)-import Data.Monoid (Monoid, mempty, mappend)-import qualified Data.Foldable as F--import qualified Data.FingerTree as F (empty, null, split)-import Data.FingerTree (FingerTree, ViewL(..),ViewR(..),viewl,viewr,(<|),(><))--import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as S (unsafeTail, unsafeHead)-import qualified Data.ByteString.UTF8 as U-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.UTF8 as LU--import Data.Rope.Body (Count(..), Chunk(..), cons', snoc', measureBody) -- Chunk-import Data.Rope.Internal (Annotation(..), drop, Rope(..), body, toLazyByteString, uncons8, unsnoc8) -- Rope, etc.-import Codec.Binary.UTF8.Generic (UTF8Bytes)-import qualified Codec.Binary.UTF8.Generic as UTF8Bytes--class Unpackable a where-    unpack :: Rope m -> [a]--    head :: Rope m -> a-    head = Prelude.head . unpack--    last :: Rope m -> a--    uncons :: Annotation m => Rope m -> Maybe (a, Rope m)-    unsnoc :: Annotation m => Rope m -> Maybe (Rope m, a)--newtype F = F { runF :: FingerTree Count Chunk } --instance Monoid F where-    mempty = F F.empty-    F a `mappend` F b = F (a >< b)--instance UTF8Bytes F Int where-    bsplit 0 (F f) = (mempty, F f)-    bsplit n (F f)-        | n >= measureBody f = (F f, mempty)-        | otherwise = (F (x `snoc'` y'), F (y'' `cons'` z))-        where-            (x, yz) = F.split (> Count n) f-            Chunk y :< z = viewl yz-            (y', y'') = S.splitAt (n - measureBody x) y-    bdrop n = snd . UTF8Bytes.bsplit n-    buncons f = case viewl (runF f) of-        Chunk c :< cs -> Just (S.unsafeHead c, F (S.unsafeTail c `cons' ` cs))-        EmptyL -> Nothing-    tail (F f) = case viewl f of-        Chunk c :< cs -> F (S.unsafeTail c `cons'`cs)-        EmptyL -> errorEmptyList "tail"-    elemIndex b = fmap fromIntegral . L.elemIndex b . L.fromChunks . map unchunk . F.toList . runF-    pack = F . foldr (\l r -> Chunk l <| r) F.empty . L.toChunks . L.pack-    empty = F F.empty-    null = F.null . runF---- w2c :: Word8 -> Char--- w2c = unsafeChr . fromIntegral---instance Unpackable Word8 where-    unpack = concatMap (S.unpack . unchunk) . F.toList . body-    head (Rope t _) = case viewl t of-        Chunk a :< _ -> S.head a-        EmptyL -> errorEmptyList "head"-    last (Rope t _) = case viewr t of-        _ :> Chunk a -> S.last a-        EmptyR -> errorEmptyList "last"-    uncons = uncons8-    unsnoc = unsnoc8--instance Unpackable Char where-    unpack = LU.toString . toLazyByteString-    head = Prelude.head . unpack-    last = undefined -- TODO-    uncons r@(Rope t _) = case UTF8Bytes.decode (F t) of -        Nothing -> Nothing-        Just (a,n) -> Just (a, drop n r)-    unsnoc = undefined -- TODO--instance Unpackable S.ByteString where-    unpack = map unchunk . F.toList . body-    head r = case viewl (body r) of-        Chunk a :< _ -> a-        _ -> errorEmptyList "head"-    last r = case viewr (body r) of-        _ :> Chunk a -> a-        _ -> errorEmptyList "last" -    uncons r = case viewl (body r) of-        Chunk a :< as -> Just (a, Rope as (drop' (S.length a) r))-        EmptyL -> Nothing-    unsnoc r = case viewr (body r) of-        as :> Chunk a -> Just (Rope as (take' (measureBody as) r), a)-        EmptyR -> Nothing--instance Unpackable Chunk where-    unpack = F.toList . body-    head r = case viewl (body r) of-        a :< _ -> a-        _ -> errorEmptyList "head"-    last r = case viewr (body r) of-        _ :> a -> a-        _ -> errorEmptyList "last"-    uncons r = case viewl (body r) of-        Chunk a :< as -> Just (Chunk a, Rope as (drop' (S.length a) r))-        EmptyL -> Nothing-    unsnoc r = case viewr (body r) of-        as :> Chunk a -> Just (Rope as (take' (measureBody as) r), Chunk a)-        EmptyR -> Nothing--errorEmptyList :: String -> a-errorEmptyList t = error $ "Kata.Rope.Unpackable." ++ t ++ ": empty list"  

@@ -1,22 +0,0 @@-module Data.Rope.Util.Bifunctor (Bifunctor(..)) where--class Bifunctor f where-    bimap :: (a -> b) -> (c -> d) -> f a c -> f b d-    first :: (a -> b) -> f a c -> f b c-    second :: (b -> c) -> f a b -> f a c-    first f = bimap f id-    second = bimap id-    bimap f g = second g . first f--instance Bifunctor (,) where-    bimap f g ~(a,b) = (f a, g b)-    first f ~(a,b) = (f a, b)-    second g ~(a,b) = (a, g b)-    -instance Bifunctor Either where-    bimap f _ (Left a) = Left (f a)-    bimap _ g (Right b) = Right (g b)-    first f (Left a) = Left (f a)-    first _ (Right b) = Right b-    second _ (Left a) = Left a-    second g (Right b) = Right (g b)

@@ -1,11 +0,0 @@-module Data.Rope.Util.Comonad -    ( Comonad(..)-    ) where--class Functor w => Comonad w where-    extract :: w a -> a-    duplicate :: w a -> w (w a)-    extend :: (w a -> b) -> w a -> w b--    duplicate = extend id-    extend f = fmap f . duplicate

@@ -1,84 +0,0 @@-{-# LANGUAGE TypeOperators #-}-module Data.Rope.Util.Coproduct-    ( (:+:)(..)-    , (:+)(..)-    , Coproduct(..)-    , counzip-    ) where--import Control.Applicative-import Data.Rope.Util.Bifunctor--counzip :: (Coproduct s, Coproduct s', Functor f) => s (f a) (f b) -> f (s' a b)-counzip = fmap left ||| fmap right---- a coproduct that is strict in its left argument only-data a :+ b = Inl !a-            | Inr b--instance Bifunctor (:+) where-    first f (Inl a) = Inl (f a)-    first _ (Inr b) = Inr b-    second _ (Inl a) = Inl a-    second g (Inr b) = Inr (g b)-    bimap f _ (Inl a) = Inl (f a)-    bimap _ g (Inr b) = Inr (g b)--instance Functor ((:+) a) where-    fmap _ (Inl a) = Inl a-    fmap g (Inr b) = Inr (g b)--instance Applicative ((:+)  a) where-    pure = Inr-    Inl a <*> _ = Inl a-    Inr _ <*> Inl a = Inl a-    Inr f <*> Inr a = Inr (f a)-    -instance Monad ((:+) a) where-    return = Inr-    Inl a >>= _ = Inl a-    Inr a >>= f = f a--class Bifunctor s => Coproduct s where-    left :: a -> s a b-    right :: b -> s a b-    (|||) :: (a -> c) -> (b -> c) -> s a b -> c-    codiag :: s a a -> a--instance Coproduct Either where-    left = Left-    right = Right-    (|||) = either-    codiag (Left a) = a-    codiag (Right a) = a--instance Coproduct (:+) where-    left = Inl-    right = Inr-    (|||) f _ (Inl a) = f a-    (|||) _ g (Inr b) = g b-    codiag (Inl a) = a -    codiag (Inr a) = a--data a :+: b = Left' !a -             | Right' !b--instance Bifunctor (:+:) where-    first f (Left' a) = Left' (f a)-    first _ (Right' b) = Right' b-    second _ (Left' a) = Left' a-    second g (Right' b) = Right' (g b)-    bimap f _ (Left' a) = Left' (f a)-    bimap _ g (Right' b) = Right' (g b)--instance Functor ((:+:) a) where-    fmap _ (Left' a) = Left' a-    fmap g (Right' b) = Right' (g b)--instance Coproduct (:+:) where-    left = Left'-    right = Right'-    (|||) f _ (Left' a) = f a-    (|||) _ g (Right' b) = g b-    codiag (Left' a) = a-    codiag (Right' a) = a

@@ -1,77 +0,0 @@-{-# LANGUAGE TypeOperators, FlexibleInstances, MultiParamTypeClasses #-}-module Data.Rope.Util.Product-    ( (:*:)(..)-    , Product(..), bothC-    , unzip-    ) where--import Data.Monoid hiding (Product(..))-import Data.Rope.Util.Comonad-import Data.Rope.Util.Bifunctor-import Data.Rope.Util.Reducer-import Prelude hiding (fst, snd, curry, uncurry, either, unzip)-import qualified Prelude as P---- a product that is strict in both arguments-data a :*: b = !a :*: !b--instance Bifunctor (:*:) where-    first f (a :*: b) = f a :*: b-    second f (a :*: b) = a :*: f b-    bimap f g (a :*: b) = f a :*: g b--instance Functor ((:*:) a) where-    fmap f (a :*: b) = a :*: f b--instance Comonad ((:*:) a) where-    extract (_ :*: b) = b-    extend f ab@(a :*: _) = a :*: f ab-    duplicate ab@(a :*: _) = a :*: ab--instance (Monoid a, Monoid b) => Monoid (a :*: b) where-    mempty = mempty :*: mempty-    (a :*: b) `mappend` (c :*: d) = mappend a c :*: mappend b d--instance (Reducer c a, Reducer c b) => Reducer c (a :*: b) where-    unit c = unit c :*: unit c-    cons c (a :*: b) = cons c a :*: cons c b-    snoc (a :*: b) c = snoc a c :*: snoc b c --class Bifunctor p => Product p where-    fst :: p a b -> a-    snd :: p a b -> b-    pair :: a -> b -> p a b-    curry :: (p a b -> c) -> a -> b -> c-    uncurry :: (a -> b -> c) -> p a b -> c-    both :: (a -> b) -> (a -> c) -> a -> p b c-    diag :: a -> p a a--    diag = both id id-    both f g = bimap f g . diag--instance Product (:*:) where-    fst (a :*: _) = a-    snd (_ :*: b) = b-    pair = (:*:)-    curry f a b = f (a :*: b)-    uncurry f (a :*: b) = f a b-    both f g a = f a :*: g a-    diag a = a :*: a--instance Product (,) where-    fst = P.fst-    snd = P.snd-    pair = (,)-    curry = P.curry-    uncurry = P.uncurry-    both f g a = (f a, g a)-    diag a = (a, a)--unzip :: (Product p, Functor f) => f (p a b) -> p (f a) (f b)-unzip = both (fmap fst) (fmap snd)-{-# INLINE unzip #-}---- CoKleisli (&&&)-bothC :: (Product p, Functor f) => (f a -> b) -> (f c -> d) -> f (p a c) -> p b d-bothC f g = both (f . fmap fst) (g . fmap snd)-{-# INLINE bothC #-}

@@ -12,7 +12,7 @@ import Control.Applicative import Control.Monad  import qualified Data.FingerTree as FingerTree-import Data.FingerTree (FingerTree, Measured, (><))+import Data.FingerTree (FingerTree, Measured) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy 

@@ -1,1 +1,30 @@-All Rights Reserved+Copyright (c) 2010, Edward Kmett+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 Isaac Jones 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.

@@ -1,5 +1,5 @@ name:           rope-version:        0.1+version:        0.2 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -7,8 +7,8 @@ stability:      experimental homepage:       http://comonad.com/reader category:       Language-synopsis:       Tools for manipulating annotated ropes of bytestrings-description:    Tools for manipulating annotated ropes of bytestrings+synopsis:       Tools for manipulating fingertrees of bytestrings+description:    Tools for manipulating fingertrees of bytestrings copyright:      (c) 2010 Edward A. Kmett build-type:     Simple cabal-version:  >=1.2@@ -19,17 +19,11 @@     base >= 4 && < 6,      bytestring >= 0.9.1.4 && < 0.10,     fingertree >= 0.0.1 && < 0.1,-    mtl >= 1.1 && < 1.2,     utf8-string >= 0.3.5 && < 0.4   exposed-modules:     Data.Rope     Data.Rope.Body     Data.Rope.Internal-    Data.Rope.Unpackable-    Data.Rope.Util.Bifunctor-    Data.Rope.Util.Comonad-    Data.Rope.Util.Coproduct-    Data.Rope.Util.Product     Data.Rope.Util.Reducer        ghc-options: -Wall