--------------------------------------------------------------------------------
-- |
-- Module      :  Data.OrdSeq
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.OrdSeq
  ( OrdSeq
  , Compare
  , insertBy
  , insert
  , splitBy
  , splitOn
  , splitMonotonic
  , deleteAll
  , deleteAllBy
  , fromListBy
  , fromListByOrd
  , fromAscList
  , lookupBy
  , memberBy
  , mapMonotonic
  , viewl
  , viewr
  , minView
  , lookupMin
  , maxView
  , lookupMax
  ) where


import           Control.Lens    (bimap)
import           Data.FingerTree hiding (null, viewl, viewr)
import qualified Data.FingerTree as FT
import qualified Data.Foldable   as F
import           Data.Maybe      (fromJust, isJust, listToMaybe)
import           Test.QuickCheck (Arbitrary (arbitrary))

--------------------------------------------------------------------------------

data Key a = NoKey | Key { Key a -> a
getKey :: !a } deriving (Int -> Key a -> ShowS
[Key a] -> ShowS
Key a -> String
(Int -> Key a -> ShowS)
-> (Key a -> String) -> ([Key a] -> ShowS) -> Show (Key a)
forall a. Show a => Int -> Key a -> ShowS
forall a. Show a => [Key a] -> ShowS
forall a. Show a => Key a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key a] -> ShowS
$cshowList :: forall a. Show a => [Key a] -> ShowS
show :: Key a -> String
$cshow :: forall a. Show a => Key a -> String
showsPrec :: Int -> Key a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Key a -> ShowS
Show,Key a -> Key a -> Bool
(Key a -> Key a -> Bool) -> (Key a -> Key a -> Bool) -> Eq (Key a)
forall a. Eq a => Key a -> Key a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key a -> Key a -> Bool
$c/= :: forall a. Eq a => Key a -> Key a -> Bool
== :: Key a -> Key a -> Bool
$c== :: forall a. Eq a => Key a -> Key a -> Bool
Eq,Eq (Key a)
Eq (Key a)
-> (Key a -> Key a -> Ordering)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Key a)
-> (Key a -> Key a -> Key a)
-> Ord (Key a)
Key a -> Key a -> Bool
Key a -> Key a -> Ordering
Key a -> Key a -> Key a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Key a)
forall a. Ord a => Key a -> Key a -> Bool
forall a. Ord a => Key a -> Key a -> Ordering
forall a. Ord a => Key a -> Key a -> Key a
min :: Key a -> Key a -> Key a
$cmin :: forall a. Ord a => Key a -> Key a -> Key a
max :: Key a -> Key a -> Key a
$cmax :: forall a. Ord a => Key a -> Key a -> Key a
>= :: Key a -> Key a -> Bool
$c>= :: forall a. Ord a => Key a -> Key a -> Bool
> :: Key a -> Key a -> Bool
$c> :: forall a. Ord a => Key a -> Key a -> Bool
<= :: Key a -> Key a -> Bool
$c<= :: forall a. Ord a => Key a -> Key a -> Bool
< :: Key a -> Key a -> Bool
$c< :: forall a. Ord a => Key a -> Key a -> Bool
compare :: Key a -> Key a -> Ordering
$ccompare :: forall a. Ord a => Key a -> Key a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Key a)
Ord)

instance Semigroup (Key a) where
  Key a
k <> :: Key a -> Key a -> Key a
<> Key a
NoKey = Key a
k
  Key a
_ <> Key a
k     = Key a
k

instance Monoid (Key a) where
  mempty :: Key a
mempty = Key a
forall a. Key a
NoKey
  Key a
k mappend :: Key a -> Key a -> Key a
`mappend` Key a
k' = Key a
k Key a -> Key a -> Key a
forall a. Semigroup a => a -> a -> a
<> Key a
k'

