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

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.SegmentMap.Strict
-- Copyright   :  (c) Arbor Networks 2017
-- License     :  BSD-style
-- Maintainer  :  mayhem@arbor.net
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs and functional dependencies)
--
-- Segment 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 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 map.  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.SegmentMap.Strict
  ( -- * Segments
    Segment(..), point,
    -- * Segment maps
    SegmentMap(..),
    OrderedMap(..),
    delete,
    empty,
    fromList,
    insert,
    singleton,
    update,
    segmentMapToList,

    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, ViewL (..), ViewR (..), viewl, viewr, (<|), (><))
import HaskellWorks.Data.Item.Strict
import HaskellWorks.Data.Segment.Strict

import qualified HaskellWorks.Data.FingerTree.Strict as FT

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 SegmentMap k a = SegmentMap (OrderedMap (Max k) (Segment k, a)) deriving (Int -> SegmentMap k a -> ShowS
[SegmentMap k a] -> ShowS
SegmentMap k a -> String
(Int -> SegmentMap k a -> ShowS)
-> (SegmentMap k a -> String)
-> ([SegmentMap k a] -> ShowS)
-> Show (SegmentMap k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> SegmentMap k a -> ShowS
forall k a. (Show k, Show a) => [SegmentMap k a] -> ShowS
forall k a. (Show k, Show a) => SegmentMap k a -> String
showList :: [SegmentMap k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [SegmentMap k a] -> ShowS
show :: SegmentMap k a -> String
$cshow :: forall k a. (Show k, Show a) => SegmentMap k a -> String
showsPrec :: Int -> SegmentMap k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> SegmentMap k a -> ShowS
Show, (forall x. SegmentMap k a -> Rep (SegmentMap k a) x)
-> (forall x. Rep (SegmentMap k a) x -> SegmentMap k a)
-> Generic (SegmentMap k a)
forall x. Rep (SegmentMap k a) x -> SegmentMap k a
forall x. SegmentMap k a -> Rep (SegmentMap k a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k a x. Rep (SegmentMap k a) x -> SegmentMap k a
forall k a x. SegmentMap k a -> Rep (SegmentMap k a) x
$cto :: forall k a x. Rep (SegmentMap k a) x -> SegmentMap k a
$cfrom :: forall k a x. SegmentMap k a -> Rep (SegmentMap k a) x
Generic, SegmentMap k a -> ()
(SegmentMap k a -> ()) -> NFData (SegmentMap k a)
forall a. (a -> ()) -> NFData a
forall k a. (NFData k, NFData a) => SegmentMap k a -> ()
rnf :: SegmentMap k a -> ()
$crnf :: forall k a. (NFData k, NFData a) => SegmentMap k a -> ()
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 Functor (SegmentMap k) where
    fmap :: (a -> b) -> SegmentMap k a -> SegmentMap k b
fmap a -> b
f (SegmentMap OrderedMap (Max k) (Segment k, a)
t) = OrderedMap (Max k) (Segment k, b) -> SegmentMap k b
forall k a. OrderedMap (Max k) (Segment k, a) -> SegmentMap k a
SegmentMap (((Segment k, a) -> (Segment k, b))
-> OrderedMap (Max k) (Segment k, a)
-> OrderedMap (Max k) (Segment k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (Segment k, a) -> (Segment k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) OrderedMap (Max k) (Segment k, a)
t)

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

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

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

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

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

delete :: forall k a. (Bounded k, Ord k, Enum k, Eq a, Show k, Show a)
       => Segment k
       -> SegmentMap k a
       -> SegmentMap k a
delete :: Segment k -> SegmentMap k a -> SegmentMap k a
delete = (Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a)
-> Maybe a -> Segment k -> SegmentMap k a -> SegmentMap k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a
forall k a.
(Ord k, Enum k, Bounded k, Eq a, Show k, Show a) =>
Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a
update Maybe a
forall a. Maybe a
Nothing

insert :: forall k a. (Bounded k, Ord k, Enum k, Eq a, Show k, Show a)
       => Segment k
       -> a
       -> SegmentMap k a
       -> SegmentMap k a
insert :: Segment k -> a -> SegmentMap k a -> SegmentMap k a
insert Segment k
s a
a = Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a
forall k a.
(Ord k, Enum k, Bounded k, Eq a, Show k, Show a) =>
Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a
update Segment k
s (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

(>*<) :: (Ord k, Enum k, Bounded k, Eq a)
      => FingerTree (Max k) (Item (Max k) (Segment k, a))
      -> FingerTree (Max k) (Item (Max k) (Segment k, a))
      -> FingerTree (Max k) (Item (Max k) (Segment k, a))
>*< :: FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
(>*<) FingerTree (Max k) (Item (Max k) (Segment k, a))
lt FingerTree (Max k) (Item (Max k) (Segment k, a))
rt = case FingerTree (Max k) (Item (Max k) (Segment k, a))
-> ViewR (FingerTree (Max k)) (Item (Max k) (Segment k, a))
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree (Max k) (Item (Max k) (Segment k, a))
lt of
  ViewR (FingerTree (Max k)) (Item (Max k) (Segment k, a))
EmptyR          -> FingerTree (Max k) (Item (Max k) (Segment k, a))
rt
  FingerTree (Max k) (Item (Max k) (Segment k, a))
treeL :> Item Max k
_ (Segment k
loL k
hiL, a
itemL)  -> case FingerTree (Max k) (Item (Max k) (Segment k, a))
-> ViewL (FingerTree (Max k)) (Item (Max k) (Segment k, a))
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree (Max k) (Item (Max k) (Segment k, a))
rt of
    ViewL (FingerTree (Max k)) (Item (Max k) (Segment k, a))
EmptyL         -> FingerTree (Max k) (Item (Max k) (Segment k, a))
lt
    Item Max k
_ (Segment k
loR k
hiR, a
itemR) :< FingerTree (Max k) (Item (Max k) (Segment k, a))
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 Bool -> Bool -> Bool
&& a
itemL a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
itemR
          then FingerTree (Max k) (Item (Max k) (Segment k, a))
treeL FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< Item (Max k) (Segment k, a)
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> (Segment k, a) -> Item (Max k) (Segment k, a)
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, a
itemL)) FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k, a))
treeR
          else FingerTree (Max k) (Item (Max k) (Segment k, a))
lt FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree (Max k) (Item (Max k) (Segment k, a))
rt

update :: forall k a. (Ord k, Enum k, Bounded k, Eq a, Show k, Show a)
       => Segment k
       -> Maybe a
       -> SegmentMap k a
       -> SegmentMap k a
update :: Segment k -> Maybe a -> SegmentMap k a -> SegmentMap k a
update (Segment k
lo k
hi)   Maybe a
_        SegmentMap k a
m | k
lo k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
hi    = SegmentMap k a
m
update Segment k
_                 Maybe a
Nothing  SegmentMap k a
m              = SegmentMap k a
m
update s :: Segment k
s@(Segment k
lo k
hi) (Just a
x) (SegmentMap (OrderedMap FingerTree (Max k) (Item (Max k) (Segment k, a))
t)) =
  OrderedMap (Max k) (Segment k, a) -> SegmentMap k a
forall k a. OrderedMap (Max k) (Segment k, a) -> SegmentMap k a
SegmentMap (OrderedMap (Max k) (Segment k, a) -> SegmentMap k a)
-> OrderedMap (Max k) (Segment k, a) -> SegmentMap k a
forall a b. (a -> b) -> a -> b
$ FingerTree (Max k) (Item (Max k) (Segment k, a))
-> OrderedMap (Max k) (Segment k, a)
forall k a. FingerTree k (Item k a) -> OrderedMap k a
OrderedMap (FingerTree (Max k) (Item (Max k) (Segment k, a))
at FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall k a.
(Ord k, Enum k, Bounded k, Eq a) =>
FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
>*< FingerTree (Max k) (Item (Max k) (Segment k, a))
forall v. FingerTree v (Item (Max k) (Segment k, a))
bbbb FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall k a.
(Ord k, Enum k, Bounded k, Eq a) =>
FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
>*< FingerTree (Max k) (Item (Max k) (Segment k, a))
cccc)
  where
    (FingerTree (Max k) (Item (Max k) (Segment k, a))
fstPivotLt, FingerTree (Max k) (Item (Max k) (Segment k, a))
fstPivotRt) = (Max k -> Bool)
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> (FingerTree (Max k) (Item (Max k) (Segment k, a)),
    FingerTree (Max k) (Item (Max k) (Segment k, a)))
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, a))
t
    (FingerTree (Max k) (Item (Max k) (Segment k, a))
at, FingerTree (Max k) (Item (Max k) (Segment k, a))
atSurplus) = k
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> (FingerTree (Max k) (Item (Max k) (Segment k, a)),
    FingerTree (Max k) (Item (Max k) (Segment k, a)))
