{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK not-home     #-}
module Database.LSMTree.Internal.Map.Range (
    Bound (.., BoundExclusive, BoundInclusive)
  , Clusive (..)
  , rangeLookup
  ) where

import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Map.Internal (Map (..))

data Clusive = Exclusive | Inclusive deriving stock Int -> Clusive -> ShowS
[Clusive] -> ShowS
Clusive -> String
(Int -> Clusive -> ShowS)
-> (Clusive -> String) -> ([Clusive] -> ShowS) -> Show Clusive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clusive -> ShowS
showsPrec :: Int -> Clusive -> ShowS
$cshow :: Clusive -> String
show :: Clusive -> String
$cshowList :: [Clusive] -> ShowS
showList :: [Clusive] -> ShowS
Show
data Bound k = NoBound | Bound !k !Clusive deriving stock Int -> Bound k -> ShowS
[Bound k] -> ShowS
Bound k -> String
(Int -> Bound k -> ShowS)
-> (Bound k -> String) -> ([Bound k] -> ShowS) -> Show (Bound k)
forall k. Show k => Int -> Bound k -> ShowS
forall k. Show k => [Bound k] -> ShowS
forall k. Show k => Bound k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> Bound k -> ShowS
showsPrec :: Int -> Bound k -> ShowS
$cshow :: forall k. Show k => Bound k -> String
show :: Bound k -> String
$cshowList :: forall k. Show k => [Bound k] -> ShowS
showList :: [Bound k] -> ShowS
Show

{-# COMPLETE BoundExclusive, BoundInclusive #-}

pattern BoundExclusive :: k -> Bound k
pattern $mBoundExclusive :: forall {r} {k}. Bound k -> (k -> r) -> ((# #) -> r) -> r
$bBoundExclusive :: forall k. k -> Bound k
BoundExclusive k = Bound k Exclusive

pattern BoundInclusive :: k -> Bound k
pattern $mBoundInclusive :: forall {r} {k}. Bound k -> (k -> r) -> ((# #) -> r) -> r
$bBoundInclusive :: forall k. k -> Bound k
BoundInclusive k = Bound k Inclusive

-- | Find all the keys in the given range and return the corresponding
-- (key, value) pairs (in ascending order).
--
rangeLookup ::
       forall k v. Ord k
    => Bound k    -- ^ lower bound
    -> Bound k    -- ^ upper bound
    -> Map k v
    -> [(k, v)]
rangeLookup :: forall k v. Ord k => Bound k -> Bound k -> Map k v -> [(k, v)]
rangeLookup Bound k
NoBound       Bound k
NoBound        Map k v
m = Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m
rangeLookup (Bound k
lb Clusive
lc) Bound k
NoBound        Map k v
m = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo k
lb Clusive
lc Map k v
m []
rangeLookup Bound k
NoBound       (Bound k
ub Clusive
uc)  Map k v
m = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi k
ub Clusive
uc Map k v
m []
rangeLookup (Bound k
lb Clusive
lc) (Bound k
ub Clusive
uc)  Map k v
m = k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupBoth k
lb Clusive
lc k
ub Clusive
uc Map k v
m []

toDList :: Map k v -> [(k, v)] -> [(k, v)]
toDList :: forall k v. Map k v -> [(k, v)] -> [(k, v)]
toDList Map k v
Tip             = [(k, v)] -> [(k, v)]
forall a. a -> a
id
toDList (Bin Int
_ k
k v
v Map k v
l Map k v
r) = Map k v -> [(k, v)] -> [(k, v)]
forall k v. Map k v -> [(k, v)] -> [(k, v)]
toDList Map k v
l ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k
k,v
v):) ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)] -> [(k, v)]
forall k v. Map k v -> [(k, v)] -> [(k, v)]
toDList Map k v
r

rangeLookupLo :: Ord k => k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo :: forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo !k
_  !Clusive
_  Map k v
Tip = [(k, v)] -> [(k, v)]
forall a. a -> a
id
rangeLookupLo  k
lb  Clusive
lc (Bin Int
_ k
k v
v Map k v
l Map k v
r)
    -- ... | --- k -----
    | k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalLowerBound k
lb Clusive
lc k
k
    = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo k
lb Clusive
lc Map k v
l ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k
k, v
v) :) ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)] -> [(k, v)]
forall k v. Map k v -> [(k, v)] -> [(k, v)]
toDList Map k v
r

    -- ... k ... |--------
    | Bool
otherwise
    = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo k
lb Clusive
lc Map k v
r

rangeLookupHi :: Ord k => k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi :: forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi !k
_  !Clusive
_  Map k v
Tip = [(k, v)] -> [(k, v)]
forall a. a -> a
id
rangeLookupHi  k
ub  Clusive
uc (Bin Int
_ k
k v
v Map k v
l Map k v
r)
    -- --- k --- | ...
    | k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalUpperBound k
ub Clusive
uc k
k
    = Map k v -> [(k, v)] -> [(k, v)]
forall k v. Map k v -> [(k, v)] -> [(k, v)]
toDList Map k v
l ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k
k, v
v) :) ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi k
ub Clusive
uc Map k v
r

    -- --------- | ... k ...
    | Bool
otherwise
    = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi k
ub Clusive
uc Map k v
l

rangeLookupBoth :: Ord k => k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupBoth :: forall k v.
Ord k =>
k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupBoth !k
_  !Clusive
_  !k
_  !Clusive
_  Map k v
Tip = [(k, v)] -> [(k, v)]
forall a. a -> a
id
rangeLookupBoth  k
lb  Clusive
lc  k
ub  Clusive
uc (Bin Int
_ k
k v
v Map k v
l Map k v
r)
    -- ... |--- k ---| ...
    | k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalLowerBound k
lb Clusive
lc k
k
    , k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalUpperBound k
ub Clusive
uc k
k
    = k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupLo k
lb Clusive
lc Map k v
l ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k
k,v
v):) ([(k, v)] -> [(k, v)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupHi k
ub Clusive
uc Map k v
r

    -- ... |-------| ... k ...
    | k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalLowerBound k
lb Clusive
lc k
k
    = k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupBoth k
lb Clusive
lc k
ub Clusive
uc Map k v
l

    -- ... k ... |-------| ...
    | k -> Clusive -> k -> Bool
forall k. Ord k => k -> Clusive -> k -> Bool
evalUpperBound k
ub Clusive
uc k
k
    = k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
forall k v.
Ord k =>
k -> Clusive -> k -> Clusive -> Map k v -> [(k, v)] -> [(k, v)]
rangeLookupBoth k
lb Clusive
lc k
ub Clusive
uc Map k v
r

    | Bool
otherwise
    = [(k, v)] -> [(k, v)]
forall a. a -> a
id

evalLowerBound :: Ord k => k -> Clusive -> k -> Bool
evalLowerBound :: forall k. Ord k => k -> Clusive -> k -> Bool
evalLowerBound k
b Clusive
Exclusive k
k = k
b k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k
evalLowerBound k
b Clusive
Inclusive k
k = k
b k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k

evalUpperBound :: Ord k => k -> Clusive -> k -> Bool
evalUpperBound :: forall k. Ord k => k -> Clusive -> k -> Bool
evalUpperBound k
b Clusive
Exclusive k
k = k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
b
evalUpperBound k
b Clusive
Inclusive k
k = k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
b