{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.SegmentSet.Strict
-- Copyright   :  (c) Arbor Networks 2017
-- License     :  BSD-style
-- Maintainer  :  mayhem@arbor.net
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs and functional dependencies)
--
-- SegmentSet provides an efficient implementation of a set of segments (a.k.a
-- intervals). Segments in the set are non-overlapping. Adjacent segments
-- are merged (i.e. (a .. b), (b + 1 .. c) -> (a .. c)).
--
-- Segment sets are 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 Programmaxg/ 16:2 (2006) pp 197-217.
--    <http://staff.city.ac.uk/~ross/papers/FingerTree.html>
--
-- An amortized running time is given for each operation, with /n/
-- referring to the size of the set.  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.
--
-----------------------------------------------------------------------------

module HaskellWorks.Data.SegmentSet.Strict
  ( -- * Segments
    Segment(..), point,
    -- * Segment maps
    SegmentSet(..),
    OrderedMap(..),
    delete,
    empty,
    fromList,
    insert,
    singleton,
    update,
    segmentSetToList,

    Item(..),
    cappedL,
    cappedM
    ) where

import Control.Applicative                 ((<$>))
import Control.DeepSeq                     (NFData)
import Data.Foldable                       (Foldable (foldMap), foldl', toList)
import Data.Semigroup
import Data.Traversable                    (Traversable (traverse))
import GHC.Generics                        (Generic)
import HaskellWorks.Data.FingerTree.Strict (FingerTree, Measured (..), ViewL (..), ViewR (..), viewl, viewr, (<|), (><))
import HaskellWorks.Data.Item.Strict
import HaskellWorks.Data.Segment.Strict

import qualified HaskellWorks.Data.FingerTree.Strict as FT

{- HLINT ignore "Reduce duplication"  -}

infixr 5 >*<

----------------------------------
-- 4.8 Application: segment trees
----------------------------------

-- | Map of closed segments, possibly with duplicates.
-- The 'Foldable' and 'Traversable' instances process the segments in
-- lexicographical order.

newtype OrderedMap k a = OrderedMap (FingerTree k (Item k a)) deriving (Int -> OrderedMap k a -> ShowS
[OrderedMap k a] -> ShowS
OrderedMap k a -> String
(Int -> OrderedMap k a -> ShowS)
-> (OrderedMap k a -> String)
-> ([OrderedMap k a] -> ShowS)
-> Show (OrderedMap k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> OrderedMap k a -> ShowS
forall k a. (Show k, Show a) => [OrderedMap k a] -> ShowS
forall k a. (Show k, Show a) => OrderedMap k a -> String
showList :: [OrderedMap k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [OrderedMap k a] -> ShowS
show :: OrderedMap k a -> String
$cshow :: forall k a. (Show k, Show a) => OrderedMap k a -> String
showsPrec :: Int -> OrderedMap k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> OrderedMap k a -> ShowS
Show, (forall x. OrderedMap k a -> Rep (OrderedMap k a) x)
-> (forall x. Rep (OrderedMap k a) x -> OrderedMap k a)
-> Generic (OrderedMap k a)
forall x. Rep (OrderedMap k a) x -> OrderedMap k a
forall x. OrderedMap k a -> Rep (OrderedMap k a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k a x. Rep (OrderedMap k a) x -> OrderedMap k a
forall k a x. OrderedMap k a -> Rep (OrderedMap k a) x
$cto :: forall k a x. Rep (OrderedMap k a) x -> OrderedMap k a
$cfrom :: forall k a x. OrderedMap k a -> Rep (OrderedMap k a) x
Generic, OrderedMap k a -> ()
(OrderedMap k a -> ()) -> NFData (OrderedMap k a)
forall a. (a -> ()) -> NFData a
forall k a. (NFData k, NFData a) => OrderedMap k a -> ()
rnf :: OrderedMap k a -> ()
$crnf :: forall k a. (NFData k, NFData a) => OrderedMap k a -> ()
NFData)

newtype SegmentSet k = SegmentSet (OrderedMap (Max k) (Segment k)) deriving (Int -> SegmentSet k -> ShowS
[SegmentSet k] -> ShowS
SegmentSet k -> String
(Int -> SegmentSet k -> ShowS)
-> (SegmentSet k -> String)
-> ([SegmentSet k] -> ShowS)
-> Show (SegmentSet k)
forall k. Show k => Int -> SegmentSet k -> ShowS
forall k. Show k => [SegmentSet k] -> ShowS
forall k. Show k => SegmentSet k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentSet k] -> ShowS
$cshowList :: forall k. Show k => [SegmentSet k] -> ShowS
show :: SegmentSet k -> String
$cshow :: forall k. Show k => SegmentSet k -> String
showsPrec :: Int -> SegmentSet k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> SegmentSet k -> ShowS
Show, (forall x. SegmentSet k -> Rep (SegmentSet k) x)
-> (forall x. Rep (SegmentSet k) x -> SegmentSet k)
-> Generic (SegmentSet k)
forall x. Rep (SegmentSet k) x -> SegmentSet k
forall x. SegmentSet k -> Rep (SegmentSet k) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k x. Rep (SegmentSet k) x -> SegmentSet k
forall k x. SegmentSet k -> Rep (SegmentSet k) x
$cto :: forall k x. Rep (SegmentSet k) x -> SegmentSet k
$cfrom :: forall k x. SegmentSet k -> Rep (SegmentSet k) x
Generic, SegmentSet k -> ()
(SegmentSet k -> ()) -> NFData (SegmentSet k)
forall k. NFData k => SegmentSet k -> ()
forall a. (a -> ()) -> NFData a
rnf :: SegmentSet k -> ()
$crnf :: forall k. NFData k => SegmentSet k -> ()
NFData)

-- ordered lexicographically by segment start

instance Functor (OrderedMap k) where
    fmap :: (a -> b) -> OrderedMap k a -> OrderedMap k b
fmap a -> b
f (OrderedMap FingerTree k (Item k a)
t) = FingerTree k (Item k b) -> OrderedMap k b
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap ((Item k a -> Item k b)
-> FingerTree k (Item k a) -> FingerTree k (Item k b)
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
FT.unsafeFmap ((a -> b) -> Item k a -> Item k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree k (Item k a)
t)

instance Foldable (OrderedMap k) where
    foldMap :: (a -> m) -> OrderedMap k a -> m
foldMap a -> m
f (OrderedMap FingerTree k (Item k a)
t) = (Item k a -> m) -> FingerTree k (Item k a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Item k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) FingerTree k (Item k a)
t

instance Traversable (OrderedMap k) where
    traverse :: (a -> f b) -> OrderedMap k a -> f (OrderedMap k b)
traverse a -> f b
f (OrderedMap FingerTree k (Item k a)
t) = FingerTree k (Item k b) -> OrderedMap k b
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap (FingerTree k (Item k b) -> OrderedMap k b)
-> f (FingerTree k (Item k b)) -> f (OrderedMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Item k a -> f (Item k b))
-> FingerTree k (Item k a) -> f (FingerTree k (Item k b))
forall (f :: * -> *) a b v.
Applicative f =>
(a -> f b) -> FingerTree v a -> f (FingerTree v b)
FT.unsafeTraverse ((a -> f b) -> Item k a -> f (Item k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree k (Item k a)
t

-- instance Foldable (SegmentSet k) where
--     foldMap f (SegmentSet t) = foldMap (foldMap f) t

segmentSetToList :: SegmentSet k -> [Segment k]
segmentSetToList :: SegmentSet k -> [Segment k]
segmentSetToList (SegmentSet OrderedMap (Max k) (Segment k)
m) = OrderedMap (Max k) (Segment k) -> [Segment k]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrderedMap (Max k) (Segment k)
m

-- instance Traversable (SegmentSet k) where
--     traverse f (SegmentSet t) =
--         SegmentSet <$> FT.unsafeTraverse (traverse f) t

-- | /O(1)/.  The empty segment set.
empty :: SegmentSet k
empty :: SegmentSet k
empty = OrderedMap (Max k) (Segment k) -> SegmentSet k
forall k. OrderedMap (Max k) (Segment k) -> SegmentSet k
SegmentSet (FingerTree (Max k) (Item (Max k) (Segment k))
-> OrderedMap (Max k) (Segment k)
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap FingerTree (Max k) (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty)

-- | /O(1)/.  Segment set with a single entry.
singleton :: Segment k -> SegmentSet k
singleton :: Segment k -> SegmentSet k
singleton s :: Segment k
s@(Segment k
lo k
hi) = OrderedMap (Max k) (Segment k) -> SegmentSet k
forall k. OrderedMap (Max k) (Segment k) -> SegmentSet k
SegmentSet (OrderedMap (Max k) (Segment k) -> SegmentSet k)
-> OrderedMap (Max k) (Segment k) -> SegmentSet k
forall a b. (a -> b) -> a -> b
$ FingerTree (Max k) (Item (Max k) (Segment k))
-> OrderedMap (Max k) (Segment k)
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap (FingerTree (Max k) (Item (Max k) (Segment k))
 -> OrderedMap (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> OrderedMap (Max k) (Segment k)
forall a b. (a -> b) -> a -> b
$ Item (Max k) (Segment k)
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (Item (Max k) (Segment k)
 -> FingerTree (Max k) (Item (Max k) (Segment k)))
-> Item (Max k) (Segment k)
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall a b. (a -> b) -> a -> b
$ Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
lo) Segment k
s

-- | /O(log(n))/. Remove a segment from the set.
-- Alias of update.
delete :: forall k a. (Bounded k, Ord k, Enum k, Show k)
       => Segment k
       -> SegmentSet k
       -> SegmentSet k
delete :: Segment k -> SegmentSet k -> SegmentSet k
delete = (Segment k -> Bool -> SegmentSet k -> SegmentSet k)
-> Bool -> Segment k -> SegmentSet k -> SegmentSet k
forall a b c. (a -> b -> c) -> b -> a -> c
flip Segment k -> Bool -> SegmentSet k -> SegmentSet k
forall k a.
(Ord k, Enum k, Bounded k, Show k) =>
Segment k -> Bool -> SegmentSet k -> SegmentSet k
update Bool
False

-- | /O(log(n))/. Insert a segment into the set.
-- Alias of update.
insert :: forall k a. (Bounded k, Ord k, Enum k, Show k)
       => Segment k
       -> SegmentSet k
       -> SegmentSet k
insert :: Segment k -> SegmentSet k -> SegmentSet k
insert = (Segment k -> Bool -> SegmentSet k -> SegmentSet k)
-> Bool -> Segment k -> SegmentSet k -> SegmentSet k
forall a b c. (a -> b -> c) -> b -> a -> c
flip Segment k -> Bool -> SegmentSet k -> SegmentSet k
forall k a.
(Ord k, Enum k, Bounded k, Show k) =>
Segment k -> Bool -> SegmentSet k -> SegmentSet k
update Bool
True

-- | Update a segment set. Prefer `insert` or `delete` in most cases.
update :: forall k a. (Ord k, Enum k, Bounded k, Show k)
       => Segment k
       -> Bool
       -> SegmentSet k
       -> SegmentSet k
update :: Segment k -> Bool -> SegmentSet k -> SegmentSet k
update (Segment k
lo k
hi)   Bool
_  SegmentSet k
m | k
lo k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
hi                = SegmentSet k
m
update s :: Segment k
s@(Segment k
lo k
hi) Bool
b (SegmentSet (OrderedMap FingerTree (Max k) (Item (Max k) (Segment k))
t)) =
  OrderedMap (Max k) (Segment k) -> SegmentSet k
forall k. OrderedMap (Max k) (Segment k) -> SegmentSet k
SegmentSet (OrderedMap (Max k) (Segment k) -> SegmentSet k)
-> OrderedMap (Max k) (Segment k) -> SegmentSet k
forall a b. (a -> b) -> a -> b
$ FingerTree (Max k) (Item (Max k) (Segment k))
-> OrderedMap (Max k) (Segment k)
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap FingerTree (Max k) (Item (Max k) (Segment k))
contents
  where
    contents :: FingerTree (Max k) (Item (Max k) (Segment k))
contents = if Bool
b then FingerTree (Max k) (Item (Max k) (Segment k))
at FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Bounded k) =>
FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
>*< FingerTree (Max k) (Item (Max k) (Segment k))
forall v. FingerTree v (Item (Max k) (Segment k))
bbbb FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Bounded k) =>
FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
>*< FingerTree (Max k) (Item (Max k) (Segment k))
cccc else FingerTree (Max k) (Item (Max k) (Segment k))
at FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Bounded k) =>
FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
>*< FingerTree (Max k) (Item (Max k) (Segment k))
cccc
    (FingerTree (Max k) (Item (Max k) (Segment k))
fstPivotLt, FingerTree (Max k) (Item (Max k) (Segment k))
fstPivotRt) = (Max k -> Bool)
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split (Max k -> Max k -> Bool
forall a. Ord a => a -> a -> Bool
>= k -> Max k
forall a. a -> Max a
Max k
lo) FingerTree (Max k) (Item (Max k) (Segment k))
t
    (FingerTree (Max k) (Item (Max k) (Segment k))
at, FingerTree (Max k) (Item (Max k) (Segment k))
atSurplus) = k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
forall k.
(Enum k, Ord k, Bounded k, Show k) =>
k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
cappedL k
lo FingerTree (Max k) (Item (Max k) (Segment k))
fstPivotLt
    (FingerTree (Max k) (Item (Max k) (Segment k))
zs, FingerTree (Max k) (Item (Max k) (Segment k))
remainder) = (Max k -> Bool)
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split (Max k -> Max k -> Bool
forall a. Ord a => a -> a -> Bool
> k -> Max k
forall a. a -> Max a
Max k
hi) (FingerTree (Max k) (Item (Max k) (Segment k))
atSurplus FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Bounded k) =>
FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
>*< FingerTree (Max k) (Item (Max k) (Segment k))
fstPivotRt)
    e :: FingerTree v (Item (Max k) (Segment k))
e = FingerTree v (Item (Max k) (Segment k))
-> (Item (Max k) (Segment k)
    -> FingerTree v (Item (Max k) (Segment k)))
-> Maybe (Item (Max k) (Segment k))
-> FingerTree v (Item (Max k) (Segment k))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree v (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.Empty Item (Max k) (Segment k) -> FingerTree v (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (FingerTree (Max k) (Item (Max k) (Segment k))
-> Maybe (Item (Max k) (Segment k))
forall v a. Measured v a => FingerTree v a -> Maybe a
FT.maybeLast FingerTree (Max k) (Item (Max k) (Segment k))
zs Maybe (Item (Max k) (Segment k))
-> (Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k)))
-> Maybe (Item (Max k) (Segment k))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= k -> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Show k) =>
k -> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
capM k
hi)
    rt :: FingerTree (Max k) (Item (Max k) (Segment k))
rt = FingerTree (Max k) (Item (Max k) (Segment k))
forall v. FingerTree v (Item (Max k) (Segment k))
e FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k))
remainder
    cccc :: FingerTree (Max k) (Item (Max k) (Segment k))
cccc = k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Enum k, Ord k, Bounded k, Show k) =>
k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
cappedM k
hi FingerTree (Max k) (Item (Max k) (Segment k))
rt
    bbbb :: FingerTree v (Item (Max k) (Segment k))
