{-# 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
-- Copyright   :  (c) Edward Kmett 2011-2019
--                (c) Ross Paterson 2008
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs, type families, functional dependencies)
--
-- Interval maps implemented using the 'FingerTree' type, following
-- section 4.8 of
--
--    * Ralf Hinze and Ross Paterson,
--      \"Finger trees: a simple general-purpose data structure\",
--      /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
--      <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
--
-- An amortized running time is given for each operation, with /n/
-- referring to the size of the priority queue.  These bounds hold even
-- in a persistent (shared) setting.
--
-- /Note/: Many of these operations have the same names as similar
-- operations on lists in the "Prelude".  The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-- Unlike "Data.IntervalMap.FingerTree", this version sorts things so
-- that the largest interval from a given point comes first. This way
-- if you have nested intervals, you get the outermost interval before
-- the contained intervals.
-----------------------------------------------------------------------------
module Text.Trifecta.Util.IntervalMap
  (
  -- * Intervals
    Interval(..)
  -- * Interval maps
  , IntervalMap(..), singleton, insert
  -- * Searching
  , search, intersections, dominators
  -- * Prepending an offset onto every interval in the map
  , offset
  -- * The result monoid
  , 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

----------------------------------
-- 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 { 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)

-- assumes the monoid and ordering are compatible.
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 -- reversed to put larger intervals first
    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

-- rightmost interval (including largest lower bound) and largest upper bound.
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)

-- | Map of closed intervals, possibly with duplicates.
-- The 'Foldable' and 'Traversable' instances process the intervals in
-- lexicographical order.
newtype IntervalMap v a = IntervalMap { IntervalMap v a -> FingerTree (IntInterval v) (Node v a)
runIntervalMap :: FingerTree (IntInterval v) (Node v a) }
-- ordered lexicographically by interval

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"

-- | /O(m log (n/\//m))/.  Merge two interval maps.
-- The map may contain duplicate intervals; entries with equal intervals
-- are kept in the original order.
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

-- | /O(n)/. Add a delta to each interval in the map
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

-- | /O(1)/.  Interval map with a single entry.
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))

-- | /O(log n)/.  Insert an interval into a map.
-- The map may contain duplicate intervals; the new entry will be inserted
-- before any existing entries for the same interval.
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

-- | /O(k log (n/\//k))/.  All intervals that contain the given interval,
-- in lexicographical order.
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

-- | /O(k log (n/\//k))/.  All intervals that contain the given point,
-- in lexicographical order.
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

-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
-- interval, in lexicographical order.
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