rope 0.5 → 0.6

raw patch · 14 files changed

+391/−408 lines, 14 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• Data/Rope.hs +2/−2
• Data/Rope/Annotated.hs +64/−67
• Data/Rope/Annotated/Internal.hs +0/−59
• Data/Rope/Annotation.hs +17/−18
• Data/Rope/Annotation/Product.hs +14/−14
• Data/Rope/Annotation/Unit.hs +11/−11
• Data/Rope/Body.hs +11/−13
• Data/Rope/Branded.hs +106/−0
• Data/Rope/Branded/Comonad.hs +11/−0
• Data/Rope/Internal.hs +34/−29
• Data/Rope/Unsafe.hs +114/−0
• Data/Rope/Util/Comonad.hs +0/−11
• Data/Rope/Util/Reducer.hs +0/−179
• rope.cabal +7/−5

@@ -10,7 +10,7 @@     , drop      -- :: Int -> Rope -> Rope     -- * Walking     -- ** construction-    , Reducer(..)+    , Packable(..)     , empty              -- :: Rope     , fromByteString     -- :: ByteString -> Rope     , fromChunks         -- :: [ByteString] -> Rope@@ -27,7 +27,6 @@     ) where  import Prelude hiding (null,head,length,drop,take,splitAt, last)-import Data.Rope.Util.Reducer (Reducer(..)) import Data.Rope.Internal      ( Rope     , empty@@ -43,6 +42,7 @@     , toString     , toChunks     , toLazyByteString+    , Packable(..)     , Breakable(..)     , Unpackable(..)     , splitAt

@@ -4,41 +4,41 @@              TypeFamilies, IncoherentInstances, OverlappingInstances #-} module Data.Rope.Annotated     ( -- * Annotated 'Rope's -      A(rope)   +      Branded(context)        , Ann-    , MonoidA, ReducerA, BreakableA -    , runAnn     -- :: Ann a f -> (forall b. Ann b f -> r) -> r+    , MonoidalAnn, PackableAnn, BreakableAnn +    , runAnn     -- :: Ann f a -> (forall b. Ann b f -> r) -> r        -- * Unpacking 'Ropes'-    , null      -- :: A s a -> Bool-    , head      -- :: Unpackable t => A s a -> t-    , last      -- :: Unpackable t => A s a -> t-    , unpack    -- :: Unpackable t => A s a -> [t]+    , null      -- :: (s `Branded` Rope) a -> Bool+    , head      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , last      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , unpack    -- :: Unpackable t => (s `Branded` Rope) a -> [t]        -- * Building Annotated 'Rope'-    , empty     -- :: MonoidA f => Ann Empty f -    , append    -- :: MonoidA f => Ann a f -> Ann b f -> Ann (a :<> b) f+    , empty     -- :: MonoidalAnn f => Ann Empty f +    , append    -- :: MonoidalAnn f => Ann f a -> Ann f b -> Ann f (a :<> b) -    , unit      -- :: (ReducerA f, Reducer t Rope) => t -> (forall a. Ann (Return a) f -> r) -> r-    , snoc      -- :: (ReducerA f, Reducer t Rope) => t -> Ann a f -> (forall c. Ann (Snoc c t a) f -> r) -> r-    , cons      -- :: (ReducerA f, Reducer t Rope) => Ann a f -> t -> (forall c. Ann (Cons c t a) f -> r) -> r+    , pack      -- :: (PackableAnn f, Packable t) => t -> (forall a. Ann f (Return a) -> r) -> r+    , snoc      -- :: (PackableAnn f, Packable t) => t -> Ann f a -> (forall c. Ann f (Snoc c t a) -> r) -> r+    , cons      -- :: (PackableAnn f, Packable t) => Ann f a -> t -> (forall c. Ann f (Cons c t a) -> r) -> r        -- * Cutting An Annotated 'Rope'-    , splitAt   -- :: (BreakablaA f) => Int -> Ann a f -> (forall n. Ann (Take n a) f -> Ann (Drop n a) f -> r) -> r-    , drop      -- :: (BreakableA f) => Int -> Ann a f -> (forall n. Ann (Drop n a) f -> r) -> r-    , take      -- :: (BreakablaA f) => Int -> Ann a f -> (forall n. Ann (Take n a) f -> r) -> r+    , splitAt   -- :: (BreakablaAnn f) => Int -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+    , drop      -- :: (BreakableAnn f) => Int -> Ann f a -> (forall n. Ann f (Drop n a) -> r) -> r+    , take      -- :: (BreakablaAnn f) => Int -> Ann f a -> (forall n. Ann f (Take n a) -> r) -> r -    , break     -- :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> Ann (Drop n a) f -> r) -> r-    , span      -- :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> Ann (Drop n a) f -> r) -> r-    , takeWhile -- :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> r) -> r-    , dropWhile -- :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Drop n a) f -> r) -> r+    , break     -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+    , span      -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+    , takeWhile -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> r) -> r+    , dropWhile -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Drop n a) -> r) -> r      -- * Inspecting the ends of the 'Rope'-    , uncons    -- :: (BreakableA f, Unpackable t) => Ann a f -> Maybe (t, Ann (Tail t b) f)-    , unsnoc    -- :: (BreakableA f, Unpackable t) => Ann a f -> Maybe (Ann (Init b t) f, t)+    , uncons    -- :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (t, Ann f (Tail t b))+    , unsnoc    -- :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (Ann f (Init b t), t)      -- * Type-level constructors-    , Drop, Take, Snoc, Cons, Tail, Init, Return, Nil , (:<>)+    , Drop, Take, Snoc, Cons, Tail, Init, Return, (:<>)     , Tailed, Inited, Dropped, Taken, Nil, (:>)      -- * Annotations@@ -55,17 +55,14 @@  import qualified Data.Rope.Internal as Rope -import Data.Rope.Annotated.Internal (A(..), null, head, last, unpack)+import Data.Rope.Branded (Branded(..), null, head, last, unpack) import Data.Rope.Annotation import Data.Rope.Annotation.Product import Data.Rope.Annotation.Unit -import Data.Rope.Util.Reducer (Reducer)-import qualified Data.Rope.Util.Reducer as Reducer--import Data.Rope.Internal (Rope(..),Breakable, Unpackable)+import Data.Rope.Internal (Rope(..), Breakable, Unpackable, Packable) -type Ann a f = A a (f a)+type Ann f s = (s `Branded` Rope) (f s)  data Nil data a :> b @@ -95,66 +92,66 @@ data Inited a t type Init a t = Return (Inited a t) -runAnn :: Ann a f -> (forall b. Ann b f -> r) -> r+runAnn :: Ann f a -> (forall b. Ann f b -> r) -> r runAnn a k = k a  -empty :: MonoidA f => Ann Nil f-empty = A Rope.empty emptyA+empty :: MonoidalAnn f => Ann f Nil+empty = Branded Rope.empty emptyAnn -append :: MonoidA f => Ann a f -> Ann b f -> Ann (a :<> b) f-append (A r a) (A s b) = A (r `mappend` s) (appendA r a s b)+append :: MonoidalAnn f => Ann f a -> Ann f b -> Ann f (a :<> b)+append (Branded r a) (Branded s b) = Branded (r `mappend` s) (appendAnn r a s b) -unit :: (ReducerA f, Reducer t Rope) => t -> (forall a. Ann (Return a) f -> r) -> r-unit t k = k (A r (unitA r)) +pack :: (PackableAnn f, Packable t) => t -> (forall a. Ann f (Return a) -> r) -> r+pack t k = k (Branded r (packAnn r))      where          r :: Rope-        r = Reducer.unit t+        r = Rope.pack t -splitAt :: BreakableA f => Int -> Ann a f -> (forall n. Ann (Take n a)  f -> Ann (Drop n a) f -> r) -> r-splitAt n (A r a) k = k (A r b) (A r c) -    where (b, c) = splitAtA n r a+splitAt :: BreakableAnn f => Int -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+splitAt n (Branded r a) k = k (Branded r b) (Branded r c) +    where (b, c) = splitAtAnn n r a -drop :: BreakableA f => Int -> Ann a f -> (forall n. Ann (Drop n a) f -> r) -> r-drop n (A r a) k = k (A r (dropA n r a))+drop :: BreakableAnn f => Int -> Ann f a -> (forall n. Ann f (Drop n a) -> r) -> r+drop n (Branded r a) k = k (Branded r (dropAnn n r a)) -take :: BreakableA f => Int -> Ann a f -> (forall n. Ann (Take n a) f -> r) -> r-take n (A r a) k = k (A r (takeA n r a))+take :: BreakableAnn f => Int -> Ann f a -> (forall n. Ann f (Take n a) -> r) -> r+take n (Branded r a) k = k (Branded r (takeAnn n r a)) -snoc :: (ReducerA f, Reducer t Rope) => Ann a f -> t -> (forall c. Ann (Snoc a c t) f -> r) -> r-snoc (A r a) t k = k (A r' (snocA (Rope.length r' - Rope.length r) r' a))-    where r' = Reducer.snoc r t +snoc :: (PackableAnn f, Packable t) => Ann f a -> t -> (forall c. Ann f (Snoc a c t) -> r) -> r+snoc (Branded r a) t k = k (Branded r' (snocAnn (Rope.length r' - Rope.length r) r' a))+    where r' = Rope.snoc r t  -cons :: (ReducerA f, Reducer t Rope) => t -> Ann a f -> (forall c. Ann (Cons c t a) f -> r) -> r-cons t (A r a) k = k (A r' (consA (Rope.length r' - Rope.length r) r' a))-    where r' = Reducer.cons t r+cons :: (PackableAnn f, Packable t) => t -> Ann f a -> (forall c. Ann f (Cons c t a) -> r) -> r+cons t (Branded r a) k = k (Branded r' (consAnn (Rope.length r' - Rope.length r) r' a))+    where r' = Rope.cons t r -break :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> Ann (Drop n a) f -> r) -> r-break p (A r a) k = k (A x b) (A y c) where+break :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+break p (Branded r a) k = k (Branded x b) (Branded y c) where     (x,y) = Rope.break p r-    (b,c) = splitAtA (Rope.length x) r a+    (b,c) = splitAtAnn (Rope.length x) r a -span :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> Ann (Drop n a) f -> r) -> r-span p (A r a) k = k (A x b) (A y c) where+span :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> Ann f (Drop n a) -> r) -> r+span p (Branded r a) k = k (Branded x b) (Branded y c) where     (x,y) = Rope.span p r-    (b,c) = splitAtA (Rope.length x) r a+    (b,c) = splitAtAnn (Rope.length x) r a -takeWhile :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Take n a) f -> r) -> r-takeWhile p (A r a) k = k (A x b) where+takeWhile :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Take n a) -> r) -> r+takeWhile p (Branded r a) k = k (Branded x b) where     x = Rope.takeWhile p r-    b = takeA (Rope.length x) r a+    b = takeAnn (Rope.length x) r a -dropWhile :: (BreakableA f, Breakable t) => (t -> Bool) -> Ann a f -> (forall n. Ann (Drop n a) f -> r) -> r-dropWhile p (A r a) k = k (A y c) where+dropWhile :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (forall n. Ann f (Drop n a) -> r) -> r+dropWhile p (Branded r a) k = k (Branded y c) where     y = Rope.dropWhile p r-    c = dropA (Rope.length r - Rope.length y) r a+    c = dropAnn (Rope.length r - Rope.length y) r a -uncons :: (BreakableA f, Unpackable t) => Ann a f -> Maybe (t, Ann (Tail t a) f)-uncons (A r a) = case Rope.uncons r of-    Just (c,cs) -> Just (c, A cs (dropA (Rope.length r - Rope.length cs) r a))+uncons :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (t, Ann f (Tail t a))+uncons (Branded r a) = case Rope.uncons r of+    Just (c,cs) -> Just (c, Branded cs (dropAnn (Rope.length r - Rope.length cs) r a))     Nothing -> Nothing -unsnoc :: (BreakableA f, Unpackable t) => Ann a f -> Maybe (Ann (Init a t) f, t)-unsnoc (A r a) = case Rope.unsnoc r of-    Just (cs,c) -> Just (A cs (dropA (Rope.length cs) r a), c)+unsnoc :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (Ann f (Init a t), t)+unsnoc (Branded r a) = case Rope.unsnoc r of+    Just (cs,c) -> Just (Branded cs (dropAnn (Rope.length cs) r a), c)     Nothing -> Nothing 

@@ -1,59 +0,0 @@-{-# LANGUAGE TypeOperators, Rank2Types, EmptyDataDecls, -             MultiParamTypeClasses, FunctionalDependencies, -             FlexibleContexts, FlexibleInstances, UndecidableInstances,-             IncoherentInstances, OverlappingInstances #-}-module Data.Rope.Annotated.Internal -    ( A(A,rope)-    , null      -- :: A s a -> Bool-    -- * Unpackable Ropes-    , head      -- :: Unpackable t => A s a -> t-    , last      -- :: Unpackable t => A s a -> t-    , unpack    -- :: Unpackable t => A s a -> [t]-    -- * Annotation Products-    ) where--import Prelude hiding (null, head, last, take, drop, span, break, splitAt, takeWhile, dropWhile)-import Control.Applicative hiding (empty)-import Data.Rope.Util.Comonad-import Data.FingerTree (Measured(..))-import Data.Foldable (Foldable, foldMap)-import qualified Data.Foldable-import Data.Traversable (Traversable(traverse))-import qualified Data.Rope.Internal as Rope-import Data.Rope.Body (Offset(..))-import Data.Rope.Internal (Rope(..),Unpackable)--data A s a = A { rope :: !Rope, extractA :: a }--null :: A s a -> Bool-null = Rope.null . rope--head :: Unpackable t => A s a -> t-head = Rope.head . rope--last :: Unpackable t => A s a -> t-last = Rope.last . rope--unpack :: Unpackable t => A s a -> [t]-unpack (A s _) = Rope.unpack s--instance Measured Offset (A s a) where-    measure = measure . rope--instance Functor (A s) where-    fmap f (A s a) = A s (f a) --instance Comonad (A s) where-    extract = extractA-    extend f a@(A s _) = A s (f a)-    duplicate a@(A s _) = A s a--instance Foldable (A s) where-    foldr f z (A _ a) = f a z-    foldr1 _ (A _ a) = a-    foldl f z (A _ a) = f z a-    foldl1 _ (A _ a) = a-    foldMap f (A _ a) = f a--instance Traversable (A s) where-    traverse f (A s a) = A s <$> f a

@@ -1,35 +1,34 @@ {-# LANGUAGE TypeOperators #-} module Data.Rope.Annotation-    ( MonoidA(..)-    , ReducerA(..)-    , BreakableA(..)+    ( MonoidalAnn(..)+    , PackableAnn(..)+    , BreakableAnn(..)     ) where  import Data.Rope (Rope) -class MonoidA f where+class MonoidalAnn f where     -- | build an empty 'Annotation'-    emptyA   :: f a-    -- | append two annotations-    appendA  :: Rope -> f a -> Rope -> f b -> f c+    emptyAnn   :: f a+    -- | append two annotations, based on their corresponding ropes+    appendAnn  :: Rope -> f a -> Rope -> f b -> f c -class MonoidA f => ReducerA f where+class MonoidalAnn f => PackableAnn f where     -- | construct an 'Annotation' from a 'Rope' out of whole cloth-    unitA    :: Rope -> f a+    packAnn    :: Rope -> f a     -- | The 'Rope' has been updated to contains n more bytes on the right than the one used to build the 'Annotation', update the 'Annotation'-    snocA    :: Int -> Rope -> f a -> f b+    snocAnn    :: Int -> Rope -> f a -> f b     -- | The 'Rope' contains n more bytes on the left than the one used to build the 'Annotation', update the 'Annotation'-    consA    :: Int -> Rope -> f a -> f b+    consAnn    :: Int -> Rope -> f a -> f b     -class BreakableA f where+class BreakableAnn f where      -- | split an 'Annotation' about a 'Rope' into two annotations, one about the first n bytes, the other about the remainder-    splitAtA :: Int -> Rope -> f a -> (f b, f c)+    splitAtAnn :: Int -> Rope -> f a -> (f b, f c)     -- | truncate the 'Annotation' to 'length' n-    takeA    :: Int -> Rope -> f a -> f b+    takeAnn    :: Int -> Rope -> f a -> f b     -- | drop the first n bytes from the 'Annotation'-    dropA    :: Int -> Rope -> f a -> f b-+    dropAnn    :: Int -> Rope -> f a -> f b -    takeA n r = fst . splitAtA n r-    dropA n r = snd . splitAtA n r+    takeAnn n r = fst . splitAtAnn n r+    dropAnn n r = snd . splitAtAnn n r

@@ -38,19 +38,19 @@ instance (Traversable f, Traversable g) => Traversable (f :*: g) where     traverse f (a :*: b) = (:*:) <$> traverse f a <*> traverse f b -instance (MonoidA f, MonoidA g) => MonoidA (f :*: g) where-    emptyA = emptyA :*: emptyA-    appendA r (a :*: a') s (b :*: b') = -        appendA r a s b :*: appendA r a' s b'+instance (MonoidalAnn f, MonoidalAnn g) => MonoidalAnn (f :*: g) where+    emptyAnn = emptyAnn :*: emptyAnn+    appendAnn r (a :*: a') s (b :*: b') = +        appendAnn r a s b :*: appendAnn r a' s b' -instance (ReducerA f, ReducerA g) => ReducerA (f :*: g) where-    unitA r = unitA r :*: unitA r-    snocA r n (f :*: g) = snocA r n f :*: snocA r n g-    consA n r (f :*: g) = consA n r f :*: consA n r g+instance (PackableAnn f, PackableAnn g) => PackableAnn (f :*: g) where+    packAnn r = packAnn r :*: packAnn r+    snocAnn r n (f :*: g) = snocAnn r n f :*: snocAnn r n g+    consAnn n r (f :*: g) = consAnn n r f :*: consAnn n r g -instance (BreakableA f, BreakableA g) => BreakableA (f :*: g) where-    dropA n r (f :*: g) = dropA n r f :*: dropA n r g-    takeA n r (f :*: g) = takeA n r f :*: takeA n r g-    splitAtA n r (f :*: g) = (f' :*: g' , f'' :*: g'') where-        (f',f'') = splitAtA n r f-        (g',g'') = splitAtA n r g+instance (BreakableAnn f, BreakableAnn g) => BreakableAnn (f :*: g) where+    dropAnn n r (f :*: g) = dropAnn n r f :*: dropAnn n r g+    takeAnn n r (f :*: g) = takeAnn n r f :*: takeAnn n r g+    splitAtAnn n r (f :*: g) = (f' :*: g' , f'' :*: g'') where+        (f',f'') = splitAtAnn n r f+        (g',g'') = splitAtAnn n r g

@@ -7,16 +7,16 @@  data Unit a -instance MonoidA Unit where-    emptyA = undefined-    appendA _ _ _ _ = undefined+instance MonoidalAnn Unit where+    emptyAnn = undefined+    appendAnn _ _ _ _ = undefined -instance ReducerA Unit where-    unitA _ = undefined-    snocA _ _ _ = undefined-    consA _ _ _ = undefined+instance PackableAnn Unit where+    packAnn _ = undefined+    snocAnn _ _ _ = undefined+    consAnn _ _ _ = undefined -instance BreakableA Unit where-    takeA _ _ _ = undefined-    dropA _ _ _ = undefined-    splitAtA _ _ _ = (undefined, undefined)+instance BreakableAnn Unit where+    takeAnn _ _ _ = undefined+    dropAnn _ _ _ = undefined+    splitAtAnn _ _ _ = (undefined, undefined)

@@ -4,8 +4,9 @@     , Offset(..)     , Chunk(..)     , measureBody-    , cons'-    , snoc'+    , consBody+    , snocBody+    , packBody     ) where  import Prelude hiding (null, length)@@ -13,7 +14,6 @@ import Data.Data import Data.Typeable import Data.Monoid-import Data.Rope.Util.Reducer import Data.ByteString (ByteString, null, length)  newtype Offset = Offset { getOffset :: Int } deriving (Eq,Ord,Num,Show,Read,Enum,Data,Typeable)@@ -32,16 +32,14 @@ measureBody :: Measured Offset a => FingerTree Offset a -> Int measureBody = getOffset . measure -cons' :: ByteString -> Body -> Body-b `cons'` t | null b = t-            | otherwise = Chunk b <| t+consBody :: ByteString -> Body -> Body+b `consBody` t | null b = t+           | otherwise = Chunk b <| t -snoc' :: Body -> ByteString -> Body-t `snoc'` b | null b = t-            | otherwise = t |> Chunk b+snocBody :: Body -> ByteString -> Body+t `snocBody` b | null b = t+           | otherwise = t |> Chunk b -instance Reducer ByteString Body where-    unit b | null b = empty+packBody :: ByteString -> FingerTree Offset Chunk+packBody b | null b = empty            | otherwise = singleton (Chunk b)-    cons = cons'-    snoc = snoc'

@@ -0,0 +1,106 @@+{-# LANGUAGE TypeOperators, Rank2Types, EmptyDataDecls, +             MultiParamTypeClasses, FunctionalDependencies, +             FlexibleContexts, FlexibleInstances, UndecidableInstances,+             IncoherentInstances, OverlappingInstances #-}++module Data.Rope.Branded+    ( Branded(..)+    , Unsafe+    , UBR+    , null      -- :: (s `Branded` Rope) a -> Bool+    -- * Unpacking Ropes+    , head      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , last      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , unpack    -- :: Unpackable t => (s `Branded` Rope) a -> [t]+    -- * MonadWriter+    , runBranded+    , execBranded -- MonadWriter terminology for 'context'+    ) where++import Prelude hiding (null, head, last, take, drop, span, break, splitAt, takeWhile, dropWhile)++import Control.Applicative hiding (empty)+import Control.Monad.Writer.Class++import Data.Rope.Branded.Comonad+import Data.Monoid+import Data.FingerTree (Measured(..))+import Data.Foldable (Foldable, foldMap)+import qualified Data.Foldable+import Data.Traversable (Traversable(traverse))+import qualified Data.Rope.Internal as Rope+import Data.Rope.Internal (Rope(..),Unpackable)++type UBR a = (Unsafe `Branded` Rope) a++data Unsafe++data Branded brand t a = Branded { context :: !t, extractBranded :: a }++null :: Branded s Rope a -> Bool+null = Rope.null . context+{-# INLINE null #-} ++head :: Unpackable t => Branded s Rope a -> t+head = Rope.head . context+{-# INLINE head #-}++last :: Unpackable t => Branded s Rope a -> t+last = Rope.last . context+{-# INLINE last #-}++unpack :: Unpackable t => Branded s Rope a -> [t]+unpack (Branded s _) = Rope.unpack s+{-# INLINE unpack #-}++instance Measured v t => Measured v (Branded s t a) where+    measure = measure . context ++instance Functor (Branded s t) where+    fmap f (Branded s a) = Branded s (f a) ++instance Comonad (Branded s t) where+    extract = extractBranded+    extend f a@(Branded s _) = Branded s (f a)+    duplicate a@(Branded s _) = Branded s a++instance Foldable (Branded s t) where+    foldr f z (Branded _ a) = f a z+    foldr1 _ (Branded _ a) = a+    foldl f z (Branded _ a) = f z a+    foldl1 _ (Branded _ a) = a+    foldMap f (Branded _ a) = f a++instance Traversable (Branded s t) where+    traverse f (Branded s a) = Branded s <$> f a++instance Monoid t => Applicative (Branded Unsafe t) where+    pure = Branded mempty+    Branded s f <*> Branded s' a = Branded (s `mappend` s') (f a)++instance Monoid t => Monad (Branded Unsafe t) where+    return = Branded mempty+    Branded s a >>= f = Branded (s `mappend` s') b+        where Branded s' b = f a++instance (Monoid t, Monoid m) => Monoid (Branded Unsafe t m) where+    mempty = Branded mempty mempty+    Branded r t `mappend` Branded s u = Branded (r `mappend` s) (t `mappend` u)++-- > sample :: Branded Unsafe Rope ()+-- > sample = do pack "Hello"+-- >             pack ' '+-- >             pack "World"+-- > +instance Monoid t => MonadWriter t (Branded Unsafe t) where+    tell t = Branded t ()+    listen (Branded t a) = Branded t (a, t)+    pass (Branded t (a,f)) = Branded (f t) a++runBranded :: Branded s t a -> (a, t)+runBranded (Branded t a) = (a, t)+{-# INLINE runBranded #-}++execBranded :: Branded s t a -> t+execBranded (Branded t _) = t +{-# INLINE execBranded #-}

@@ -0,0 +1,11 @@+module Data.Rope.Branded.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

@@ -2,7 +2,8 @@ module Data.Rope.Internal     ( Rope(..)     -- * Construction-    , pack                  -- :: a `Reducer` Rope => a -> Roe+    , Packable(..)+    , pack                  -- :: Packable a => a -> Rope     , empty                 -- :: Rope     , fromChunks            -- :: [ByteString] -> Rope     , fromByteString        -- :: ByteString -> Rope@@ -47,7 +48,6 @@ import Data.Monoid  import Data.Rope.Body-import Data.Rope.Util.Reducer (Reducer, cons, snoc, unit)  import Data.Word (Word8) @@ -85,16 +85,22 @@ instance Measured Offset Rope where     measure = measure . body -pack :: Reducer a Rope => a -> Rope-pack = unit-{-# INLINE pack #-}+-- Minimal definition: 'unit' or 'snocBody+class Packable c where+    pack :: c -> Rope+    snoc :: Rope -> c -> Rope+    cons :: c -> Rope -> Rope +    pack = snoc mempty +    snoc m = mappend m . pack+    cons = mappend . pack+ empty :: Rope empty = Rope F.empty {-# INLINE empty #-}  fromChunks :: [ByteString] -> Rope-fromChunks = foldr (\l (Rope t) -> Rope (l `cons'` t)) mempty+fromChunks = foldr (\l (Rope t) -> Rope (l `consBody` t)) mempty {-# INLINE fromChunks #-}  toChunks :: Rope -> [ByteString]@@ -107,6 +113,7 @@  toString :: Rope -> String toString = unpack+{-# INLINE toString #-}  length :: Rope -> Int length = measureBody . body@@ -177,7 +184,7 @@ splitAt n (Rope f)         | n <= 0 = (mempty, Rope f)         | n >= measureBody f = (Rope f, mempty)-        | otherwise = (Rope (x `snoc'` y'), Rope (y'' `cons'` z))+        | otherwise = (Rope (x `snocBody` y'), Rope (y'' `consBody` z))         where             (x,yz) = F.split (> Offset n) f             Chunk y :< z = viewl yz@@ -230,13 +237,13 @@  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))+    Chunk c :< cs -> Just (S.unsafeHead c, Rope (S.unsafeTail c `consBody` cs))     _ -> Nothing {-# INLINE uncons8 #-}  unsnoc8 :: Rope -> Maybe (Rope, Word8) unsnoc8 r = case viewr (body r) of-    cs :> Chunk c -> Just (Rope (cs `snoc'` S.unsafeTail c), S.unsafeHead c)+    cs :> Chunk c -> Just (Rope (cs `snocBody` S.unsafeTail c), S.unsafeHead c)     _ -> Nothing {-# INLINE unsnoc8 #-} @@ -244,8 +251,8 @@ w2c = unsafeChr . fromIntegral {-# INLINE w2c #-} -instance Reducer Char Rope where-    unit = fromChar+instance Packable Char where+    pack = 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)@@ -255,41 +262,40 @@         _ -> Rope (t |> Chunk b)         where b = U.fromString [a] -instance Reducer Word8 Rope where-    unit = fromWord8+instance Packable Word8 where+    pack = 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 -instance Reducer Rope Rope where-    unit = id--instance Reducer String Rope where-    unit = fromString+instance Packable Rope where+    pack = id -instance Reducer [Word8] Rope where-    unit = fromWords+instance Packable String where+    pack = fromString -instance Reducer ByteString Rope where-    unit = fromByteString+instance Packable [Word8] where+    pack = fromWords -instance Reducer L.ByteString Rope where-    unit = fromLazyByteString+instance Packable ByteString where+    pack = fromByteString -instance Reducer Chunk Rope where-    unit = fromByteString . unchunk +instance Packable L.ByteString where+    pack = fromLazyByteString +instance Packable Chunk where+    pack = fromByteString . unchunk   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))+        Chunk c :< cs -> Just (S.unsafeHead c, Rope (S.unsafeTail c `consBody ` cs))         EmptyL -> Nothing     tail (Rope f) = case viewl f of-        Chunk c :< cs -> Rope (S.unsafeTail c `cons'`cs)+        Chunk c :< cs -> Rope (S.unsafeTail c `consBody`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@@ -360,4 +366,3 @@  errorEmptyList :: String -> a errorEmptyList t = error $ "Data.Rope.Unpackable." ++ t ++ ": empty list"  -

@@ -0,0 +1,114 @@+{-# LANGUAGE TypeOperators, EmptyDataDecls, +             MultiParamTypeClasses, FunctionalDependencies, +             FlexibleContexts, FlexibleInstances, UndecidableInstances,+             TypeFamilies, IncoherentInstances, OverlappingInstances #-}+module Data.Rope.Unsafe+    ( -- * Annotations+      MonoidalAnn+    , PackableAnn+    , BreakableAnn +    -- * Constructors+    , Branded+    , Ann+    , Unsafe++      -- * Unpacking 'Ropes'+    , null      -- :: (s `Branded` Rope) a -> Bool+    , head      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , last      -- :: Unpackable t => (s `Branded` Rope) a -> t+    , unpack    -- :: Unpackable t => (s `Branded` Rope) a -> [t]++      -- * Building Annotated 'Rope'+    , empty     -- :: MonoidalAnn f => Ann f Unsafe +    , append    -- :: MonoidalAnn f => Ann f a -> Ann f b -> Ann f Unsafe++    , Packable+    , pack+    , snoc+    , cons++      -- * Cutting An Annotated 'Rope'+    , splitAt   -- :: BreakableAnn f => Int -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+    , drop      -- :: BreakableAnn f => Int -> Ann f a -> Ann f Unsafe+    , take      -- :: BreakableAnn f => Int -> Ann f a -> Ann f Unsafe++    , break     -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+    , span      -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+    , takeWhile -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> Ann f Unsafe+    , dropWhile -- :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> Ann f Unsafe++    -- * Inspecting the ends of the 'Rope'+    , uncons    -- :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (t, Ann f Unsafe)+    , unsnoc    -- :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (Ann f Unsafe, t)++    ) where++import Prelude hiding (null, head, last, take, drop, span, break, splitAt, takeWhile, dropWhile)+import Data.Monoid++import qualified Data.Rope.Internal as Rope++import Data.Rope.Annotation (MonoidalAnn(..), PackableAnn(..), BreakableAnn(..))+import Data.Rope.Annotated (Ann)+import Data.Rope.Branded (Branded(..), null, head, last, unpack, Unsafe)++import Data.Rope.Internal (Packable, Breakable, Unpackable)++empty :: MonoidalAnn f => Ann f Unsafe+empty = Branded Rope.empty emptyAnn++append :: MonoidalAnn f => Ann f a -> Ann f b -> Ann f Unsafe+append (Branded r a) (Branded s b) = Branded (r `mappend` s) (appendAnn r a s b)++pack :: (PackableAnn f, Packable t) => t -> Ann f Unsafe +pack t = Branded r (packAnn r) +    where r = Rope.pack t++splitAt :: BreakableAnn f => Int -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+splitAt n (Branded r a) = (Branded r b, Branded r c) +    where (b, c) = splitAtAnn n r a++drop :: BreakableAnn f => Int -> Ann f a -> Ann f Unsafe+drop n (Branded r a) = Branded r (dropAnn n r a)++take :: BreakableAnn f => Int -> Ann f a -> Ann f Unsafe+take n (Branded r a) = Branded r (takeAnn n r a)++snoc :: (PackableAnn f, Packable t) => Ann f a -> t -> Ann f Unsafe+snoc (Branded r a) t = Branded r' (snocAnn (Rope.length r' - Rope.length r) r' a)+    where r' = Rope.snoc r t ++cons :: (PackableAnn f, Packable t) => t -> Ann f a -> Ann f Unsafe+cons t (Branded r a) = Branded r' (consAnn (Rope.length r' - Rope.length r) r' a)+    where r' = Rope.cons t r++break :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+break p (Branded r a) = (Branded x b, Branded y c) where+    (x,y) = Rope.break p r+    (b,c) = splitAtAnn (Rope.length x) r a++span :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> (Ann f Unsafe, Ann f Unsafe)+span p (Branded r a) = (Branded x b, Branded y c) where+    (x,y) = Rope.span p r+    (b,c) = splitAtAnn (Rope.length x) r a++takeWhile :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> Ann f Unsafe+takeWhile p (Branded r a) = Branded x b where+    x = Rope.takeWhile p r+    b = takeAnn (Rope.length x) r a++dropWhile :: (BreakableAnn f, Breakable t) => (t -> Bool) -> Ann f a -> Ann f Unsafe+dropWhile p (Branded r a) = Branded y c where+    y = Rope.dropWhile p r+    c = dropAnn (Rope.length r - Rope.length y) r a++uncons :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (t, Ann f Unsafe)+uncons (Branded r a) = case Rope.uncons r of+    Just (c,cs) -> Just (c, Branded cs (dropAnn (Rope.length r - Rope.length cs) r a))+    Nothing -> Nothing++unsnoc :: (BreakableAnn f, Unpackable t) => Ann f a -> Maybe (Ann f Unsafe, t)+unsnoc (Branded r a) = case Rope.unsnoc r of+    Just (cs,c) -> Just (Branded cs (dropAnn (Rope.length cs) r a), c)+    Nothing -> Nothing+

@@ -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,179 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Data.Rope.Util.Reducer -    ( Reducer(..)-    -- * Folding with 'Reducer's-    , foldMapReduce -- :: (Foldable f, e `Reducer` m) => (a -> e) -> f a -> m-    , foldReduce    -- :: (Foldable f, e `Reducer` m) => f e -> m -    -- * 'Applicative' reduction-    , pureUnit      -- :: (Applicative f, c `Reducer` n) => c -> m n-    , returnUnit    -- :: (Monad m, c `Reducer` n) c -> m n-    ) where--import Control.Applicative-import Control.Monad -import qualified Data.FingerTree as FingerTree-import Data.FingerTree (FingerTree, Measured)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as Lazy--import Data.Monoid--import Data.Foldable--{--import qualified Data.Sequence as Seq-import Data.Sequence (Seq)--import qualified Data.Set as Set-import Data.Set (Set)--import qualified Data.IntSet as IntSet-import Data.IntSet (IntSet)--import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)--import qualified Data.Map as Map-import Data.Map (Map)--}---- | This type may be best read infix. A @c `Reducer` m@ is a 'Monoid' @m@ that maps--- values of type @c@ through @unit@ to values of type @m@. A @c@-'Reducer' may also--- supply operations which tack-on another @c@ to an existing 'Monoid' @m@ on the left--- or right. These specialized reductions may be more efficient in some scenarios--- and are used when appropriate by a 'Generator'. The names 'cons' and 'snoc' work--- by analogy to the synonymous operations in the list monoid.------ This class deliberately avoids functional-dependencies, so that () can be a @c@-Reducer--- for all @c@, and so many common reducers can work over multiple types, for instance,--- First and Last may reduce both @a@ and 'Maybe' @a@. Since a 'Generator' has a fixed element--- type, the input to the reducer is generally known and extracting from the monoid usually--- is sufficient to fix the result type. Combinators are available for most scenarios where--- this is not the case, and the few remaining cases can be handled by using an explicit --- type annotation.------ Minimal definition: 'unit' or 'snoc'-class Monoid m => Reducer c m where-    -- | Convert a value into a 'Monoid'-    unit :: c -> m -    -- | Append a value to a 'Monoid' for use in left-to-right reduction-    snoc :: m -> c -> m-    -- | Prepend a value onto a 'Monoid' for use during right-to-left reduction-    cons :: c -> m -> m --    unit = snoc mempty -    snoc m = mappend m . unit-    cons = mappend . unit---- | Apply a 'Reducer' to a 'Foldable' container, after mapping the contents into a suitable form for reduction.-foldMapReduce :: (Foldable f, e `Reducer` m) => (a -> e) -> f a -> m-foldMapReduce f = foldMap (unit . f)---- | Apply a 'Reducer' to a 'Foldable' mapping each element through 'unit'-foldReduce :: (Foldable f, e `Reducer` m) => f e -> m-foldReduce = foldMap unit--returnUnit :: (Monad m, c `Reducer` n) => c -> m n -returnUnit = return . unit--pureUnit :: (Applicative f, c `Reducer` n) => c -> f n-pureUnit = pure . unit--instance (Reducer c m, Reducer c n) => Reducer c (m,n) where-    unit x = (unit x,unit x)-    (m,n) `snoc` x = (m `snoc` x, n `snoc` x)-    x `cons` (m,n) = (x `cons` m, x `cons` n)--instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where-    unit x = (unit x,unit x, unit x)-    (m,n,o) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x)-    x `cons` (m,n,o) = (x `cons` m, x `cons` n, x `cons` o)--instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where-    unit x = (unit x,unit x, unit x, unit x)-    (m,n,o,p) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x, p `snoc` x)-    x `cons` (m,n,o,p) = (x `cons` m, x `cons` n, x `cons` o, x `cons` p)--instance Reducer ByteString ByteString where-    unit = id-    snoc = mappend-    cons = mappend--instance Reducer ByteString Lazy.ByteString where-    unit = Lazy.fromChunks . return--instance Reducer c [c] where-    unit = return-    cons = (:)-    xs `snoc` x = xs ++ [x]--instance Reducer c () where-    unit _ = ()-    _ `snoc` _ = ()-    _ `cons` _ = ()--instance Reducer Bool Any where-    unit = Any--instance Reducer Bool All where-    unit = All--instance Reducer (a -> a) (Endo a) where-    unit = Endo--instance Monoid a => Reducer a (Dual a) where-    unit = Dual-    -instance Num a => Reducer a (Sum a) where-    unit = Sum--instance Num a => Reducer a (Product a) where-    unit = Product--instance Reducer (Maybe a) (First a) where-    unit = First--instance Reducer a (First a) where-    unit = First . Just--instance Reducer (Maybe a) (Last a) where-    unit = Last--instance Reducer a (Last a) where-    unit = Last . Just---- instance Measured v a => Monoid (FingerTree v a) where---    mempty = FingerTree.empty---    mappend = (><)--instance Measured v a => Reducer a (FingerTree v a) where-    unit = FingerTree.singleton--{--instance Reducer a (Seq a) where-    unit = Seq.singleton-    cons = (Seq.<|)-    snoc = (Seq.|>)--instance Reducer Int IntSet where-    unit = IntSet.singleton-    cons = IntSet.insert-    snoc = flip IntSet.insert -- left bias irrelevant--instance Ord a => Reducer a (Set a) where-    unit = Set.singleton-    cons = Set.insert-    -- pedantic about order in case 'Eq' doesn't implement structural equality-    snoc s m | Set.member m s = s -             | otherwise = Set.insert m s--instance Reducer (Int,v) (IntMap v) where-    unit = uncurry IntMap.singleton-    cons = uncurry IntMap.insert-    snoc = flip . uncurry . IntMap.insertWith $ const id--instance Ord k => Reducer (k,v) (Map k v) where-    unit = uncurry Map.singleton-    cons = uncurry Map.insert-    snoc = flip . uncurry . Map.insertWith $ const id--}

@@ -1,5 +1,5 @@ name:           rope-version:        0.5+version:        0.6 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -19,17 +19,19 @@     base >= 4 && < 6,      bytestring >= 0.9.1.4 && < 0.10,     fingertree >= 0.0.1 && < 0.1,-    utf8-string >= 0.3.5 && < 0.4+    utf8-string >= 0.3.5 && < 0.4,+    mtl >= 1.1 && < 1.2+   exposed-modules:     Data.Rope     Data.Rope.Annotated-    Data.Rope.Annotated.Internal     Data.Rope.Annotation     Data.Rope.Annotation.Product     Data.Rope.Annotation.Unit+    Data.Rope.Branded+    Data.Rope.Branded.Comonad+    Data.Rope.Unsafe     Data.Rope.Body     Data.Rope.Internal-    Data.Rope.Util.Comonad-    Data.Rope.Util.Reducer        ghc-options: -Wall