bbbb = Item (Max k) (Segment k) -> FingerTree v (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
lo) Segment k
s)

cappedL :: (Enum k, Ord k, Bounded k, Show k)
  => k
  -> FingerTree (Max k) (Item (Max k) (Segment k))
  -> (FingerTree (Max k) (Item (Max k) (Segment k)), FingerTree (Max k) (Item (Max k) (Segment k)))
cappedL :: k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
cappedL k
lo FingerTree (Max k) (Item (Max k) (Segment k))
t = case FingerTree (Max k) (Item (Max k) (Segment k))
-> ViewR (FingerTree (Max k)) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree (Max k) (Item (Max k) (Segment k))
t of
  ViewR (FingerTree (Max k)) (Item (Max k) (Segment k))
EmptyR      -> (FingerTree (Max k) (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty, FingerTree (Max k) (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty)
  FingerTree (Max k) (Item (Max k) (Segment k))
ltp :> Item (Max k) (Segment k)
item -> FingerTree (Max k) (Item (Max k) (Segment k))
-> Item (Max k) (Segment k)
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree (Max k) (Item (Max k) (Segment k)))
forall k v.
FingerTree (Max k) (Item (Max k) (Segment k))
-> Item k (Segment k)
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree v (Item (Max k) (Segment k)))
resolve FingerTree (Max k) (Item (Max k) (Segment k))
ltp Item (Max k) (Segment k)
item
  where resolve :: FingerTree (Max k) (Item (Max k) (Segment k))
