fingertree 0.1.1.0 → 0.1.2.0

raw patch · 6 files changed

+529/−54 lines, 6 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/FingerTree.hs +310/−32
• Data/IntervalMap/FingerTree.hs +68/−10
• Data/PriorityQueue/FingerTree.hs +55/−9
• changelog +33/−0
• fingertree.cabal +10/−3
• images/search.svg +53/−0

@@ -50,21 +50,36 @@     fromList,     -- * Deconstruction     null,-    ViewL(..), ViewR(..), viewl, viewr,+    -- ** Examining the ends+    ViewL(..), viewl,+    ViewR(..), viewr,+    -- ** Search+    SearchResult(..), search,+    -- ** Splitting+    -- | These functions are special cases of 'search'.     split, takeUntil, dropUntil,     -- * Transformation     reverse,-    fmap', fmapWithPos, unsafeFmap,-    traverse', traverseWithPos, unsafeTraverse+    -- ** Maps+    fmap', fmapWithPos, fmapWithContext, unsafeFmap,+    -- ** Traversals+    traverse', traverseWithPos, traverseWithContext, unsafeTraverse,     -- * Example     -- $example     ) where  import Prelude hiding (null, reverse)-+#if MIN_VERSION_base(4,8,0)+import qualified Prelude (null)+#else import Control.Applicative (Applicative(pure, (<*>)), (<$>)) import Data.Monoid-import Data.Foldable (Foldable(foldMap), toList)+import Data.Foldable (Foldable(foldMap))+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#endif+import Data.Foldable (toList)  infixr 5 >< infixr 5 <|, :<@@ -83,18 +98,25 @@                     -- and the rightmost element     deriving (Eq, Ord, Show, Read) -instance Functor s => Functor (ViewL s) where+instance (Functor s) => Functor (ViewL s) where     fmap _ EmptyL    = EmptyL     fmap f (x :< xs) = f x :< fmap f xs -instance Functor s => Functor (ViewR s) where+instance (Functor s) => Functor (ViewR s) where     fmap _ EmptyR    = EmptyR     fmap f (xs :> x) = fmap f xs :> f x +#if MIN_VERSION_base(4,9,0)+instance (Measured v a) => Semigroup (FingerTree v a) where+    (<>) = (><)+#endif+ -- | 'empty' and '><'.-instance Measured v a => Monoid (FingerTree v a) where+instance (Measured v a) => Monoid (FingerTree v a) where     mempty = empty+#if !(MIN_VERSION_base(4,11,0))     mappend = (><)+#endif  -- Explicit Digit type (Exercise 1) @@ -168,7 +190,8 @@  deep ::  (Measured v a) =>      Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a-deep pr m sf = Deep ((measure pr `mappendVal` m) `mappend` measure sf) pr m sf+deep pr m sf =+    Deep ((measure pr `mappend` measure m) `mappend` measure sf) pr m sf  -- | /O(1)/. The cached measure of a tree. instance (Measured v a) => Measured v (FingerTree v a) where@@ -176,25 +199,32 @@     measure (Single x)      =  measure x     measure (Deep v _ _ _)  =  v +-- | Elements from left to right. instance Foldable (FingerTree v) where     foldMap _ Empty = mempty     foldMap f (Single x) = f x     foldMap f (Deep _ pr m sf) =         foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf -instance Eq a => Eq (FingerTree v a) where+#if MIN_VERSION_base(4,8,0)+    null Empty = True+    null _ = False+#endif++instance (Eq a) => Eq (FingerTree v a) where     xs == ys = toList xs == toList ys -instance Ord a => Ord (FingerTree v a) where+-- | Lexicographical order from left to right.+instance (Ord a) => Ord (FingerTree v a) where     compare xs ys = compare (toList xs) (toList ys)  #if !TESTING-instance Show a => Show (FingerTree v a) where+instance (Show a) => Show (FingerTree v a) where     showsPrec p xs = showParen (p > 10) $         showString "fromList " . shows (toList xs) #endif --- | Like 'fmap', but with a more constrained type.+-- | Like 'fmap', but with constraints on the element types. fmap' :: (Measured v1 a1, Measured v2 a2) =>     (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2 fmap' = mapTree@@ -233,7 +263,7 @@          (mapWPDigit f vm sf)   where     vpr     =  v    `mappend`  measure pr-    vm      =  vpr  `mappendVal` m+    vm      =  vpr  `mappend`  measure m  mapWPNode :: (Measured v1 a1, Measured v2 a2) =>     (v1 -> a1 -> a2) -> v1 -> Node v1 a1 -> Node v2 a2@@ -260,6 +290,64 @@     vab     = va `mappend` measure b     vabc    = vab `mappend` measure c +-- | Map all elements of the tree with a function that also takes the+-- measure of the prefix to the left and of the suffix to the right of+-- the element.+fmapWithContext :: (Measured v1 a1, Measured v2 a2) =>+    (v1 -> a1 -> v1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2+fmapWithContext f t = mapWCTree f mempty t mempty++mapWCTree :: (Measured v1 a1, Measured v2 a2) =>+    (v1 -> a1 -> v1 -> a2) -> v1 -> FingerTree v1 a1 -> v1 -> FingerTree v2 a2+mapWCTree _ _ Empty _ = Empty+mapWCTree f vl (Single x) vr = Single (f vl x vr)+mapWCTree f vl (Deep _ pr m sf) vr =+    deep (mapWCDigit f vl pr vmsr)+         (mapWCTree (mapWCNode f) vlp m vsr)+         (mapWCDigit f vlpm sf vr)+  where+    vlp     =  vl `mappend` measure pr+    vlpm    =  vlp `mappend` vm+    vmsr    =  vm `mappend` vsr+    vsr     =  measure sf `mappend` vr+    vm      =  measure m++mapWCNode :: (Measured v1 a1, Measured v2 a2) =>+    (v1 -> a1 -> v1 -> a2) -> v1 -> Node v1 a1 -> v1 -> Node v2 a2+mapWCNode f vl (Node2 _ a b) vr = node2 (f vl a vb) (f va b vr)+  where+    va      = vl `mappend` measure a+    vb      = measure b `mappend` vr+mapWCNode f vl (Node3 _ a b c) vr = node3 (f vl a vbc) (f va b vc) (f vab c vr)+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vbc     = measure b `mappend` vc+    vc      = measure c `mappend` vr++mapWCDigit ::+    (Measured v a) => (v -> a -> v -> b) -> v -> Digit a -> v -> Digit b+mapWCDigit f vl (One a) vr = One (f vl a vr)+mapWCDigit f vl (Two a b) vr = Two (f vl a vb) (f va b vr)+  where+    va      = vl `mappend` measure a+    vb      = measure b `mappend` vr+mapWCDigit f vl (Three a b c) vr = Three (f vl a vbc) (f va b vc) (f vab c vr)+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vbc     = measure b `mappend` vc+    vc      = measure c `mappend` vr+mapWCDigit f vl (Four a b c d) vr =+    Four (f vl a vbcd) (f va b vcd) (f vab c vd) (f vabc d vr)+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vabc    = vab `mappend` measure c+    vbcd    = measure b `mappend` vcd+    vcd     = measure c `mappend` vd+    vd      = measure d `mappend` vr+ -- | Like 'fmap', but safe only if the function preserves the measure. unsafeFmap :: (a -> b) -> FingerTree v a -> FingerTree v b unsafeFmap _ Empty = Empty@@ -271,7 +359,7 @@ unsafeFmapNode f (Node2 v a b) = Node2 v (f a) (f b) unsafeFmapNode f (Node3 v a b c) = Node3 v (f a) (f b) (f c) --- | Like 'traverse', but with a more constrained type.+-- | Like 'traverse', but with constraints on the element types. traverse' :: (Measured v1 a1, Measured v2 a2, Applicative f) =>     (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) traverse' = traverseTree@@ -294,8 +382,8 @@ traverseDigit f (Three a b c) = Three <$> f a <*> f b <*> f c traverseDigit f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d --- | Traverse the tree with a function that also takes the--- measure of the prefix of the tree to the left of the element.+-- | Traverse the tree from left to right with a function that also+-- takes the measure of the prefix of the tree to the left of the element. traverseWithPos :: (Measured v1 a1, Measured v2 a2, Applicative f) =>     (v1 -> a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) traverseWithPos f = traverseWPTree f mempty@@ -308,7 +396,7 @@     deep <$> traverseWPDigit f v pr <*> traverseWPTree (traverseWPNode f) vpr m <*> traverseWPDigit f vm sf   where     vpr     =  v    `mappend`  measure pr-    vm      =  vpr  `mappendVal` m+    vm      =  vpr  `mappend`  measure m  traverseWPNode :: (Measured v1 a1, Measured v2 a2, Applicative f) =>     (v1 -> a1 -> f a2) -> v1 -> Node v1 a1 -> f (Node v2 a2)@@ -336,6 +424,64 @@     vab     = va `mappend` measure b     vabc    = vab `mappend` measure c +-- | Traverse the tree from left to right with a function that also+-- takes the measure of the prefix to the left and the measure of the+-- suffix to the right of the element.+traverseWithContext :: (Measured v1 a1, Measured v2 a2, Applicative f) =>+    (v1 -> a1 -> v1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)+traverseWithContext f t = traverseWCTree f mempty t mempty++traverseWCTree :: (Measured v1 a1, Measured v2 a2, Applicative f) =>+    (v1 -> a1 -> v1 -> f a2) -> v1 -> FingerTree v1 a1 -> v1 -> f (FingerTree v2 a2)+traverseWCTree _ _ Empty _ = pure Empty+traverseWCTree f vl (Single x) vr = Single <$> f vl x vr+traverseWCTree f vl (Deep _ pr m sf) vr =+    deep <$> traverseWCDigit f vl pr vmsr <*> traverseWCTree (traverseWCNode f) vlp m vsr <*> traverseWCDigit f vlpm sf vr+  where+    vlp     =  vl `mappend` measure pr+    vlpm    =  vlp `mappend` vm+    vmsr    =  vm `mappend` vsr+    vsr     =  measure sf `mappend` vr+    vm      =  measure m++traverseWCNode :: (Measured v1 a1, Measured v2 a2, Applicative f) =>+    (v1 -> a1 -> v1 -> f a2) -> v1 -> Node v1 a1 -> v1 -> f (Node v2 a2)+traverseWCNode f vl (Node2 _ a b) vr = node2 <$> f vl a vb <*> f va b vr+  where+    va      = vl `mappend` measure a+    vb      = measure a `mappend` vr+traverseWCNode f vl (Node3 _ a b c) vr =+    node3 <$> f vl a vbc <*> f va b vc <*> f vab c vr+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vc      = measure c `mappend` vr+    vbc     = measure b `mappend` vc++traverseWCDigit :: (Measured v a, Applicative f) =>+    (v -> a -> v -> f b) -> v -> Digit a -> v -> f (Digit b)+traverseWCDigit f vl (One a) vr = One <$> f vl a vr+traverseWCDigit f vl (Two a b) vr = Two <$> f vl a vb <*> f va b vr+  where+    va      = vl `mappend` measure a+    vb      = measure a `mappend` vr+traverseWCDigit f vl (Three a b c) vr =+    Three <$> f vl a vbc <*> f va b vc <*> f vab c vr+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vc      = measure c `mappend` vr+    vbc     = measure b `mappend` vc+traverseWCDigit f vl (Four a b c d) vr =+    Four <$> f vl a vbcd <*> f va b vcd <*> f vab c vd <*> f vabc d vr+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vabc    = vab `mappend` measure c+    vd      = measure d `mappend` vr+    vcd     = measure c `mappend` vd+    vbcd    = measure b `mappend` vcd+ -- | Like 'traverse', but safe only if the function preserves the measure. unsafeTraverse :: (Applicative f) =>     (a -> f b) -> FingerTree v a -> f (FingerTree v b)@@ -362,6 +508,7 @@ singleton = Single  -- | /O(n)/. Create a sequence from a finite list of elements.+-- The opposite operation 'toList' is supplied by the 'Foldable' instance. fromList :: (Measured v a) => [a] -> FingerTree v a fromList = foldr (<|) Empty @@ -398,7 +545,7 @@ snocDigit (Four _ _ _ _) _ = illegal_argument "snocDigit"  -- | /O(1)/. Is this the empty sequence?-null :: (Measured v a) => FingerTree v a -> Bool+null :: FingerTree v a -> Bool null Empty = True null _ = False @@ -436,7 +583,7 @@ rotR :: (Measured v a) => Digit a -> FingerTree v (Node v a) -> FingerTree v a rotR pr m = case viewr m of     EmptyR  ->  digitToTree pr-    m' :> a ->  Deep (measure pr `mappendVal` m) pr m' (nodeToDigit a)+    m' :> a ->  Deep (measure pr `mappend` measure m) pr m' (nodeToDigit a)  rheadDigit :: Digit a -> a rheadDigit (One a) = a@@ -698,8 +845,144 @@ -- 4.4 Splitting ---------------- +-- | A result of 'search', attempting to find a point where a predicate+-- on splits of the sequence changes from 'False' to 'True'.+data SearchResult v a+    = Position (FingerTree v a) a (FingerTree v a)+        -- ^ A tree opened at a particular element: the prefix to the+        -- left, the element, and the suffix to the right.+    | OnLeft+        -- ^ A position to the left of the sequence, indicating that the+        -- predicate is 'True' at both ends.+    | OnRight+        -- ^ A position to the right of the sequence, indicating that the+        -- predicate is 'False' at both ends.+    | Nowhere+        -- ^ No position in the tree, returned if the predicate is 'True'+        -- at the left end and 'False' at the right end.  This will not+        -- occur if the predicate in monotonic on the tree.+    deriving (Eq, Ord, Show)++-- | /O(log(min(i,n-i)))/. Search a sequence for a point where a predicate+-- on splits of the sequence changes from 'False' to 'True'.+--+-- The argument @p@ is a relation between the measures of the two+-- sequences that could be appended together to form the sequence @t@.+-- If the relation is 'False' at the leftmost split and 'True' at the+-- rightmost split, i.e.+--+-- @not (p 'mempty' ('measure' t)) && p ('measure' t) 'mempty'@+--+-- then there must exist an element @x@ in the sequence such that @p@+-- is 'False' for the split immediately before @x@ and 'True' for the+-- split just after it:+--+-- <<images/search.svg>>+--+-- In this situation, @'search' p t@ returns such an element @x@ and the+-- pieces @l@ and @r@ of the sequence to its left and right respectively.+-- That is, it returns @'Position' l x r@ such that+--+-- * @l >< (x <| r) = t@+--+-- * @not (p (measure l) (measure (x <| r))@+--+-- * @p (measure (l |> x)) (measure r)@+--+-- For predictable results, one should ensure that there is only one such+-- point, i.e. that the predicate is /monotonic/ on @t@.+search :: (Measured v a) =>+    (v -> v -> Bool) -> FingerTree v a -> SearchResult v a+search p t+  | p_left && p_right = OnLeft+  | not p_left && p_right = case searchTree p mempty t mempty of+        Split l x r -> Position l x r+  | not p_left && not p_right = OnRight+  | otherwise = Nowhere+  where+    p_left = p mempty vt+    p_right = p vt mempty+    vt = measure t++-- isSplit :: (Measured v a) => (v -> v -> Bool) -> v -> a -> v -> Bool+-- isSplit p vl x vr = not (p vl (v `mappend` vr)) && p (vl `mappend` v) vr+--   where v = measure x+--+-- property:+-- isSplit p vl t vr =>+--    let Split l x r = search t in+--    isSplit p (vl `mappend` measure l) x (measure r `mappend` vr)++searchTree :: (Measured v a) =>+    (v -> v -> Bool) -> v -> FingerTree v a -> v -> Split (FingerTree v a) a+searchTree _ _ Empty _ = illegal_argument "searchTree"+searchTree _ _ (Single x) _ = Split Empty x Empty+searchTree p vl (Deep _ pr m sf) vr+  | p vlp vmsr  =  let  Split l x r     =  searchDigit p vl pr vmsr+                   in   Split (maybe Empty digitToTree l) x (deepL r m sf)+  | p vlpm vsr  =  let  Split ml xs mr  =  searchTree p vlp m vsr+                        Split l x r     =  searchNode p (vlp `mappend` measure ml) xs (measure mr `mappend` vsr)+                   in   Split (deepR pr  ml l) x (deepL r mr sf)+  | otherwise   =  let  Split l x r     =  searchDigit p vm sf vr+                   in   Split (deepR pr  m  l) x (maybe Empty digitToTree r)+  where+    vlp     =  vl `mappend` measure pr+    vlpm    =  vlp `mappend` vm+    vmsr    =  vm `mappend` vsr+    vsr     =  measure sf `mappend` vr+    vm      =  measure m++searchNode :: (Measured v a) =>+    (v -> v -> Bool) -> v -> Node v a -> v -> Split (Maybe (Digit a)) a+searchNode p vl (Node2 _ a b) vr+  | p va vb     = Split Nothing a (Just (One b))+  | otherwise   = Split (Just (One a)) b Nothing+  where+    va      = vl `mappend` measure a+    vb      = measure b `mappend` vr+searchNode p vl (Node3 _ a b c) vr+  | p va vbc    = Split Nothing a (Just (Two b c))+  | p vab vc    = Split (Just (One a)) b (Just (One c))+  | otherwise   = Split (Just (Two a b)) c Nothing+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vc      = measure c `mappend` vr+    vbc     = measure b `mappend` vc++searchDigit :: (Measured v a) =>+    (v -> v -> Bool) -> v -> Digit a -> v -> Split (Maybe (Digit a)) a+searchDigit _ vl (One a) vr = vl `seq` vr `seq` Split Nothing a Nothing+searchDigit p vl (Two a b) vr+  | p va vb     = Split Nothing a (Just (One b))+  | otherwise   = Split (Just (One a)) b Nothing+  where+    va      = vl `mappend` measure a+    vb      = measure b `mappend` vr+searchDigit p vl (Three a b c) vr+  | p va vbc    = Split Nothing a (Just (Two b c))+  | p vab vc    = Split (Just (One a)) b (Just (One c))+  | otherwise   = Split (Just (Two a b)) c Nothing+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vbc     = measure b `mappend` vc+    vc      = measure c `mappend` vr+searchDigit p vl (Four a b c d) vr+  | p va vbcd   = Split Nothing a (Just (Three b c d))+  | p vab vcd   = Split (Just (One a)) b (Just (Two c d))+  | p vabc vd   = Split (Just (Two a b)) c (Just (One d))+  | otherwise   = Split (Just (Three a b c)) d Nothing+  where+    va      = vl `mappend` measure a+    vab     = va `mappend` measure b+    vabc    = vab `mappend` measure c+    vbcd    = measure b `mappend` vcd+    vcd     = measure c `mappend` vd+    vd      = measure d `mappend` vr+ -- | /O(log(min(i,n-i)))/. Split a sequence at a point where the predicate--- on the accumulated measure changes from 'False' to 'True'.+-- on the accumulated measure of the prefix changes from 'False' to 'True'. -- -- For predictable results, one should ensure that there is only one such -- point, i.e. that the predicate is /monotonic/.@@ -738,18 +1021,13 @@   | p vpr       =  let  Split l x r     =  splitDigit p i pr                    in   Split (maybe Empty digitToTree l) x (deepL r m sf)   | p vm        =  let  Split ml xs mr  =  splitTree p vpr m-                        Split l x r     =  splitNode p (vpr `mappendVal` ml) xs+                        Split l x r     =  splitNode p (vpr `mappend` measure ml) xs                    in   Split (deepR pr  ml l) x (deepL r mr sf)   | otherwise   =  let  Split l x r     =  splitDigit p vm sf                    in   Split (deepR pr  m  l) x (maybe Empty digitToTree r)   where     vpr     =  i    `mappend`  measure pr-    vm      =  vpr  `mappendVal` m---- Avoid relying on right identity (cf Exercise 7)-mappendVal :: (Measured v a) => v -> FingerTree v a -> v-mappendVal v Empty = v-mappendVal v t = v `mappend` measure t+    vm      =  vpr  `mappend`  measure m  deepL :: (Measured v a) =>     Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a@@ -761,8 +1039,8 @@ deepR pr m Nothing      =   rotR pr m deepR pr m (Just sf)    =   deep pr m sf -splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a ->-    Split (Maybe (Digit a)) a+splitNode :: (Measured v a) =>+    (v -> Bool) -> v -> Node v a -> Split (Maybe (Digit a)) a splitNode p i (Node2 _ a b)   | p va        = Split Nothing a (Just (One b))   | otherwise   = Split (Just (One a)) b Nothing@@ -776,8 +1054,8 @@     va      = i `mappend` measure a     vab     = va `mappend` measure b -splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->-    Split (Maybe (Digit a)) a+splitDigit :: (Measured v a) =>+    (v -> Bool) -> v -> Digit a -> Split (Maybe (Digit a)) a splitDigit _ i (One a) = i `seq` Split Nothing a Nothing splitDigit p i (Two a b)   | p va        = Split Nothing a (Just (One b))

