{-# LANGUAGE Safe #-}

-- | Internal utility functions shared across the range library.
-- This module is in @other-modules@ and is not part of the public API.
--
-- Functions are grouped by the layer that consumes them:
--   * "Used by Ranges\/Ord" — consumed by the semi-public modules
--   * "Used by Spans\/RangeInternal" — consumed only by the strictly-internal layer
--   * "Util-internal" — building blocks used only within this module
module Data.Range.Util
  ( -- * Used by Ranges and Ord
    compareLower
  , compareHigher
  , invertBound
  , boundsOverlapType
  , pointJoinType
  , boundIsBetween
  , againstLowerBound
  , againstUpperBound
  , takeEvenly
    -- * Used by Spans and RangeInternal
  , compareUpperToLower
  , minBounds
  , maxBounds
  , minBoundsIntersection
  , maxBoundsIntersection
  , insertionSort
  , isEmptySpan
  , removeEmptySpans
  , boundCmp
  , lowestValueInLowerBound
  , highestValueInUpperBound
  ) where

import Data.List (transpose)

import Data.Range.Data

compareLower :: Ord a => Bound a -> Bound a -> Ordering
compareLower :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower ab :: Bound a
ab@(Bound a
a BoundType
aType) bb :: Bound a
bb@(Bound a
b BoundType
_)
   | Bound a
ab Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
bb     = Ordering
EQ
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b       = if BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then Ordering
LT else Ordering
GT
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b        = Ordering
LT
   | Bool
otherwise    = Ordering
GT

compareHigher :: Ord a => Bound a -> Bound a -> Ordering
compareHigher :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigher ab :: Bound a
ab@(Bound a
a BoundType
aType) bb :: Bound a
bb@(Bound a
b BoundType
_)
   | Bound a
ab Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
bb     = Ordering
EQ
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b       = if BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then Ordering
GT else Ordering
LT
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b        = Ordering
LT
   | Bool
otherwise    = Ordering
GT

-- | Util-internal: used only by 'minBoundsIntersection'.
compareLowerIntersection :: Ord a => Bound a -> Bound a -> Ordering
compareLowerIntersection :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareLowerIntersection ab :: Bound a
ab@(Bound a
a BoundType
aType) bb :: Bound a
bb@(Bound a
b BoundType
_)
   | Bound a
ab Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
bb     = Ordering
EQ
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b       = if BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Exclusive then Ordering
LT else Ordering
GT
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b        = Ordering
LT
   | Bool
otherwise    = Ordering
GT

-- | Util-internal: used only by 'maxBoundsIntersection'.
compareHigherIntersection :: Ord a => Bound a -> Bound a -> Ordering
compareHigherIntersection :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigherIntersection ab :: Bound a
ab@(Bound a
a BoundType
aType) bb :: Bound a
bb@(Bound a
b BoundType
_)
   | Bound a
ab Bound a -> Bound a -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a
bb     = Ordering
EQ
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b       = if BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Exclusive then Ordering
GT else Ordering
LT
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b        = Ordering
LT
   | Bool
otherwise    = Ordering
GT

compareUpperToLower :: Ord a => Bound a -> Bound a -> Ordering
compareUpperToLower :: forall a. Ord a => Bound a -> Bound a -> Ordering
compareUpperToLower (Bound a
upper BoundType
upperType) (Bound a
lower BoundType
lowerType)
   | a
upper a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lower  = if BoundType
upperType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive Bool -> Bool -> Bool
|| BoundType
lowerType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then Ordering
EQ else Ordering
LT
   | a
upper a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lower   = Ordering
LT
   | Bool
otherwise       = Ordering
GT

minBounds :: Ord a => Bound a -> Bound a -> Bound a
minBounds :: forall a. Ord a => Bound a -> Bound a -> Bound a
minBounds Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Bound a
ao else Bound a
bo

maxBounds :: Ord a => Bound a -> Bound a -> Bound a
maxBounds :: forall a. Ord a => Bound a -> Bound a -> Bound a
maxBounds Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigher Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Bound a
ao else Bound a
bo

minBoundsIntersection :: Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection :: forall a. Ord a => Bound a -> Bound a -> Bound a
minBoundsIntersection Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLowerIntersection Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Bound a
ao else Bound a
bo

maxBoundsIntersection :: Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection :: forall a. Ord a => Bound a -> Bound a -> Bound a
maxBoundsIntersection Bound a
ao Bound a
bo = if Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigherIntersection Bound a
ao Bound a
bo Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Bound a
ao else Bound a
bo

insertionSort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
insertionSort :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
insertionSort a -> a -> Ordering
comp [a]
xs [a]
ys = [a] -> [a] -> [a]
go [a]
xs [a]
ys
   where
      go :: [a] -> [a] -> [a]
go (a
f : [a]
fs) (a
s : [a]
ss) = case a -> a -> Ordering
comp a
f a
s of
         Ordering
LT -> a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
fs (a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ss)
         Ordering
EQ -> a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
fs [a]
ss
         Ordering
GT -> a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go (a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs) [a]
ss
      go [] [a]
z = [a]
z
      go [a]
z [] = [a]
z

invertBound :: Bound a -> Bound a
invertBound :: forall a. Bound a -> Bound a
invertBound (Bound a
x BoundType
Inclusive) = a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Exclusive
invertBound (Bound a
x BoundType
Exclusive) = a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Inclusive

isEmptySpan :: Eq a => (Bound a, Bound a) -> Bool
isEmptySpan :: forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a
a BoundType
aType, Bound a
b BoundType
bType) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& (BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Exclusive Bool -> Bool -> Bool
|| BoundType
bType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Exclusive)