-> Item k (Segment k)
-> (FingerTree (Max k) (Item (Max k) (Segment k)),
    FingerTree v (Item (Max k) (Segment k)))
resolve FingerTree (Max k) (Item (Max k) (Segment k))
ltp (Item k
_ (Segment k
lilo k
lihi))
            | k
lo k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
lilo  = (FingerTree (Max k) (Item (Max k) (Segment k))
ltp         , FingerTree v (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty)
            | k
lo k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<  k
lihi  = (FingerTree (Max k) (Item (Max k) (Segment k))
ltp FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k))
forall v. FingerTree v (Item (Max k) (Segment k))
lPart, FingerTree v (Item (Max k) (Segment k))
forall v. FingerTree v (Item (Max k) (Segment k))
rPart   )
            | k
lo k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
lihi  = (FingerTree (Max k) (Item (Max k) (Segment k))
ltp FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k))
forall v. FingerTree v (Item (Max k) (Segment k))
lPart, FingerTree v (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty)
            | Bool
otherwise   = (FingerTree (Max k) (Item (Max k) (Segment k))
t           , FingerTree v (Item (Max k) (Segment k))
forall v a. FingerTree v a
FT.empty)
          where lPart :: FingerTree v (Item (Max k) (Segment k))
lPart = Item (Max k) (Segment k) -> FingerTree v (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
lilo) (k -> k -> Segment k
forall k. k -> k -> Segment k
Segment k
lilo (k -> k
forall a. Enum a => a -> a
pred k
lo)))
                rPart :: FingerTree v (Item (Max k) (Segment k))