liftCmp                     :: (a -> a -> Ordering) -> Key a -> Key a -> Ordering
liftCmp :: (a -> a -> Ordering) -> Key a -> Key a -> Ordering
liftCmp a -> a -> Ordering
_   Key a
NoKey   Key a
NoKey   = Ordering
EQ
liftCmp a -> a -> Ordering
_   Key a
NoKey   (Key a
_) = Ordering
LT
liftCmp a -> a -> Ordering
_   (Key a
_) Key a
NoKey   = Ordering
GT
liftCmp a -> a -> Ordering
cmp (Key a
x) (Key a
y) = a
x a -> a -> Ordering
`cmp` a
y



newtype Elem a = Elem a deriving (Elem a -> Elem a -> Bool
(Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool) -> Eq (Elem a)
forall a. Eq a => Elem a -> Elem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elem a -> Elem a -> Bool
$c/= :: forall a. Eq a => Elem a -> Elem a -> Bool
== :: Elem a -> Elem a -> Bool
$c== :: forall a. Eq a => Elem a -> Elem a -> Bool
Eq,Eq (Elem a)
Eq (Elem a)
-> (Elem a -> Elem a -> Ordering)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Elem a)
-> (Elem a -> Elem a -> Elem a)
-> Ord (Elem a)
Elem a -> Elem a -> Bool
Elem a -> Elem a -> Ordering
Elem a -> Elem a -> Elem a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Elem a)
forall a. Ord a => Elem a -> Elem a -> Bool
forall a. Ord a => Elem a -> Elem a -> Ordering
forall a. Ord a => Elem a -> Elem a -> Elem a
min :: Elem a -> Elem a -> Elem a
$cmin :: forall a. Ord a => Elem a -> Elem a -> Elem a
max :: Elem a -> Elem a -> Elem a
$cmax :: forall a. Ord a => Elem a -> Elem a -> Elem a
>= :: Elem a -> Elem a -> Bool
$c>= :: forall a. Ord a => Elem a -> Elem a -> Bool
> :: Elem a -> Elem a -> Bool
$c> :: forall a. Ord a => Elem a -> Elem a -> Bool
<= :: Elem a -> Elem a -> Bool
$c<= :: forall a. Ord a => Elem a -> Elem a -> Bool
< :: Elem a -> Elem a -> Bool
$c< :: forall a. Ord a => Elem a -> Elem a -> Bool
compare :: Elem a -> Elem a -> Ordering
$ccompare :: forall a. Ord a => Elem a -> Elem a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Elem a)
Ord,Functor Elem
Foldable Elem
Functor Elem
-> Foldable Elem
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Elem a -> f (Elem b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Elem (f a) -> f (Elem a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Elem a -> m (Elem b))
-> (forall (m :: * -> *) a. Monad m => Elem (m a) -> m (Elem a))
-> Traversable Elem
(a -> f b) -> Elem a -> f (Elem b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Elem (m a) -> m (Elem a)
forall (f :: * -> *) a. Applicative f => Elem (f a) -> f (Elem a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elem a -> m (Elem b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem a -> f (Elem b)
sequence :: Elem (m a) -> m (Elem a)
$csequence :: forall (m :: * -> *) a. Monad m => Elem (m a) -> m (Elem a)
mapM :: (a -> m b) -> Elem a -> m (Elem b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elem a -> m (Elem b)
sequenceA :: Elem (f a) -> f (Elem a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Elem (f a) -> f (Elem a)
traverse :: (a -> f b) -> Elem a -> f (Elem b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem a -> f (Elem b)
$cp2Traversable :: Foldable Elem
$cp1Traversable :: Functor Elem
Traversable,Elem a -> Bool
(a -> m) -> Elem a -> m
(a -> b -> b) -> b -> Elem a -> b
(forall m. Monoid m => Elem m -> m)
-> (forall m a. Monoid m => (a -> m) -> Elem a -> m)
-> (forall m a. Monoid m => (a -> m) -> Elem a -> m)
-> (forall a b. (a -> b -> b) -> b -> Elem a -> b)
-> (forall a b. (a -> b -> b) -> b -> Elem a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elem a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elem a -> b)
-> (forall a. (a -> a -> a) -> Elem a -> a)
-> (forall a. (a -> a -> a) -> Elem a -> a)
-> (forall a. Elem a -> [a])
-> (forall a. Elem a -> Bool)
-> (forall a. Elem a -> Int)
-> (forall a. Eq a => a -> Elem a -> Bool)
-> (forall a. Ord a => Elem a -> a)
-> (forall a. Ord a => Elem a -> a)
-> (forall a. Num a => Elem a -> a)
-> (forall a. Num a => Elem a -> a)
-> Foldable Elem
forall a. Eq a => a -> Elem a -> Bool
forall a. Num a => Elem a -> a
forall a. Ord a => Elem a -> a
forall m. Monoid m => Elem m -> m
forall a. Elem a -> Bool
forall a. Elem a -> Int
forall a. Elem a -> [a]
forall a. (a -> a -> a) -> Elem a -> a
forall m a. Monoid m => (a -> m) -> Elem a -> m
forall b a. (b -> a -> b) -> b -> Elem a -> b
forall a b. (a -> b -> b) -> b -> Elem a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Elem a -> a
$cproduct :: forall a. Num a => Elem a -> a
sum :: Elem a -> a
$csum :: forall a. Num a => Elem a -> a
minimum :: Elem a -> a
$cminimum :: forall a. Ord a => Elem a -> a
maximum :: Elem a -> a
$cmaximum :: forall a. Ord a => Elem a -> a
elem :: a -> Elem a -> Bool
$celem :: forall a. Eq a => a -> Elem a -> Bool
length :: Elem a -> Int
$clength :: forall a. Elem a -> Int
null :: Elem a -> Bool
$cnull :: forall a. Elem a -> Bool
toList :: Elem a -> [a]
$ctoList :: forall a. Elem a -> [a]
foldl1 :: (a -> a -> a) -> Elem a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Elem a -> a
foldr1 :: (a -> a -> a) -> Elem a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Elem a -> a
foldl' :: (b -> a -> b) -> b -> Elem a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl :: (b -> a -> b) -> b -> Elem a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldr' :: (a -> b -> b) -> b -> Elem a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Elem a -> b
foldr :: (a -> b -> b) -> b -> Elem a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Elem a -> b
foldMap' :: (a -> m) -> Elem a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Elem a -> m
foldMap :: (a -> m) -> Elem a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Elem a -> m
fold :: Elem m -> m
$cfold :: forall m. Monoid m => Elem m -> m
Foldable,a -> Elem b -> Elem a
(a -> b) -> Elem a -> Elem b
(forall a b. (a -> b) -> Elem a -> Elem b)
-> (forall a b. a -> Elem b -> Elem a) -> Functor Elem
forall a b. a -> Elem b -> Elem a
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Elem b -> Elem a
$c<$ :: forall a b. a -> Elem b -> Elem a
fmap :: (a -> b) -> Elem a -> Elem b
$cfmap :: forall a b. (a -> b) -> Elem a -> Elem b
Functor)

instance Show a => Show (Elem a) where
  show :: Elem a -> String
show (Elem a
x) = String
"Elem " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x

-- | Sequence of ordered elements.
newtype OrdSeq a = OrdSeq { OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree :: FingerTree (Key a) (Elem a) }
                   deriving (OrdSeq a -> OrdSeq a -> Bool
(OrdSeq a -> OrdSeq a -> Bool)
-> (OrdSeq a -> OrdSeq a -> Bool) -> Eq (OrdSeq a)
forall a. Eq a => OrdSeq a -> OrdSeq a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrdSeq a -> OrdSeq a -> Bool
$c/= :: forall a. Eq a => OrdSeq a -> OrdSeq a -> Bool
== :: OrdSeq a -> OrdSeq a -> Bool
$c== :: forall a. Eq a => OrdSeq a -> OrdSeq a -> Bool
Eq)

instance Show a => Show (OrdSeq a) where
  show :: OrdSeq a -> String
show OrdSeq a
s = String
"fromAscList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (OrdSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList OrdSeq a
s)

instance Semigroup (OrdSeq a) where
  (OrdSeq FingerTree (Key a) (Elem a)
s) <> :: OrdSeq a -> OrdSeq a -> OrdSeq a
<> (OrdSeq FingerTree (Key a) (Elem a)
t) = FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq (FingerTree (Key a) (Elem a) -> OrdSeq a)
-> FingerTree (Key a) (Elem a) -> OrdSeq a
forall a b. (a -> b) -> a -> b
$ FingerTree (Key a) (Elem a)
s FingerTree (Key a) (Elem a)
-> FingerTree (Key a) (Elem a) -> FingerTree (Key a) (Elem a)
forall a. Monoid a => a -> a -> a
`mappend` FingerTree (Key a) (Elem a)
t

instance Monoid (OrdSeq a) where
  mempty :: OrdSeq a
mempty = FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
forall a. Monoid a => a
mempty
  mappend :: OrdSeq a -> OrdSeq a -> OrdSeq a
mappend = OrdSeq a -> OrdSeq a -> OrdSeq a
forall a. Semigroup a => a -> a -> a
(<>)

instance Foldable OrdSeq where
  foldMap :: (a -> m) -> OrdSeq a -> m
foldMap a -> m
f = (Elem a -> m) -> FingerTree (Key a) (Elem a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Elem a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) (FingerTree (Key a) (Elem a) -> m)
-> (OrdSeq a -> FingerTree (Key a) (Elem a)) -> OrdSeq a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree
  null :: OrdSeq a -> Bool
null      = FingerTree (Key a) (Elem a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FingerTree (Key a) (Elem a) -> Bool)
-> (OrdSeq a -> FingerTree (Key a) (Elem a)) -> OrdSeq a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree
  length :: OrdSeq a -> Int
length    = FingerTree (Key a) (Elem a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FingerTree (Key a) (Elem a) -> Int)
-> (OrdSeq a -> FingerTree (Key a) (Elem a)) -> OrdSeq a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree
  minimum :: OrdSeq a -> a
minimum   = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (OrdSeq a -> Maybe a) -> OrdSeq a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> Maybe a
forall a. OrdSeq a -> Maybe a
lookupMin
  maximum :: OrdSeq a -> a
maximum   = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (OrdSeq a -> Maybe a) -> OrdSeq a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> Maybe a
forall a. OrdSeq a -> Maybe a
lookupMax

instance (Arbitrary a, Ord a) => Arbitrary (OrdSeq a) where
  arbitrary :: Gen (OrdSeq a)
arbitrary = [a] -> OrdSeq a
forall a. Ord a => [a] -> OrdSeq a
fromListByOrd ([a] -> OrdSeq a) -> Gen [a] -> Gen (OrdSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
forall a. Arbitrary a => Gen a
arbitrary

instance Measured (Key a) (Elem a) where
  measure :: Elem a -> Key a
measure (Elem a
x) = a -> Key a
forall a. a -> Key a
Key a
x

-- | Signature for functions that give the ordering of two values.
type Compare a = a -> a -> Ordering

-- | Insert into a monotone OrdSeq.
--
-- pre: the comparator maintains monotonicity
--
-- \(O(\log n)\)
insertBy                  :: Compare a -> a -> OrdSeq a -> OrdSeq a
insertBy :: Compare a -> a -> OrdSeq a -> OrdSeq a
insertBy Compare a
cmp a
x (OrdSeq FingerTree (Key a) (Elem a)
s) = FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq (FingerTree (Key a) (Elem a) -> OrdSeq a)
-> FingerTree (Key a) (Elem a) -> OrdSeq a
forall a b. (a -> b) -> a -> b
$ FingerTree (Key a) (Elem a)
l FingerTree (Key a) (Elem a)
-> FingerTree (Key a) (Elem a) -> FingerTree (Key a) (Elem a)
forall a. Monoid a => a -> a -> a
`mappend` (a -> Elem a
forall a. a -> Elem a
Elem a
x Elem a
-> FingerTree (Key a) (Elem a) -> FingerTree (Key a) (Elem a)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (Key a) (Elem a)
r)
  where
    (FingerTree (Key a) (Elem a)
l,FingerTree (Key a) (Elem a)
r) = (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (\Key a
v -> Compare a -> Key a -> Key a -> Ordering
forall a. (a -> a -> Ordering) -> Key a -> Key a -> Ordering
liftCmp Compare a
cmp Key a
v (a -> Key a
forall a. a -> Key a
Key a
x) Ordering -> [Ordering] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ordering
EQ, Ordering
GT]) FingerTree (Key a) (Elem a)
s

-- | Insert into a sorted OrdSeq
--
-- \(O(\log n)\)
insert :: Ord a => a -> OrdSeq a -> OrdSeq a
insert :: a -> OrdSeq a -> OrdSeq a
insert = Compare a -> a -> OrdSeq a -> OrdSeq a
forall a. Compare a -> a -> OrdSeq a -> OrdSeq a
insertBy Compare a
forall a. Ord a => a -> a -> Ordering
compare

-- | \( O(\log n) \). Delete all elements that compare as equal to @x@.
deleteAllBy         :: Compare a -> a -> OrdSeq a -> OrdSeq a
deleteAllBy :: Compare a -> a -> OrdSeq a -> OrdSeq a
deleteAllBy Compare a
cmp a
x OrdSeq a
s = OrdSeq a
l OrdSeq a -> OrdSeq a -> OrdSeq a
forall a. Semigroup a => a -> a -> a
<> OrdSeq a
r
  where
    (OrdSeq a
l,OrdSeq a
_,OrdSeq a
r) = Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
forall a.
Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitBy Compare a
cmp a
x OrdSeq a
s

    -- (l,m) = split (\v -> liftCmp cmp v (Key x) `elem` [EQ,GT]) s
    -- (_,r) = split (\v -> liftCmp cmp v (Key x) == GT) m


-- | \(O(\log n)\)
splitBy                  :: Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitBy :: Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitBy Compare a
cmp a
x (OrdSeq FingerTree (Key a) (Elem a)
s) = (FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
l, FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
m', FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
r)
  where
    (FingerTree (Key a) (Elem a)
l, FingerTree (Key a) (Elem a)
m) = (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (\Key a
v -> Compare a -> Key a -> Key a -> Ordering
forall a. (a -> a -> Ordering) -> Key a -> Key a -> Ordering
liftCmp Compare a
cmp Key a
v (a -> Key a
forall a. a -> Key a
Key a
x) Ordering -> [Ordering] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ordering
EQ,Ordering
GT]) FingerTree (Key a) (Elem a)
s
    (FingerTree (Key a) (Elem a)
m',FingerTree (Key a) (Elem a)
r) = (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (\Key a
v -> Compare a -> Key a -> Key a -> Ordering
forall a. (a -> a -> Ordering) -> Key a -> Key a -> Ordering
liftCmp Compare a
cmp Key a
v (a -> Key a
forall a. a -> Key a
Key a
x) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) FingerTree (Key a) (Elem a)
m


{- HLINT ignore splitOn -}
-- | Given a monotonic function f that maps a to b, split the sequence s
-- depending on the b values. I.e. the result (l,m,r) is such that
--
-- * @all (< x) . fmap f $ l@
-- * @all (== x) . fmap f $ m@
-- * @all (> x) . fmap f $ r@
--
-- >>> splitOn id 3 $ fromAscList [1..5]
-- (fromAscList [1,2],fromAscList [3],fromAscList [4,5])
-- >>> splitOn fst 2 $ fromAscList [(0,"-"),(1,"A"),(2,"B"),(2,"C"),(3,"D"),(4,"E")]
-- (fromAscList [(0,"-"),(1,"A")],fromAscList [(2,"B"),(2,"C")],fromAscList [(3,"D"),(4,"E")])
splitOn :: Ord b => (a -> b) -> b -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitOn :: (a -> b) -> b -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitOn a -> b
f b
x (OrdSeq FingerTree (Key a) (Elem a)
s) = (FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
l, FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
m', FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
r)
  where
    (FingerTree (Key a) (Elem a)
l, FingerTree (Key a) (Elem a)
m) = (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (\(Key a
v) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> b
f a
v) b
x Ordering -> [Ordering] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ordering
EQ,Ordering
GT]) FingerTree (Key a) (Elem a)
s
    (FingerTree (Key a) (Elem a)
m',FingerTree (Key a) (Elem a)
r) = (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (\(Key a
v) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> b
f a
v) b
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==     Ordering
GT)      FingerTree (Key a) (Elem a)
m

-- | Given a monotonic predicate p, splits the sequence s into two sequences
--  (as,bs) such that all (not p) as and all p bs
--
-- \(O(\log n)\)
splitMonotonic  :: (a -> Bool) -> OrdSeq a -> (OrdSeq a, OrdSeq a)
splitMonotonic :: (a -> Bool) -> OrdSeq a -> (OrdSeq a, OrdSeq a)
splitMonotonic a -> Bool
p = (FingerTree (Key a) (Elem a) -> OrdSeq a)
-> (FingerTree (Key a) (Elem a) -> OrdSeq a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
-> (OrdSeq a, OrdSeq a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq ((FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
 -> (OrdSeq a, OrdSeq a))
-> (OrdSeq a
    -> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a)))
-> OrdSeq a
-> (OrdSeq a, OrdSeq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key a -> Bool)
-> FingerTree (Key a) (Elem a)
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split (a -> Bool
p (a -> Bool) -> (Key a -> a) -> Key a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> a
forall a. Key a -> a
getKey) (FingerTree (Key a) (Elem a)
 -> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a)))
-> (OrdSeq a -> FingerTree (Key a) (Elem a))
-> OrdSeq a
-> (FingerTree (Key a) (Elem a), FingerTree (Key a) (Elem a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree


-- | Deletes all elements from the OrdDeq
--
-- \(O(n\log n)\)
deleteAll :: Ord a => a -> OrdSeq a -> OrdSeq a
deleteAll :: a -> OrdSeq a -> OrdSeq a
deleteAll = Compare a -> a -> OrdSeq a -> OrdSeq a
forall a. Compare a -> a -> OrdSeq a -> OrdSeq a
deleteAllBy Compare a
forall a. Ord a => a -> a -> Ordering
compare


-- | inserts all eleements in order
-- \(O(n\log n)\)
fromListBy     :: Compare a -> [a] -> OrdSeq a
fromListBy :: Compare a -> [a] -> OrdSeq a
fromListBy Compare a
cmp = (a -> OrdSeq a -> OrdSeq a) -> OrdSeq a -> [a] -> OrdSeq a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Compare a -> a -> OrdSeq a -> OrdSeq a
forall a. Compare a -> a -> OrdSeq a -> OrdSeq a
insertBy Compare a
cmp) OrdSeq a
forall a. Monoid a => a
mempty

-- | inserts all eleements in order
-- \(O(n\log n)\)
fromListByOrd :: Ord a => [a] -> OrdSeq a
fromListByOrd :: [a] -> OrdSeq a
fromListByOrd = Compare a -> [a] -> OrdSeq a
forall a. Compare a -> [a] -> OrdSeq a
fromListBy Compare a
forall a. Ord a => a -> a -> Ordering
compare

-- | \( O(n) \)
fromAscList :: [a] -> OrdSeq a
fromAscList :: [a] -> OrdSeq a
fromAscList = FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq (FingerTree (Key a) (Elem a) -> OrdSeq a)
-> ([a] -> FingerTree (Key a) (Elem a)) -> [a] -> OrdSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Elem a] -> FingerTree (Key a) (Elem a)
forall v a. Measured v a => [a] -> FingerTree v a
fromList ([Elem a] -> FingerTree (Key a) (Elem a))
-> ([a] -> [Elem a]) -> [a] -> FingerTree (Key a) (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Elem a) -> [a] -> [Elem a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Elem a
forall a. a -> Elem a
Elem


-- | \(O(\log n)\)
lookupBy         :: Compare a -> a -> OrdSeq a -> Maybe a
lookupBy :: Compare a -> a -> OrdSeq a -> Maybe a
lookupBy Compare a
cmp a
x OrdSeq a
s = let (OrdSeq a
_,OrdSeq a
m,OrdSeq a
_) = Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
forall a.
Compare a -> a -> OrdSeq a -> (OrdSeq a, OrdSeq a, OrdSeq a)
splitBy Compare a
cmp a
x OrdSeq a
s in [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (OrdSeq a -> [a]) -> OrdSeq a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OrdSeq a -> Maybe a) -> OrdSeq a -> Maybe a
forall a b. (a -> b) -> a -> b
$ OrdSeq a
m

-- | \(O(\log n)\). Queries for the existance of any elements that compare as equal to @x@.
memberBy        :: Compare a -> a -> OrdSeq a -> Bool
memberBy :: Compare a -> a -> OrdSeq a -> Bool
memberBy Compare a
cmp a
x = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (OrdSeq a -> Maybe a) -> OrdSeq a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare a -> a -> OrdSeq a -> Maybe a
forall a. Compare a -> a -> OrdSeq a -> Maybe a
lookupBy Compare a
cmp a
x


-- | \( O(n) \) Fmap, assumes the order does not change
mapMonotonic   :: (a -> b) -> OrdSeq a -> OrdSeq b
mapMonotonic :: (a -> b) -> OrdSeq a -> OrdSeq b
mapMonotonic a -> b
f = [b] -> OrdSeq b
forall a. [a] -> OrdSeq a
fromAscList ([b] -> OrdSeq b) -> (OrdSeq a -> [b]) -> OrdSeq a -> OrdSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> [b]) -> (OrdSeq a -> [a]) -> OrdSeq a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList


-- | \(O(1)\) Gets the first element from the sequence
viewl :: OrdSeq a -> ViewL OrdSeq a
viewl :: OrdSeq a -> ViewL OrdSeq a
viewl = ViewL (FingerTree (Key a)) (Elem a) -> ViewL OrdSeq a
forall a. ViewL (FingerTree (Key a)) (Elem a) -> ViewL OrdSeq a
f (ViewL (FingerTree (Key a)) (Elem a) -> ViewL OrdSeq a)
-> (OrdSeq a -> ViewL (FingerTree (Key a)) (Elem a))
-> OrdSeq a
-> ViewL OrdSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Key a) (Elem a) -> ViewL (FingerTree (Key a)) (Elem a)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl (FingerTree (Key a) (Elem a)
 -> ViewL (FingerTree (Key a)) (Elem a))
-> (OrdSeq a -> FingerTree (Key a) (Elem a))
-> OrdSeq a
-> ViewL (FingerTree (Key a)) (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree
  where
    f :: ViewL (FingerTree (Key a)) (Elem a) -> ViewL OrdSeq a
f ViewL (FingerTree (Key a)) (Elem a)
EmptyL        = ViewL OrdSeq a
forall (s :: * -> *) a. ViewL s a
EmptyL
    f (Elem a
x :< FingerTree (Key a) (Elem a)
s) = a
x a -> OrdSeq a -> ViewL OrdSeq a
forall (s :: * -> *) a. a -> s a -> ViewL s a
:< FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
s

-- | \(O(1)\) Gets the last element from the sequence
viewr :: OrdSeq a -> ViewR OrdSeq a
viewr :: OrdSeq a -> ViewR OrdSeq a
viewr = ViewR (FingerTree (Key a)) (Elem a) -> ViewR OrdSeq a
forall a. ViewR (FingerTree (Key a)) (Elem a) -> ViewR OrdSeq a
f (ViewR (FingerTree (Key a)) (Elem a) -> ViewR OrdSeq a)
-> (OrdSeq a -> ViewR (FingerTree (Key a)) (Elem a))
-> OrdSeq a
-> ViewR OrdSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Key a) (Elem a) -> ViewR (FingerTree (Key a)) (Elem a)
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr (FingerTree (Key a) (Elem a)
 -> ViewR (FingerTree (Key a)) (Elem a))
-> (OrdSeq a -> FingerTree (Key a) (Elem a))
-> OrdSeq a
-> ViewR (FingerTree (Key a)) (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> FingerTree (Key a) (Elem a)
forall a. OrdSeq a -> FingerTree (Key a) (Elem a)
_asFingerTree
  where
    f :: ViewR (FingerTree (Key a)) (Elem a) -> ViewR OrdSeq a
f ViewR (FingerTree (Key a)) (Elem a)
EmptyR        = ViewR OrdSeq a
forall (s :: * -> *) a. ViewR s a
EmptyR
    f (FingerTree (Key a) (Elem a)
s :> Elem a
x) = FingerTree (Key a) (Elem a) -> OrdSeq a
forall a. FingerTree (Key a) (Elem a) -> OrdSeq a
OrdSeq FingerTree (Key a) (Elem a)
s OrdSeq a -> a -> ViewR OrdSeq a
forall (s :: * -> *) a. s a -> a -> ViewR s a
:> a
x


-- | \(O(1)\)
minView   :: OrdSeq a -> Maybe (a, OrdSeq a)
minView :: OrdSeq a -> Maybe (a, OrdSeq a)
minView OrdSeq a
s = case OrdSeq a -> ViewL OrdSeq a
forall a. OrdSeq a -> ViewL OrdSeq a
viewl OrdSeq a
s of
              ViewL OrdSeq a
EmptyL   -> Maybe (a, OrdSeq a)
forall a. Maybe a
Nothing
              (a
x :< OrdSeq a
t) -> (a, OrdSeq a) -> Maybe (a, OrdSeq a)
forall a. a -> Maybe a
Just (a
x,OrdSeq a
t)

-- | \(O(1)\)
lookupMin :: OrdSeq a -> Maybe a
lookupMin :: OrdSeq a -> Maybe a
lookupMin = ((a, OrdSeq a) -> a) -> Maybe (a, OrdSeq a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, OrdSeq a) -> a
forall a b. (a, b) -> a
fst (Maybe (a, OrdSeq a) -> Maybe a)
-> (OrdSeq a -> Maybe (a, OrdSeq a)) -> OrdSeq a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> Maybe (a, OrdSeq a)
forall a. OrdSeq a -> Maybe (a, OrdSeq a)
minView

-- | \(O(1)\)
maxView   :: OrdSeq a -> Maybe (a, OrdSeq a)
maxView :: OrdSeq a -> Maybe (a, OrdSeq a)
maxView OrdSeq a
s = case OrdSeq a -> ViewR OrdSeq a
forall a. OrdSeq a -> ViewR OrdSeq a
viewr OrdSeq a
s of
              ViewR OrdSeq a
EmptyR   -> Maybe (a, OrdSeq a)
forall a. Maybe a
Nothing
              (OrdSeq a
t :> a
x) -> (a, OrdSeq a) -> Maybe (a, OrdSeq a)
forall a. a -> Maybe a
Just (a
x,OrdSeq a
t)

-- | \(O(1)\)
lookupMax :: OrdSeq a -> Maybe a
lookupMax :: OrdSeq a -> Maybe a
lookupMax = ((a, OrdSeq a) -> a) -> Maybe (a, OrdSeq a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, OrdSeq a) -> a
forall a b. (a, b) -> a
fst (Maybe (a, OrdSeq a) -> Maybe a)
-> (OrdSeq a -> Maybe (a, OrdSeq a)) -> OrdSeq a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdSeq a -> Maybe (a, OrdSeq a)
forall a. OrdSeq a -> Maybe (a, OrdSeq a)
maxView