removeEmptySpans :: Eq a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
removeEmptySpans :: forall a. Eq a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]
removeEmptySpans = ((Bound a, Bound a) -> Bool)
-> [(Bound a, Bound a)] -> [(Bound a, Bound a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bound a, Bound a) -> Bool) -> (Bound a, Bound a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan)

boundsOverlapType :: Ord a => (Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType :: forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType l :: (Bound a, Bound a)
l@(ab :: Bound a
ab@(Bound a
a BoundType
_), bb :: Bound a
bb@(Bound a
b BoundType
_)) r :: (Bound a, Bound a)
r@(xb :: Bound a
xb@(Bound a
x BoundType
_), yb :: Bound a
yb@(Bound a
y BoundType
_))
   | (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a, Bound a)
l Bool -> Bool -> Bool
|| (Bound a, Bound a) -> Bool
forall a. Eq a => (Bound a, Bound a) -> Bool
isEmptySpan (Bound a, Bound a)
r    = OverlapType
Separate
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x                            = OverlapType
Overlap
   | a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y                            = OverlapType
Overlap
   | Bool
otherwise = (Bound a
ab Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
`boundIsBetween` (Bound a
xb, Bound a
yb)) OverlapType -> OverlapType -> OverlapType
`orOverlapType` (Bound a
xb Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
`boundIsBetween` (Bound a
ab, Bound a
bb))

-- | Util-internal: used only by 'boundsOverlapType'.
orOverlapType :: OverlapType -> OverlapType -> OverlapType
orOverlapType :: OverlapType -> OverlapType -> OverlapType
orOverlapType OverlapType
Overlap OverlapType
_ = OverlapType
Overlap
orOverlapType OverlapType
_ OverlapType
Overlap = OverlapType
Overlap
orOverlapType OverlapType
Adjoin OverlapType
_ = OverlapType
Adjoin
orOverlapType OverlapType
_ OverlapType
Adjoin = OverlapType
Adjoin
orOverlapType OverlapType
_ OverlapType
_ = OverlapType
Separate

pointJoinType :: BoundType -> BoundType -> OverlapType
pointJoinType :: BoundType -> BoundType -> OverlapType
pointJoinType BoundType
Inclusive BoundType
Inclusive = OverlapType
Overlap
pointJoinType BoundType
Exclusive BoundType
Exclusive = OverlapType
Separate
pointJoinType BoundType
_ BoundType
_ = OverlapType
Adjoin

-- | This function assumes that the bound on the left is a lower bound and
-- that the range is in @(lower, upper)@ bound order.
boundCmp :: (Ord a) => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp :: forall a. Ord a => Bound a -> (Bound a, Bound a) -> Ordering
boundCmp ab :: Bound a
ab@(Bound a
a BoundType
_) (xb :: Bound a
xb@(Bound a
x BoundType
_), Bound a
yb)
   | Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween Bound a
ab (Bound a
xb, Bound a
yb) OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
/= OverlapType
Separate = Ordering
EQ
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x = Ordering
LT
   | Bool
otherwise = Ordering
GT

-- | Tests whether a single 'Bound' falls within the span @(lower, upper)@,
-- returning the 'OverlapType' at that point.
--
-- This is the point-in-span primitive. 'boundsOverlapType' is built on top
-- of it and handles the span-vs-span case. Replacing call sites of this
-- function with 'boundsOverlapType' would require constructing a degenerate
-- span @(b, b)@ for each point — see @ai-planning/boundIsBetween-todo.md@
-- for the full analysis.
boundIsBetween :: (Ord a) => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween :: forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween (Bound a
a BoundType
aType) (Bound a
x BoundType
xType, Bound a
y BoundType
yType)
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
a     = OverlapType
Separate
   | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a    = BoundType -> BoundType -> OverlapType
pointJoinType BoundType
aType BoundType
xType
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y     = OverlapType
Overlap
   | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = BoundType -> BoundType -> OverlapType
pointJoinType BoundType
aType BoundType
yType
   | Bool
otherwise = OverlapType
Separate

againstLowerBound :: Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound :: forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (Bound a
a BoundType
aType) (Bound a
lower BoundType
lowerType)
   | a
lower a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a   = BoundType -> BoundType -> OverlapType
pointJoinType BoundType
aType BoundType
lowerType
   | a
lower a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a    = OverlapType
Overlap
   | Bool
otherwise    = OverlapType
Separate

againstUpperBound :: Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound :: forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (Bound a
a BoundType
aType) (Bound a
upper BoundType
upperType)
   | a
upper a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a   = BoundType -> BoundType -> OverlapType
pointJoinType BoundType
aType BoundType
upperType
   | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
upper    = OverlapType
Overlap
   | Bool
otherwise    = OverlapType
Separate

takeEvenly :: [[a]] -> [a]
takeEvenly :: forall a. [[a]] -> [a]
takeEvenly = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose

lowestValueInLowerBound :: Enum a => Bound a -> a
lowestValueInLowerBound :: forall a. Enum a => Bound a -> a
lowestValueInLowerBound (Bound a
a BoundType
Inclusive) = a
a
lowestValueInLowerBound (Bound a
a BoundType
Exclusive) = a -> a
forall a. Enum a => a -> a
succ a
a

highestValueInUpperBound :: Enum a => Bound a -> a
highestValueInUpperBound :: forall a. Enum a => Bound a -> a
highestValueInUpperBound (Bound a
a BoundType
Inclusive) = a
a
highestValueInUpperBound (Bound a
a BoundType
Exclusive) = a -> a
forall a. Enum a => a -> a
pred a
a