rPart = Item (Max k) (Segment k) -> FingerTree v (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
lo  ) (k -> k -> Segment k
forall k. k -> k -> Segment k
Segment k
lo   k
lihi     ))

cappedM :: (Enum k, Ord k, Bounded k, Show k)
  => k
  -> FingerTree (Max k) (Item (Max k) (Segment k))
  -> FingerTree (Max k) (Item (Max k) (Segment k))
cappedM :: k
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
cappedM k
hi FingerTree (Max k) (Item (Max k) (Segment k))
t = case FingerTree (Max k) (Item (Max k) (Segment k))
-> ViewL (FingerTree (Max k)) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree (Max k) (Item (Max k) (Segment k))
t of
  ViewL (FingerTree (Max k)) (Item (Max k) (Segment k))
EmptyL   -> FingerTree (Max k) (Item (Max k) (Segment k))
t
  Item (Max k) (Segment k)
n :< FingerTree (Max k) (Item (Max k) (Segment k))
rtp -> FingerTree (Max k) (Item (Max k) (Segment k))
-> (Item (Max k) (Segment k)
    -> FingerTree (Max k) (Item (Max k) (Segment k)))
-> Maybe (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree (Max k) (Item (Max k) (Segment k))
rtp (Item (Max k) (Segment k)
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Max k) (Item (Max k) (Segment k))
rtp) (k -> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Show k) =>
k -> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
capM k
hi Item (Max k) (Segment k)
n)