forall k a.
(Enum k, Ord k, Bounded k, Show k) =>
k
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> (FingerTree (Max k) (Item (Max k) (Segment k, a)),
    FingerTree (Max k) (Item (Max k) (Segment k, a)))
cappedL k
lo FingerTree (Max k) (Item (Max k) (Segment k, a))
fstPivotLt
    (FingerTree (Max k) (Item (Max k) (Segment k, a))
zs, FingerTree (Max k) (Item (Max k) (Segment k, a))
remainder) = (Max k -> Bool)
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> (FingerTree (Max k) (Item (Max k) (Segment k, a)),
    FingerTree (Max k) (Item (Max k) (Segment k, a)))
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, a))
atSurplus FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall k a.
(Ord k, Enum k, Bounded k, Eq a) =>
FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
>*< FingerTree (Max k) (Item (Max k) (Segment k, a))
fstPivotRt)
    e :: FingerTree v (Item (Max k) (Segment k, a))
e = FingerTree v (Item (Max k) (Segment k, a))
-> (Item (Max k) (Segment k, a)
    -> FingerTree v (Item (Max k) (Segment k, a)))
-> Maybe (Item (Max k) (Segment k, a))
-> FingerTree v (Item (Max k) (Segment k, a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree v (Item (Max k) (Segment k, a))
forall v a. FingerTree v a
FT.Empty Item (Max k) (Segment k, a)
-> FingerTree v (Item (Max k) (Segment k, a))
forall a v. a -> FingerTree v a
FT.singleton (FingerTree (Max k) (Item (Max k) (Segment k, a))
-> Maybe (Item (Max k) (Segment k, a))
forall v a. Measured v a => FingerTree v a -> Maybe a
FT.maybeLast FingerTree (Max k) (Item (Max k) (Segment k, a))
zs Maybe (Item (Max k) (Segment k, a))
-> (Item (Max k) (Segment k, a)
    -> Maybe (Item (Max k) (Segment k, a)))
-> Maybe (Item (Max k) (Segment k, a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= k
-> Item (Max k) (Segment k, a)
-> Maybe (Item (Max k) (Segment k, a))
forall k a.
(Ord k, Enum k, Show k, Show a) =>
k
-> Item (Max k) (Segment k, a)
-> Maybe (Item (Max k) (Segment k, a))
capM k
hi)
    rt :: FingerTree (Max k) (Item (Max k) (Segment k, a))
rt = FingerTree (Max k) (Item (Max k) (Segment k, a))
forall v. FingerTree v (Item (Max k) (Segment k, a))
e FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall k a.
(Ord k, Enum k, Bounded k, Eq a) =>
FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
>*< FingerTree (Max k) (Item (Max k) (Segment k, a))
remainder
    bbbb :: FingerTree v (Item (Max k) (Segment k, a))
bbbb = Item (Max k) (Segment k, a)
-> FingerTree v (Item (Max k) (Segment k, a))
forall a v. a -> FingerTree v a
FT.singleton (Max k -> (Segment k, a) -> Item (Max k) (Segment k, a)
forall k a. k -> a -> Item k a
Item (k -> Max k
forall a. a -> Max a
Max k
lo) (Segment k
s, a
x))
    cccc :: FingerTree (Max k) (Item (Max k) (Segment k, a))
cccc = k
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
forall k a.
(Enum k, Ord k, Bounded k, Show k, Show a) =>
k
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
-> FingerTree (Max k) (Item (Max k) (Segment k, a))
cappedM k
hi FingerTree (Max k) (Item (Max k) (Segment k, a))
rt

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

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

capM :: (Ord k, Enum k, Show k, Show a)
  => k
  -> Item (Max k) (Segment k, a)
  -> Maybe (Item (Max k) (Segment k, a))
capM :: k
-> Item (Max k) (Segment k, a)
-> Maybe (Item (Max k) (Segment k, a))
capM k
lihi n :: Item (Max k) (Segment k, a)
n@(Item Max k
_ (Segment k
rilo k
rihi, a
a))
  -- let !_ = trace ("lihi: " <> show lihi) lihi in
  -- let !_ = trace ("rilo: " <> show rilo) rilo in
  -- let !_ = trace ("rihi: " <> show rihi) rihi in
  -- let result = case () of
  | k
lihi k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
rilo = Item (Max k) (Segment k, a) -> Maybe (Item (Max k) (Segment k, a))
forall a. a -> Maybe a
Just Item (Max k) (Segment k, a)
n
  | k
lihi k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
rihi = Item (Max k) (Segment k, a) -> Maybe (Item (Max k) (Segment k, a))
forall a. a -> Maybe a
Just (Item (Max k) (Segment k, a)
 -> Maybe (Item (Max k) (Segment k, a)))
-> Item (Max k) (Segment k, a)
-> Maybe (Item (Max k) (Segment k, a))
forall a b. (a -> b) -> a -> b
$ Max k -> (Segment k, a) -> Item (Max k) (Segment k, a)
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, a
a)
  | Bool
otherwise   = Maybe (Item (Max k) (Segment k, a))
forall a. Maybe a
Nothing
        -- in
  -- let !_ = trace ("result: " <> show result) result in
  -- result

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