@@ -35,7 +35,7 @@  module Data.IntervalMap.FingerTree (     -- * Intervals-    Interval(..), point,+    Interval(..), low, high, point,     -- * Interval maps     IntervalMap, empty, singleton, insert, union,     -- * Searching@@ -45,25 +45,43 @@ import qualified Data.FingerTree as FT import Data.FingerTree (FingerTree, Measured(..), ViewL(..), (<|), (><)) +import Prelude hiding (null)+#if MIN_VERSION_base(4,8,0)+import qualified Prelude (null)+#else import Control.Applicative ((<$>))-import Data.Traversable (Traversable(traverse)) import Data.Foldable (Foldable(foldMap)) import Data.Monoid+import Data.Traversable (Traversable(traverse))+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#endif+import Data.Foldable (toList)  ---------------------------------- -- 4.8 Application: interval trees ----------------------------------  -- | A closed interval.  The lower bound should be less than or equal--- to the higher bound.-data Interval v = Interval { low :: v, high :: v }+-- to the upper bound.+data Interval v = Interval v v -- ^ Lower and upper bounds of the interval.     deriving (Eq, Ord, Show) +-- | Lower bound of the interval+low :: Interval v -> v+low (Interval lo _) = lo++-- | Upper bound of the interval+high :: Interval v -> v+high (Interval _ hi) = hi+ -- | An interval in which the lower and upper bounds are equal. point :: v -> Interval v point v = Interval v v  data Node v a = Node (Interval v) a+    deriving (Eq, Ord, Show)  instance Functor (Node v) where     fmap f (Node i x) = Node i (f x)@@ -77,19 +95,28 @@ -- rightmost interval (including largest lower bound) and largest upper bound. data IntInterval v = NoInterval | IntInterval (Interval v) v +#if MIN_VERSION_base(4,9,0)+instance Ord v => Semigroup (IntInterval v) where+    (<>) = intervalUnion+#endif+ instance Ord v => Monoid (IntInterval v) where     mempty = NoInterval-    NoInterval `mappend` i  = i-    i `mappend` NoInterval  = i-    IntInterval _ hi1 `mappend` IntInterval int2 hi2 =-        IntInterval int2 (max hi1 hi2)+#if !(MIN_VERSION_base(4,11,0))+    mappend = intervalUnion+#endif +intervalUnion :: Ord v => IntInterval v -> IntInterval v -> IntInterval v+NoInterval `intervalUnion` i  = i+i `intervalUnion` NoInterval  = i+IntInterval _ hi1 `intervalUnion` IntInterval int2 hi2 =+    IntInterval int2 (max hi1 hi2)++ instance (Ord v) => Measured (IntInterval v) (Node v a) where     measure (Node i _) = IntInterval i (high i)  -- | Map of closed intervals, possibly with duplicates.--- The 'Foldable' and 'Traversable' instances process the intervals in--- lexicographical order. newtype IntervalMap v a =     IntervalMap (FingerTree (IntInterval v) (Node v a)) -- ordered lexicographically by interval@@ -97,17 +124,48 @@ instance Functor (IntervalMap v) where     fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t) +-- | Values in lexicographical order of intervals. instance Foldable (IntervalMap v) where     foldMap f (IntervalMap t) = foldMap (foldMap f) t+#if MIN_VERSION_base(4,8,0)+    null (IntervalMap t) = Prelude.null t+#endif +-- | Traverse the intervals in lexicographical order. instance Traversable (IntervalMap v) where     traverse f (IntervalMap t) =         IntervalMap <$> FT.unsafeTraverse (traverse f) t +instance (Eq v, Eq a) => Eq (IntervalMap v a) where+    IntervalMap xs == IntervalMap ys = toList xs == toList ys++-- | Lexicographical ordering+instance (Ord v, Ord a) => Ord (IntervalMap v a) where+    compare (IntervalMap xs) (IntervalMap ys) = compare (toList xs) (toList ys)++instance (Show v, Show a) => Show (IntervalMap v a) where+    showsPrec p (IntervalMap ns)+      | Prelude.null ns = showString "empty"+      | otherwise =+        showParen (p > 0) (showIntervals (toList ns))+      where+        showIntervals [] = showString "empty"+        showIntervals (Node i x:ixs) =+            showString "insert " . shows i . showChar ' ' . shows x .+                showString " $ " . showIntervals ixs++#if MIN_VERSION_base(4,9,0)+-- | 'union'.+instance (Ord v) => Semigroup (IntervalMap v a) where+    (<>) = union+#endif+ -- | 'empty' and 'union'. instance (Ord v) => Monoid (IntervalMap v a) where     mempty = empty+#if !(MIN_VERSION_base(4,11,0))     mappend = union+#endif  -- | /O(1)/.  The empty interval map. empty :: (Ord v) => IntervalMap v a

@@ -57,10 +57,18 @@ import qualified Data.FingerTree as FT import Data.FingerTree (FingerTree, (<|), (|>), (><), ViewL(..), Measured(..)) -import Control.Arrow ((***))+import Prelude hiding (null)+#if MIN_VERSION_base(4,8,0)+import qualified Prelude (null)+#else import Data.Foldable (Foldable(foldMap)) import Data.Monoid-import Prelude hiding (null)+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#endif+import Control.Arrow ((***))+import Data.List (unfoldr)  data Entry k v = Entry k v @@ -72,14 +80,24 @@  data Prio k v = NoPrio | Prio k v +#if MIN_VERSION_base(4,9,0)+instance Ord k => Semigroup (Prio k v) where+    (<>) = unionPrio+#endif+ instance Ord k => Monoid (Prio k v) where-    mempty                  = NoPrio-    x `mappend` NoPrio      = x-    NoPrio `mappend` y      = y-    x@(Prio kx _) `mappend` y@(Prio ky _)-      | kx <= ky            = x-      | otherwise           = y+    mempty  = NoPrio+#if !(MIN_VERSION_base(4,11,0))+    mappend = unionPrio+#endif +unionPrio :: Ord k => Prio k v -> Prio k v -> Prio k v+x `unionPrio` NoPrio      = x+NoPrio `unionPrio` y      = y+x@(Prio kx _) `unionPrio` y@(Prio ky _)+  | kx <= ky            = x+  | otherwise           = y+ instance Ord k => Measured (Prio k v) (Entry k v) where     measure (Entry k v) = Prio k v @@ -89,15 +107,39 @@ instance Ord k => Functor (PQueue k) where     fmap f (PQueue xs) = PQueue (FT.fmap' (fmap f) xs) +-- | In ascending order of keys. instance Ord k => Foldable (PQueue k) where     foldMap f q = case minView q of         Nothing -> mempty         Just (v, q') -> f v `mappend` foldMap f q'+#if MIN_VERSION_base(4,8,0)+    null (PQueue q) = Prelude.null q+#endif +#if MIN_VERSION_base(4,9,0)+instance Ord k => Semigroup (PQueue k v) where+    (<>) = union+#endif++-- | 'empty' and 'union' instance Ord k => Monoid (PQueue k v) where     mempty = empty+#if !(MIN_VERSION_base(4,11,0))     mappend = union+#endif +instance (Ord k, Eq v) => Eq (PQueue k v) where+    xs == ys = assocs xs == assocs ys++-- | Lexicographical ordering+instance (Ord k, Ord v) => Ord (PQueue k v) where+    compare xs ys = compare (assocs xs) (assocs ys)++-- | In ascending key order+instance (Ord k, Show k, Show v) => Show (PQueue k v) where+    showsPrec p xs = showParen (p > 10) $+        showString "fromList " . shows (assocs xs)+ -- | /O(1)/. The empty priority queue. empty :: Ord k => PQueue k v empty = PQueue FT.empty@@ -168,7 +210,7 @@ -- minViewWithKey :: Ord k => PQueue k v -> Maybe ((k, v), PQueue k v) minViewWithKey (PQueue q)-  | FT.null q = Nothing+  | Prelude.null q = Nothing   | otherwise = Just ((k, v), case FT.viewl r of     _ :< r' -> PQueue (l >< r')     _ -> error "can't happen")@@ -179,3 +221,7 @@ below :: Ord k => k -> Prio k v -> Bool below _ NoPrio = False below k (Prio k' _) = k' <= k++-- | /O(n)/. Key-value pairs in ascending key order.+assocs :: Ord k => PQueue k v -> [(k, v)]+assocs = unfoldr minViewWithKey

@@ -0,0 +1,33 @@+-*-change-log-*-++0.1.2.0 Ross Paterson <R.Paterson@city.ac.uk> Oct 2017+	* Removed constraint on the type of null+	* Added versions of fmap and traverse passing the measures of both sides+	* Added new search function, a symmetrical generalization of split+	* Added Eq, Ord and Show instances for IntervalMap and PriorityQueue+	* Made low and high into separate functions+	* Updated for Monoid, Foldable, Traversable in Prelude+	* Made compatible with Semigroup/Monoid proposal++0.1.1.0 Ross Paterson <R.Paterson@city.ac.uk> Jun 2015+	* Added Safe for GHC >= 7.2+	* Added AutoDeriveTypeable for GHC >= 7.10++0.1.0.2 Ross Paterson <ross@soi.city.ac.uk> Mar 2015+	* Cabal file updates++0.1.0.1 Ross Paterson <ross@soi.city.ac.uk> Feb 2015+	* fix warnings++0.1.0.0 Ross Paterson <ross@soi.city.ac.uk> Jun 2013+	* Added Monoid instance for IntervalMap+	* Removed unnecessary Measured v a constraints on Eq, Ord, and Show instances++0.0.1.1 Ross Paterson <ross@soi.city.ac.uk> Sep 2012+	* Cabal file updates++0.0.1.0 Ross Paterson <ross@soi.city.ac.uk> Jul 2009+	* Added Data.IntervalMap.FingerTree and Data.PriorityQueue.FingerTree++0.0 Ross Paterson <ross@soi.city.ac.uk> May 2007+	* Initial revision

@@ -1,6 +1,6 @@ Name:           fingertree-Version:        0.1.1.0-Cabal-Version:  >= 1.8+Version:        0.1.2.0+Cabal-Version:  >= 1.18 Copyright:      (c) 2006 Ross Paterson, Ralf Hinze License:        BSD3 License-File:   LICENSE@@ -23,6 +23,10 @@                 @containers@ package, which is a specialization of                 this structure. Build-Type:     Simple+Extra-Source-Files:+                changelog+Extra-Doc-Files:+                images/search.svg  Source-Repository head   Type: darcs@@ -30,7 +34,9 @@  Library   Build-Depends: base < 6-  Extensions:   MultiParamTypeClasses+  Default-Language: Haskell2010+  Other-Extensions:+                MultiParamTypeClasses                 FunctionalDependencies                 FlexibleInstances                 UndecidableInstances@@ -43,6 +49,7 @@   type: exitcode-stdio-1.0   main-is: tests/ft-properties.hs   cpp-options: -DTESTING+  default-language: Haskell2010   build-depends:                 base >= 4.2 && < 6,                 HUnit,

@@ -0,0 +1,53 @@+<?xml version="1.0" standalone="no"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+  "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<svg width="700" height="200" xmlns="http://www.w3.org/2000/svg" version="1.1">+<g transform="translate(25,90)">+ <g stroke="black" stroke-width="1" fill="#fda">+  <rect x="0" y="0" height="50" width="600" />+  <line x1="300" y1="0" x2="300" y2="50" />+  <line x1="340" y1="0" x2="340" y2="50" />+ </g>+ <g transform="translate(0,-15)">+  <g stroke="black" stroke-width="0.5" fill="none">+   <line x1="0" y1="0" x2="600" y2="0" />+   <line x1="0" y1="-12" x2="0" y2="12" />+   <line x1="300" y1="-12" x2="300" y2="12" />+   <line x1="600" y1="-12" x2="600" y2="12" />+   <polyline points="9,-8 1,0 9,8" />+   <polyline points="291,-8 299,0 291,8" />+   <polyline points="309,-8 301,0 309,8" />+   <polyline points="591,-8 599,0 591,8" />+  </g>+ </g>+ <g transform="translate(0,65)">+  <g stroke="black" stroke-width="0.5" fill="none">+   <line x1="0" y1="0" x2="600" y2="0" />+   <line x1="0" y1="-12" x2="0" y2="12" />+   <line x1="340" y1="-12" x2="340" y2="12" />+   <line x1="600" y1="-12" x2="600" y2="12" />+   <polyline points="9,-8 1,0 9,8" />+   <polyline points="331,-8 339,0 331,8" />+   <polyline points="349,-8 341,0 349,8" />+   <polyline points="591,-8 599,0 591,8" />+  </g>+ </g>+ <g>+  <text x="150" y="30" text-anchor="middle">l</text>+  <text x="320" y="30" text-anchor="middle">x</text>+  <text x="470" y="30" text-anchor="middle">r</text>+  <text x="150" y="-30" text-anchor="middle">measure l</text>+  <text x="450" y="-30" text-anchor="middle">measure (x &lt;| r)</text>+  <text x="170" y="90" text-anchor="middle">measure (l |&gt; x)</text>+  <text x="470" y="90" text-anchor="middle">measure r</text>+ </g>+ <g fill="#00f" transform="translate(640,0)">+  <g stroke="#00f" stroke-width="1">+   <line x1="-20" y1="-60" x2="20" y2="-60" />+  </g>+  <text x="0" y="-70" text-anchor="middle">p</text>+  <text x="0" y="-30" text-anchor="middle">False</text>+  <text x="0" y="90" text-anchor="middle">True</text>+ </g>+</g>+</svg>