capM :: (Ord k, Enum k, Show k)
  => k
  -> Item (Max k) (Segment k)
  -> Maybe (Item (Max k) (Segment k))
capM :: k -> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
capM k
lihi n :: Item (Max k) (Segment k)
n@(Item Max k
_ (Segment k
rilo k
rihi))
  | k
lihi k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
rilo = Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
forall a. a -> Maybe a
Just Item (Max k) (Segment k)
n
  | k
lihi k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
rihi = Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
forall a. a -> Maybe a
Just (Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k)))
-> Item (Max k) (Segment k) -> Maybe (Item (Max k) (Segment k))
forall a b. (a -> b) -> a -> b
$ Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max (k -> k
forall a. Enum a => a -> a
succ k
lihi)) (k -> k -> Segment k
forall k. k -> k -> Segment k
Segment (k -> k
forall a. Enum a => a -> a
succ k
lihi) k
rihi)
  | Bool
otherwise   = Maybe (Item (Max k) (Segment k))
forall a. Maybe a
Nothing

fromList :: (Ord v, Enum v, Bounded v, Show v)
  => [Segment v]
  -> SegmentSet v
fromList :: [Segment v] -> SegmentSet v
fromList = (SegmentSet v -> Segment v -> SegmentSet v)
-> SegmentSet v -> [Segment v] -> SegmentSet v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Segment v -> SegmentSet v -> SegmentSet v)
-> SegmentSet v -> Segment v -> SegmentSet v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Segment v -> SegmentSet v -> SegmentSet v
forall k a.
(Bounded k, Ord k, Enum k, Show k) =>
Segment k -> SegmentSet k -> SegmentSet k
insert) SegmentSet v
forall k. SegmentSet k
empty

