{-# LANGUAGE BangPatterns, Safe #-}
module Data.RangeSet.Internal.SmartConstructors (
    single,
    fork, forkH,
    balance, balanceL, balanceR,
    uncheckedBalanceL, uncheckedBalanceR
  ) where

import Prelude
import Data.RangeSet.Internal.Types

-- Basic tree constructors
{-# INLINE single #-}
single :: E -> E -> RangeSet a
single :: forall a. E -> E -> RangeSet a
single !E
l !E
u = forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork H
1 E
l E
u forall a. RangeSet a
Tip forall a. RangeSet a
Tip

{-# INLINE heightOfFork #-}
heightOfFork :: H -> H -> H
heightOfFork :: H -> H -> H
heightOfFork H
lh H
rh = forall a. Ord a => a -> a -> a
max H
lh H
rh forall a. Num a => a -> a -> a
+ H
1

{-# INLINE fork #-}
fork :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork !E
l !E
u !RangeSet a
lt !RangeSet a
rt = forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH E
l E
u (forall a. RangeSet a -> H
height RangeSet a
lt) RangeSet a
lt (forall a. RangeSet a -> H
height RangeSet a
rt) RangeSet a
rt

{-# INLINE forkH #-}
forkH :: E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH :: forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH !E
l !E
u !H
lh !RangeSet a
lt !H
rh !RangeSet a
rt =  forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork (H -> H -> H
heightOfFork H
lh H
rh) E
l E
u RangeSet a
lt RangeSet a
rt

-- Balancers
{-# NOINLINE balance #-}
balance :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance !E
l !E
u RangeSet a
Tip RangeSet a
Tip = forall a. E -> E -> RangeSet a
single E
l E
u
balance E
l E
u lt :: RangeSet a
lt@(Fork H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt) RangeSet a
Tip
  | H
lh forall a. Eq a => a -> a -> Bool
== H
1   = forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork (H
lh forall a. Num a => a -> a -> a
+ H
1) E
l E
u RangeSet a
lt forall a. RangeSet a
Tip
  | Bool
otherwise = forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL E
l E
u E
ll E
lu RangeSet a
llt RangeSet a
lrt forall a. RangeSet a
Tip
balance E
l E
u RangeSet a
Tip rt :: RangeSet a
rt@(Fork H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
  | H
rh forall a. Eq a => a -> a -> Bool
== H
1   = forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork (H
rh forall a. Num a => a -> a -> a
+ H
1) E
l E
u forall a. RangeSet a
Tip RangeSet a
rt
  | Bool
otherwise = forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR E
l E
u forall a. RangeSet a
Tip E
rl E
ru RangeSet a
rlt RangeSet a
rrt
balance E
l E
u lt :: RangeSet a
lt@(Fork H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
  | forall a. RangeSet a -> H
height RangeSet a
lt forall a. Ord a => a -> a -> Bool
> forall a. RangeSet a -> H
height RangeSet a
rt forall a. Num a => a -> a -> a
+ H
1 = forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL E
l E
u E
ll E
lu RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  | forall a. RangeSet a -> H
height RangeSet a
rt forall a. Ord a => a -> a -> Bool
> forall a. RangeSet a -> H
height RangeSet a
lt forall a. Num a => a -> a -> a
+ H
1 = forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR E
l E
u RangeSet a
lt E
rl E
ru RangeSet a
rlt RangeSet a
rrt
  | Bool
otherwise = forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH E
l E
u H
lh RangeSet a
lt H
rh RangeSet a
rt

{-# INLINEABLE balanceL #-}
balanceL :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
balanceL :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceL !E
l1 !E
u1 lt :: RangeSet a
lt@(Fork H
lh E
l2 E
u2 RangeSet a
llt RangeSet a
lrt) !RangeSet a
rt
  -- both sides are equal height or off by one
  | H
dltrt forall a. Ord a => a -> a -> Bool
<= H
1 = forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH E
l1 E
u1 H
lh RangeSet a
lt H
rh RangeSet a
rt
  -- The bias is 2 (dltrt == 2)
  | Bool
otherwise  = forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL E
l1 E
u1 E
l2 E
u2 RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  where
    !rh :: H
rh = forall a. RangeSet a -> H
height RangeSet a
rt
    !dltrt :: H
dltrt = H -> H -> H
absDiff H
lh H
rh
-- If the right shrank (or nothing changed), we have to be prepared to handle the Tip case for lt
balanceL E
l E
u RangeSet a
Tip RangeSet a
rt = forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork (forall a. RangeSet a -> H
height RangeSet a
rt forall a. Num a => a -> a -> a
+ H
1) E
l E
u forall a. RangeSet a
Tip RangeSet a
rt

{-# INLINEABLE balanceR #-}
balanceR :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
balanceR :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceR !E
l1 !E
u1 !RangeSet a
lt rt :: RangeSet a
rt@(Fork H
rh E
l2 E
u2 RangeSet a
rlt RangeSet a
rrt)
  -- both sides are equal height or off by one
  | H
dltrt forall a. Ord a => a -> a -> Bool
<= H
1 = forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH E
l1 E
u1 H
lh RangeSet a
lt H
rh RangeSet a
rt
  | Bool
otherwise  = forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR E
l1 E
u1 RangeSet a
lt E
l2 E
u2 RangeSet a
rlt RangeSet a
rrt
  where
    !lh :: H
lh = forall a. RangeSet a -> H
height RangeSet a
lt
    !dltrt :: H
dltrt = H -> H -> H
absDiff H
rh H
lh
-- If the left shrank (or nothing changed), we have to be prepared to handle the Tip case for rt
balanceR E
l E
u RangeSet a
lt RangeSet a
Tip = forall a. H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork (forall a. RangeSet a -> H
height RangeSet a
lt forall a. Num a => a -> a -> a
+ H
1) E
l E
u RangeSet a
lt forall a. RangeSet a
Tip

{-# NOINLINE uncheckedBalanceL #-}
-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
uncheckedBalanceL :: E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a
uncheckedBalanceL :: forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL !E
l1 !E
u1 !E
l2 !E
u2 !RangeSet a
llt !RangeSet a
lrt !RangeSet a
rt
  -- The bias is 2 (dltrt == 2)
  | H
hllt forall a. Ord a => a -> a -> Bool
>= H
hlrt = forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' E
l1 E
u1 E
l2 E
u2 RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  | Bool
otherwise    = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotr E
l1 E
u1 (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl E
l2 E
u2 RangeSet a
llt RangeSet a
lrt) RangeSet a
rt
  where
    !hllt :: H
hllt = forall a. RangeSet a -> H
height RangeSet a
llt
    !hlrt :: H
hlrt = forall a. RangeSet a -> H
height RangeSet a
lrt

{-# NOINLINE uncheckedBalanceR #-}
uncheckedBalanceR :: E -> E -> RangeSet a -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
uncheckedBalanceR :: forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR !E
l1 !E
u1 !RangeSet a
lt !E
l2 !E
u2 !RangeSet a
rlt !RangeSet a
rrt
  -- The bias is 2 (drtlt == 2)
  | H
hrrt forall a. Ord a => a -> a -> Bool
>= H
hrlt = forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' E
l1 E
u1 RangeSet a
lt E
l2 E
u2 RangeSet a
rlt RangeSet a
rrt
  | Bool
otherwise    = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl E
l1 E
u1 RangeSet a
lt (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotr E
l2 E
u2 RangeSet a
rlt RangeSet a
rrt)
  where
    !hrlt :: H
hrlt = forall a. RangeSet a -> H
height RangeSet a
rlt
    !hrrt :: H
hrrt = forall a. RangeSet a -> H
height RangeSet a
rrt

{-# INLINE rotr #-}
rotr :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotr :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotr !E
l1 !E
u1 (Fork H
_ E
l2 E
u2 RangeSet a
p RangeSet a
q) !RangeSet a
r = forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' E
l1 E
u1 E
l2 E
u2 RangeSet a
p RangeSet a
q RangeSet a
r
rotr E
_ E
_ RangeSet a
_ RangeSet a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"rotr on Tip"

{-# INLINE rotl #-}
rotl :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl !E
l1 !E
u1 !RangeSet a
p (Fork H
_ E
l2 E
u2 RangeSet a
q RangeSet a
r) = forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' E
l1 E
u1 RangeSet a
p E
l2 E
u2 RangeSet a
q RangeSet a
r
rotl E
_ E
_ RangeSet a
_ RangeSet a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"rotr on Tip"

{-# INLINE rotr' #-}
rotr' :: E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a
rotr' :: forall a.
E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' !E
l1 !E
u1 !E
l2 !E
u2 !RangeSet a
p !RangeSet a
q !RangeSet a
r = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l2 E
u2 RangeSet a
p (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l1 E
u1 RangeSet a
q RangeSet a
r)

{-# INLINE rotl' #-}
rotl' :: E -> E -> RangeSet a -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl' :: forall a.
E
-> E
-> RangeSet a
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' !E
l1 !E
u1 !RangeSet a
p !E
l2 !E
u2 !RangeSet a
q !RangeSet a
r = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l2 E
u2 (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l1 E
u1 RangeSet a
p RangeSet a
q) RangeSet a
r