{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
#ifndef MIN_VERSION_lens
#define MIN_VERSION_lens(x,y,z) 1
#endif
module Text.Trifecta.Util.IntervalMap
(
Interval(..)
, IntervalMap(..), singleton, insert
, search, intersections, dominators
, offset
, IntInterval(..)
, fromList
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative hiding (empty)
import Data.Foldable (Foldable (foldMap))
#endif
#if MIN_VERSION_lens(4,13,0) && __GLASGOW_HASKELL__ >= 710
import Control.Lens hiding ((:<), (<|), (|>))
#else
import Control.Lens hiding ((<|), (|>))
#endif
import Data.FingerTree
(FingerTree, Measured (..), ViewL (..), (<|), (><))
import qualified Data.FingerTree as FT
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Semigroup.Reducer
import Data.Semigroup.Union
data Interval v = Interval { Interval v -> v
low :: v, Interval v -> v
high :: v }
deriving Int -> Interval v -> ShowS
[Interval v] -> ShowS
Interval v -> String
(Int -> Interval v -> ShowS)
-> (Interval v -> String)
-> ([Interval v] -> ShowS)
-> Show (Interval v)
forall v. Show v => Int -> Interval v -> ShowS
forall v. Show v => [Interval v] -> ShowS
forall v. Show v => Interval v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval v] -> ShowS
$cshowList :: forall v. Show v => [Interval v] -> ShowS
show :: Interval v -> String
$cshow :: forall v. Show v => Interval v -> String
showsPrec :: Int -> Interval v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Interval v -> ShowS
Show
instance Ord v => Semigroup (Interval v) where
Interval a :: v
a b :: v
b <> :: Interval v -> Interval v -> Interval v
<> Interval c :: v
c d :: v
d = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval (v -> v -> v
forall a. Ord a => a -> a -> a
min v
a v
c) (v -> v -> v
forall a. Ord a => a -> a -> a
max v
b v
d)
instance (Ord v, Monoid v) => Reducer v (Interval v) where
unit :: v -> Interval v
unit v :: v
v = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval v
v v
v
cons :: v -> Interval v -> Interval v
cons v :: v
v (Interval a :: v
a b :: v
b) = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval (v
v v -> v -> v
forall a. Monoid a => a -> a -> a
`mappend` v
a) (v
v v -> v -> v
forall a. Monoid a => a -> a -> a
`mappend` v
b)
snoc :: Interval v -> v -> Interval v
snoc (Interval a :: v
a b :: v
b) v :: v
v = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval (v
a v -> v -> v
forall a. Monoid a => a -> a -> a
`mappend` v
v) (v
b v -> v -> v
forall a. Monoid a => a -> a -> a
`mappend` v
v)
instance Eq v => Eq (Interval v) where
Interval a :: v
a b :: v
b == :: Interval v -> Interval v -> Bool
== Interval c :: v
c d :: v
d = v
a v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
c Bool -> Bool -> Bool
&& v
d v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
b
instance Ord v => Ord (Interval v) where
compare :: Interval v -> Interval v -> Ordering
compare (Interval a :: v
a b :: v
b) (Interval c :: v
c d :: v
d) = case v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v
a v
c of
LT -> Ordering
LT
EQ -> v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v
d v
b
GT -> Ordering
GT
instance Functor Interval where
fmap :: (a -> b) -> Interval a -> Interval b
fmap f :: a -> b
f (Interval a :: a
a b :: a
b) = b -> b -> Interval b
forall v. v -> v -> Interval v
Interval (a -> b
f a
a) (a -> b
f a
b)
instance Foldable Interval where
foldMap :: (a -> m) -> Interval a -> m
foldMap f :: a -> m
f (Interval a :: a
a b :: a
b) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b
instance Traversable Interval where
traverse :: (a -> f b) -> Interval a -> f (Interval b)
traverse f :: a -> f b
f (Interval a :: a
a b :: a
b) = b -> b -> Interval b
forall v. v -> v -> Interval v
Interval (b -> b -> Interval b) -> f b -> f (b -> Interval b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> Interval b) -> f b -> f (Interval b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b
data Node v a = Node (Interval v) a
instance Functor (Node v) where
fmap :: (a -> b) -> Node v a -> Node v b
fmap f :: a -> b
f (Node i :: Interval v
i x :: a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (a -> b
f a
x)
instance FunctorWithIndex (Interval v) (Node v) where
imap :: (Interval v -> a -> b) -> Node v a -> Node v b
imap f :: Interval v -> a -> b
f (Node i :: Interval v
i x :: a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (Interval v -> a -> b
f Interval v
i a
x)
instance Foldable (Node v) where
foldMap :: (a -> m) -> Node v a -> m
foldMap f :: a -> m
f (Node _ x :: a
x) = a -> m
f a
x
instance FoldableWithIndex (Interval v) (Node v) where
ifoldMap :: (Interval v -> a -> m) -> Node v a -> m
ifoldMap f :: Interval v -> a -> m
f (Node k :: Interval v
k v :: a
v) = Interval v -> a -> m
f Interval v
k a
v
instance Traversable (Node v) where
traverse :: (a -> f b) -> Node v a -> f (Node v b)
traverse f :: a -> f b
f (Node i :: Interval v
i x :: a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (b -> Node v b) -> f b -> f (Node v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
instance TraversableWithIndex (Interval v) (Node v) where
itraverse :: (Interval v -> a -> f b) -> Node v a -> f (Node v b)
itraverse f :: Interval v -> a -> f b
f (Node i :: Interval v
i x :: a
x) = Interval v -> b -> Node v b
forall v a. Interval v -> a -> Node v a
Node Interval v
i (b -> Node v b) -> f b -> f (Node v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interval v -> a -> f b
f Interval v
i a
x
data IntInterval v = NoInterval | IntInterval (Interval v) v
instance Ord v => Monoid (IntInterval v) where
mempty :: IntInterval v
mempty = IntInterval v
forall v. IntInterval v
NoInterval
mappend :: IntInterval v -> IntInterval v -> IntInterval v
mappend = IntInterval v -> IntInterval v -> IntInterval v
forall a. Semigroup a => a -> a -> a
(<>)
instance Ord v => Semigroup (IntInterval v) where
NoInterval <> :: IntInterval v -> IntInterval v -> IntInterval v
<> i :: IntInterval v
i = IntInterval v
i
i :: IntInterval v
i <> NoInterval = IntInterval v
i
IntInterval _ hi1 :: v
hi1 <> IntInterval int2 :: Interval v
int2 hi2 :: v
hi2 =
Interval v -> v -> IntInterval v
forall v. Interval v -> v -> IntInterval v
IntInterval Interval v
int2 (v -> v -> v
forall a. Ord a => a -> a -> a
max v
hi1 v
hi2)
instance Ord v => Measured (IntInterval v) (Node v a) where
measure :: Node v a -> IntInterval v
measure (Node i :: Interval v
i _) = Interval v -> v -> IntInterval v
forall v. Interval v -> v -> IntInterval v
IntInterval Interval v
i (Interval v -> v
forall v. Interval v -> v
high Interval v
i)
newtype IntervalMap v a = IntervalMap { IntervalMap v a -> FingerTree (IntInterval v) (Node v a)
runIntervalMap :: FingerTree (IntInterval v) (Node v a) }
instance Functor (IntervalMap v) where
fmap :: (a -> b) -> IntervalMap v a -> IntervalMap v b
fmap f :: a -> b
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap ((Node v a -> Node v b)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v b)
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
FT.unsafeFmap ((a -> b) -> Node v a -> Node v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (IntInterval v) (Node v a)
t)
instance FunctorWithIndex (Interval v) (IntervalMap v) where
imap :: (Interval v -> a -> b) -> IntervalMap v a -> IntervalMap v b
imap f :: Interval v -> a -> b
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap ((Node v a -> Node v b)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v b)
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
FT.unsafeFmap ((Interval v -> a -> b) -> Node v a -> Node v b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Interval v -> a -> b
f) FingerTree (IntInterval v) (Node v a)
t)
instance Foldable (IntervalMap v) where
foldMap :: (a -> m) -> IntervalMap v a -> m
foldMap f :: a -> m
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = (Node v a -> m) -> FingerTree (IntInterval v) (Node v a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Node v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) FingerTree (IntInterval v) (Node v a)
t
instance FoldableWithIndex (Interval v) (IntervalMap v) where
ifoldMap :: (Interval v -> a -> m) -> IntervalMap v a -> m
ifoldMap f :: Interval v -> a -> m
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = (Node v a -> m) -> FingerTree (IntInterval v) (Node v a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Interval v -> a -> m) -> Node v a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Interval v -> a -> m
f) FingerTree (IntInterval v) (Node v a)
t
instance Traversable (IntervalMap v) where
traverse :: (a -> f b) -> IntervalMap v a -> f (IntervalMap v b)
traverse f :: a -> f b
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) =
FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v b) -> IntervalMap v b)
-> f (FingerTree (IntInterval v) (Node v b)) -> f (IntervalMap v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node v a -> f (Node v b))
-> FingerTree (IntInterval v) (Node v a)
-> f (FingerTree (IntInterval v) (Node v b))
forall (f :: * -> *) a b v.
Applicative f =>
(a -> f b) -> FingerTree v a -> f (FingerTree v b)
FT.unsafeTraverse ((a -> f b) -> Node v a -> f (Node v b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree (IntInterval v) (Node v a)
t
instance TraversableWithIndex (Interval v) (IntervalMap v) where
itraverse :: (Interval v -> a -> f b) -> IntervalMap v a -> f (IntervalMap v b)
itraverse f :: Interval v -> a -> f b
f (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) =
FingerTree (IntInterval v) (Node v b) -> IntervalMap v b
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v b) -> IntervalMap v b)
-> f (FingerTree (IntInterval v) (Node v b)) -> f (IntervalMap v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node v a -> f (Node v b))
-> FingerTree (IntInterval v) (Node v a)
-> f (FingerTree (IntInterval v) (Node v b))
forall (f :: * -> *) a b v.
Applicative f =>
(a -> f b) -> FingerTree v a -> f (FingerTree v b)
FT.unsafeTraverse ((Interval v -> a -> f b) -> Node v a -> f (Node v b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse Interval v -> a -> f b
f) FingerTree (IntInterval v) (Node v a)
t
instance Ord v => Measured (IntInterval v) (IntervalMap v a) where
measure :: IntervalMap v a -> IntInterval v
measure (IntervalMap m :: FingerTree (IntInterval v) (Node v a)
m) = FingerTree (IntInterval v) (Node v a) -> IntInterval v
forall v a. Measured v a => a -> v
measure FingerTree (IntInterval v) (Node v a)
m
largerError :: a
largerError :: a
largerError = String -> a
forall a. HasCallStack => String -> a
error "Text.Trifecta.IntervalMap.larger: the impossible happened"
instance Ord v => HasUnion (IntervalMap v a) where
union :: IntervalMap v a -> IntervalMap v a -> IntervalMap v a
union (IntervalMap xs :: FingerTree (IntInterval v) (Node v a)
xs) (IntervalMap ys :: FingerTree (IntInterval v) (Node v a)
ys) = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Ord v =>
FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 FingerTree (IntInterval v) (Node v a)
xs FingerTree (IntInterval v) (Node v a)
ys) where
merge1 :: FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 as :: FingerTree (IntInterval v) (Node v a)
as bs :: FingerTree (IntInterval v) (Node v a)
bs = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
as of
EmptyL -> FingerTree (IntInterval v) (Node v a)
bs
a :: Node v a
a@(Node i :: Interval v
i _) :< as' :: FingerTree (IntInterval v) (Node v a)
as' -> FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Node v a
a Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge2 FingerTree (IntInterval v) (Node v a)
as' FingerTree (IntInterval v) (Node v a)
r
where
(l :: FingerTree (IntInterval v) (Node v a)
l, r :: FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
bs
larger :: IntInterval v -> Bool
larger (IntInterval k :: Interval v
k _) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval v
i
larger _ = Bool
forall a. a
largerError
merge2 :: FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge2 as :: FingerTree (IntInterval v) (Node v a)
as bs :: FingerTree (IntInterval v) (Node v a)
bs = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (IntInterval v) (Node v a)
bs of
EmptyL -> FingerTree (IntInterval v) (Node v a)
as
b :: Node v a
b@(Node i :: Interval v
i _) :< bs' :: FingerTree (IntInterval v) (Node v a)
bs' -> FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Node v a
b Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
merge1 FingerTree (IntInterval v) (Node v a)
r FingerTree (IntInterval v) (Node v a)
bs'
where
(l :: FingerTree (IntInterval v) (Node v a)
l, r :: FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
as
larger :: IntInterval v -> Bool
larger (IntInterval k :: Interval v
k _) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval v
i
larger _ = Bool
forall a. a
largerError
instance Ord v => HasUnion0 (IntervalMap v a) where
empty :: IntervalMap v a
empty = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => FingerTree v a
FT.empty
instance Ord v => Monoid (IntervalMap v a) where
mempty :: IntervalMap v a
mempty = IntervalMap v a
forall f. HasUnion0 f => f
empty
mappend :: IntervalMap v a -> IntervalMap v a -> IntervalMap v a
mappend = IntervalMap v a -> IntervalMap v a -> IntervalMap v a
forall a. Semigroup a => a -> a -> a
(<>)
instance Ord v => Semigroup (IntervalMap v a) where
<> :: IntervalMap v a -> IntervalMap v a -> IntervalMap v a
(<>) = IntervalMap v a -> IntervalMap v a -> IntervalMap v a
forall f. HasUnion f => f -> f -> f
union
offset :: (Ord v, Monoid v) => v -> IntervalMap v a -> IntervalMap v a
offset :: v -> IntervalMap v a -> IntervalMap v a
offset v :: v
v (IntervalMap m :: FingerTree (IntInterval v) (Node v a)
m) = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v a) -> IntervalMap v a)
-> FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall a b. (a -> b) -> a -> b
$ (Node v a -> Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
FT.fmap' (\(Node (Interval lo :: v
lo hi :: v
hi) a :: a
a) -> Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node (v -> v -> Interval v
forall v. v -> v -> Interval v
Interval (v -> v -> v
forall a. Monoid a => a -> a -> a
mappend v
v v
lo) (v -> v -> v
forall a. Monoid a => a -> a -> a
mappend v
v v
hi)) a
a) FingerTree (IntInterval v) (Node v a)
m
singleton :: Ord v => Interval v -> a -> IntervalMap v a
singleton :: Interval v -> a -> IntervalMap v a
singleton i :: Interval v
i x :: a
x = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (Node v a -> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a
FT.singleton (Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node Interval v
i a
x))
insert :: Ord v => v -> v -> a -> IntervalMap v a -> IntervalMap v a
insert :: v -> v -> a -> IntervalMap v a -> IntervalMap v a
insert lo :: v
lo hi :: v
hi _ m :: IntervalMap v a
m | v
lo v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
hi = IntervalMap v a
m
insert lo :: v
lo hi :: v
hi x :: a
x (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
forall v a.
FingerTree (IntInterval v) (Node v a) -> IntervalMap v a
IntervalMap (FingerTree (IntInterval v) (Node v a)
l FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Interval v -> a -> Node v a
forall v a. Interval v -> a -> Node v a
Node Interval v
i a
x Node v a
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (IntInterval v) (Node v a)
r) where
i :: Interval v
i = v -> v -> Interval v
forall v. v -> v -> Interval v
Interval v
lo v
hi
(l :: FingerTree (IntInterval v) (Node v a)
l, r :: FingerTree (IntInterval v) (Node v a)
r) = (IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> (FingerTree (IntInterval v) (Node v a),
FingerTree (IntInterval v) (Node v a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split IntInterval v -> Bool
larger FingerTree (IntInterval v) (Node v a)
t
larger :: IntInterval v -> Bool
larger (IntInterval k :: Interval v
k _) = Interval v
k Interval v -> Interval v -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval v
i
larger _ = Bool
forall a. a
largerError
dominators :: Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
dominators :: v -> v -> IntervalMap v a -> [(Interval v, a)]
dominators i :: v
i j :: v
j = v -> v -> IntervalMap v a -> [(Interval v, a)]
forall v a. Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
intersections v
j v
i
search :: Ord v => v -> IntervalMap v a -> [(Interval v, a)]
search :: v -> IntervalMap v a -> [(Interval v, a)]
search p :: v
p = v -> v -> IntervalMap v a -> [(Interval v, a)]
forall v a. Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
intersections v
p v
p
intersections :: Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
intersections :: v -> v -> IntervalMap v a -> [(Interval v, a)]
intersections lo :: v
lo hi :: v
hi (IntervalMap t :: FingerTree (IntInterval v) (Node v a)
t) = FingerTree (IntInterval v) (Node v a) -> [(Interval v, a)]
matches ((IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
FT.takeUntil (v -> IntInterval v -> Bool
forall v. Ord v => v -> IntInterval v -> Bool
greater v
hi) FingerTree (IntInterval v) (Node v a)
t) where
matches :: FingerTree (IntInterval v) (Node v a) -> [(Interval v, a)]
matches xs :: FingerTree (IntInterval v) (Node v a)
xs = case FingerTree (IntInterval v) (Node v a)
-> ViewL (FingerTree (IntInterval v)) (Node v a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl ((IntInterval v -> Bool)
-> FingerTree (IntInterval v) (Node v a)
-> FingerTree (IntInterval v) (Node v a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
FT.dropUntil (v -> IntInterval v -> Bool
forall v. Ord v => v -> IntInterval v -> Bool
atleast v
lo) FingerTree (IntInterval v) (Node v a)
xs) of
EmptyL -> []
Node i :: Interval v
i x :: a
x :< xs' :: FingerTree (IntInterval v) (Node v a)
xs' -> (Interval v
i, a
x) (Interval v, a) -> [(Interval v, a)] -> [(Interval v, a)]
forall a. a -> [a] -> [a]
: FingerTree (IntInterval v) (Node v a) -> [(Interval v, a)]
matches FingerTree (IntInterval v) (Node v a)
xs'
atleast :: Ord v => v -> IntInterval v -> Bool
atleast :: v -> IntInterval v -> Bool
atleast k :: v
k (IntInterval _ hi :: v
hi) = v
k v -> v -> Bool
forall a. Ord a => a -> a -> Bool
<= v
hi
atleast _ _ = Bool
False
greater :: Ord v => v -> IntInterval v -> Bool
greater :: v -> IntInterval v -> Bool
greater k :: v
k (IntInterval i :: Interval v
i _) = Interval v -> v
forall v. Interval v -> v
low Interval v
i v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
k
greater _ _ = Bool
False
fromList :: Ord v => [(v, v, a)] -> IntervalMap v a
fromList :: [(v, v, a)] -> IntervalMap v a
fromList = ((v, v, a) -> IntervalMap v a -> IntervalMap v a)
-> IntervalMap v a -> [(v, v, a)] -> IntervalMap v a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v, v, a) -> IntervalMap v a -> IntervalMap v a
forall v a.
Ord v =>
(v, v, a) -> IntervalMap v a -> IntervalMap v a
ins IntervalMap v a
forall f. HasUnion0 f => f
empty where
ins :: (v, v, a) -> IntervalMap v a -> IntervalMap v a
ins (lo :: v
lo, hi :: v
hi, n :: a
n) = v -> v -> a -> IntervalMap v a -> IntervalMap v a
forall v a.
Ord v =>
v -> v -> a -> IntervalMap v a -> IntervalMap v a
insert v
lo v
hi a
n