--------------------------------------------------------------------------------
-- Private functions
--------------------------------------------------------------------------------

-- | /O(log(n))/. Merge two segment sets.
-- Private (bare) function to merge two segment sets.
-- Requires two guarantees from the caller:
-- 1) That the sets are non-overlapping, and
-- 2) That the left tree is "less" than the right tree. i.e. that the maximum
-- high in the left tree is less than the minimum low in the right tree.
-- If the two middle-most segments are adjacent:
--   (max (hi left) == succ (min (low right))
-- then those two segments will be merged.
merge :: (Ord k, Enum k, Bounded k)
       => FingerTree (Max k) (Item (Max k) (Segment k))
       -> FingerTree (Max k) (Item (Max k) (Segment k))
       -> FingerTree (Max k) (Item (Max k) (Segment k))
merge :: FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
merge FingerTree (Max k) (Item (Max k) (Segment k))
lt FingerTree (Max k) (Item (Max k) (Segment k))
rt = case FingerTree (Max k) (Item (Max k) (Segment k))
-> ViewR (FingerTree (Max k)) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree (Max k) (Item (Max k) (Segment k))
lt of
  ViewR (FingerTree (Max k)) (Item (Max k) (Segment k))
EmptyR          -> FingerTree (Max k) (Item (Max k) (Segment k))
rt
  FingerTree (Max k) (Item (Max k) (Segment k))
treeL :> Item Max k
_ (Segment k
loL k
hiL)  -> case FingerTree (Max k) (Item (Max k) (Segment k))
-> ViewL (FingerTree (Max k)) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree (Max k) (Item (Max k) (Segment k))
rt of
    ViewL (FingerTree (Max k)) (Item (Max k) (Segment k))
EmptyL         -> FingerTree (Max k) (Item (Max k) (Segment k))
lt
    Item Max k
_ (Segment k
loR k
hiR) :< FingerTree (Max k) (Item (Max k) (Segment k))
treeR ->
        if k -> k
forall a. Enum a => a -> a
succ k
hiL k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
loR
          then FingerTree (Max k) (Item (Max k) (Segment k))
treeL FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Item (Max k) (Segment k)
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> Segment k -> Item (Max k) (Segment k)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
loL) (k -> k -> Segment k
forall k. k -> k -> Segment k
Segment k
loL k
hiR)) FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k))
treeR
          else FingerTree (Max k) (Item (Max k) (Segment k))
lt FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k))
rt

-- | Operator version of merge.
(>*<) :: (Ord k, Enum k, Bounded k)
      => FingerTree (Max k) (Item (Max k) (Segment k))
      -> FingerTree (Max k) (Item (Max k) (Segment k))
      -> FingerTree (Max k) (Item (Max k) (Segment k))
>*< :: FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
(>*<) = FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
forall k.
(Ord k, Enum k, Bounded k) =>
FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
-> FingerTree (Max k) (Item (Max k) (Segment k))
merge