{-# LANGUAGE Safe #-}

-- | Ordering newtypes for 'Range'.
--
-- 'Range' deliberately has no 'Ord' instance because there is no single
-- natural ordering — the right choice depends on the use case. This module
-- provides two explicit wrappers:
--
-- * 'KeyRange' — a consistent structural ordering, suitable for use as a
--   'Data.Map.Map' key or in a 'Data.Set.Set'.
--
-- * 'SortedRange' — a positional ordering by location on the number line,
--   suitable for sorting ranges for display.
--
-- == Example: Map keyed on ranges
--
-- @
-- import Data.Range (Range, (+=+), lbi)
-- import Data.Range.Ord (KeyRange(..))
-- import qualified Data.Map.Strict as Map
--
-- type RuleMap = Map (KeyRange Integer) String
--
-- rules :: RuleMap
-- rules = Map.fromList
--   [ (KeyRange (1 +=+ 10),  \"low\")
--   , (KeyRange (11 +=+ 50), \"medium\")
--   , (KeyRange (lbi 51),    \"high\")
--   ]
-- @
--
-- == Example: sorting ranges by position on the number line
--
-- @
-- import Data.List (sortOn)
-- import Data.Range (Range, (+=+), lbi, ube)
-- import Data.Range.Ord (SortedRange(..))
--
-- sortOn SortedRange [lbi 10, 1 +=+ 5, ube 0 :: Range Integer]
-- -- [ube 0, 1 +=+ 5, lbi 10]
--
-- -- or equivalently:
-- displayRanges :: Ord a => [Range a] -> [Range a]
-- displayRanges = sortOn SortedRange
-- @
module Data.Range.Ord
   ( -- * Structural ordering
     -- | Use 'KeyRange' when you need 'Range' values as 'Data.Map.Map' keys or
     -- in a 'Data.Set.Set'. The ordering is consistent but not semantically
     -- meaningful on the number line.
     KeyRange(..)
     -- * Positional ordering
     -- | Use 'SortedRange' when you want to sort ranges by where they sit on
     -- the number line (lower bound first, upper bound as tiebreaker).
   , SortedRange(..)
   ) where

-- $setup
-- >>> import Data.Range
-- >>> import Data.Range.Ord
-- >>> import Data.List (sortOn)

import Data.Range.Data
import Data.Range.Util (compareLower, compareHigher)

-- ---------------------------------------------------------------------------
-- KeyRange: structural ordering
-- ---------------------------------------------------------------------------

-- | Wraps 'Range' with a structural 'Ord' instance, suitable for use as a
-- 'Data.Map.Map' key or in a 'Data.Set.Set'.
--
-- Constructor order: @SingletonRange < SpanRange < LowerBoundRange <
-- UpperBoundRange < InfiniteRange@. Fields within the same constructor are
-- compared lexicographically.
--
-- This ordering is not semantically meaningful on the number line —
-- @SingletonRange 5@ and @SpanRange (Bound 5 Inclusive) (Bound 5 Inclusive)@
-- are considered distinct. It is only appropriate where any consistent total
-- order will do (deduplication, 'Data.Map.Map' keys).
--
-- Use 'unKeyRange' to unwrap the underlying 'Range'.
--
-- See also 'SortedRange' for ordering by position on the number line.
--
-- @since 0.3.2.0
newtype KeyRange a = KeyRange { forall a. KeyRange a -> Range a
unKeyRange :: Range a }
   deriving (KeyRange a -> KeyRange a -> Bool
(KeyRange a -> KeyRange a -> Bool)
-> (KeyRange a -> KeyRange a -> Bool) -> Eq (KeyRange a)
forall a. Eq a => KeyRange a -> KeyRange a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => KeyRange a -> KeyRange a -> Bool
== :: KeyRange a -> KeyRange a -> Bool
$c/= :: forall a. Eq a => KeyRange a -> KeyRange a -> Bool
/= :: KeyRange a -> KeyRange a -> Bool
Eq, Int -> KeyRange a -> ShowS
[KeyRange a] -> ShowS
KeyRange a -> String
(Int -> KeyRange a -> ShowS)
-> (KeyRange a -> String)
-> ([KeyRange a] -> ShowS)
-> Show (KeyRange a)
forall a. Show a => Int -> KeyRange a -> ShowS
forall a. Show a => [KeyRange a] -> ShowS
forall a. Show a => KeyRange a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> KeyRange a -> ShowS
showsPrec :: Int -> KeyRange a -> ShowS
$cshow :: forall a. Show a => KeyRange a -> String
show :: KeyRange a -> String
$cshowList :: forall a. Show a => [KeyRange a] -> ShowS
showList :: [KeyRange a] -> ShowS
Show)

constructorRank :: Range a -> Int
constructorRank :: forall a. Range a -> Int
constructorRank (SingletonRange a
_)  = Int
0
constructorRank (SpanRange Bound a
_ Bound a
_)     = Int
1
constructorRank (LowerBoundRange Bound a
_) = Int
2
constructorRank (UpperBoundRange Bound a
_) = Int
3
constructorRank Range a
InfiniteRange       = Int
4

compareRangeFields :: Ord a => Range a -> Range a -> Ordering
compareRangeFields :: forall a. Ord a => Range a -> Range a -> Ordering
compareRangeFields (SingletonRange a
a)  (SingletonRange a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareRangeFields (SpanRange Bound a
lo1 Bound a
hi1) (SpanRange Bound a
lo2 Bound a
hi2) =
   case Bound a -> Bound a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bound a
lo1 Bound a
lo2 of
      Ordering
EQ -> Bound a -> Bound a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bound a
hi1 Bound a
hi2
      Ordering
r  -> Ordering
r
compareRangeFields (LowerBoundRange Bound a
a) (LowerBoundRange Bound a
b) = Bound a -> Bound a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bound a
a Bound a
b
compareRangeFields (UpperBoundRange Bound a
a) (UpperBoundRange Bound a
b) = Bound a -> Bound a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bound a
a Bound a
b
compareRangeFields Range a
InfiniteRange       Range a
InfiniteRange       = Ordering
EQ
compareRangeFields Range a
_                   Range a
_                   = Ordering
EQ

instance Ord a => Ord (KeyRange a) where
   compare :: KeyRange a -> KeyRange a -> Ordering
compare (KeyRange Range a
x) (KeyRange Range a
y) =
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Range a -> Int
forall a. Range a -> Int
constructorRank Range a
x) (Range a -> Int
forall a. Range a -> Int
constructorRank Range a
y) of
         Ordering
EQ -> Range a -> Range a -> Ordering
forall a. Ord a => Range a -> Range a -> Ordering
compareRangeFields Range a
x Range a
y
         Ordering
r  -> Ordering
r

-- ---------------------------------------------------------------------------
-- SortedRange: positional ordering
-- ---------------------------------------------------------------------------

-- | Extended bound adding @-∞@ and @+∞@ sentinels, used internally by
-- 'SortedRange'.
data ExtBound a = NegInfinity | FiniteBound (Bound a) | PosInfinity

compareExtBound :: (Bound a -> Bound a -> Ordering) -> ExtBound a -> ExtBound a -> Ordering
compareExtBound :: forall a.
(Bound a -> Bound a -> Ordering)
-> ExtBound a -> ExtBound a -> Ordering
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
NegInfinity     ExtBound a
NegInfinity     = Ordering
EQ
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
NegInfinity     ExtBound a
_               = Ordering
LT
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
_               ExtBound a
NegInfinity     = Ordering
GT
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
PosInfinity     ExtBound a
PosInfinity     = Ordering
EQ
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
PosInfinity     ExtBound a
_               = Ordering
GT
compareExtBound Bound a -> Bound a -> Ordering
_   ExtBound a
_               ExtBound a
PosInfinity     = Ordering
LT
compareExtBound Bound a -> Bound a -> Ordering
cmp (FiniteBound Bound a
a) (FiniteBound Bound a
b) = Bound a -> Bound a -> Ordering
cmp Bound a
a Bound a
b

lowerExtBound :: Range a -> ExtBound a
lowerExtBound :: forall a. Range a -> ExtBound a
lowerExtBound (UpperBoundRange Bound a
_) = ExtBound a
forall a. ExtBound a
NegInfinity
lowerExtBound Range a
InfiniteRange       = ExtBound a
forall a. ExtBound a
NegInfinity
lowerExtBound (LowerBoundRange Bound a
b) = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound Bound a
b
lowerExtBound (SpanRange Bound a
lo Bound a
_)    = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound Bound a
lo
lowerExtBound (SingletonRange a
x)  = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Inclusive)

upperExtBound :: Range a -> ExtBound a
upperExtBound :: forall a. Range a -> ExtBound a
upperExtBound (LowerBoundRange Bound a
_) = ExtBound a
forall a. ExtBound a
PosInfinity
upperExtBound Range a
InfiniteRange       = ExtBound a
forall a. ExtBound a
PosInfinity
upperExtBound (UpperBoundRange Bound a
b) = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound Bound a
b
upperExtBound (SpanRange Bound a
_ Bound a
hi)    = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound Bound a
hi
upperExtBound (SingletonRange a
x)  = Bound a -> ExtBound a
forall a. Bound a -> ExtBound a
FiniteBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
x BoundType
Inclusive)

-- | Wraps 'Range' with a positional 'Ord' instance: ranges are ordered by
-- where they sit on the number line, lower bound first with upper bound as a
-- tiebreaker.
--
-- The 'Eq' instance is consistent with 'Ord': two 'SortedRange' values are
-- equal iff they have the same lower and upper bounds. This means
-- @SortedRange (SingletonRange 5)@ and @SortedRange (5 +=+ 5)@ are considered
-- equal (they occupy the same point on the number line).
--
-- Use 'unSortedRange' to unwrap the underlying 'Range'. Typical usage:
--
-- >>> import Data.List (sortOn)
-- >>> sortOn SortedRange [SingletonRange 5, SingletonRange 1, SingletonRange 3 :: Range Integer]
-- [SingletonRange 1,SingletonRange 3,SingletonRange 5]
--
-- See also 'KeyRange' for a structural ordering suitable for 'Data.Map.Map' keys.
--
-- @since 0.3.2.0
newtype SortedRange a = SortedRange { forall a. SortedRange a -> Range a
unSortedRange :: Range a }

instance Show a => Show (SortedRange a) where
   show :: SortedRange a -> String
show (SortedRange Range a
r) = String
"SortedRange (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Range a -> String
forall a. Show a => a -> String
show Range a
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Ord a => Eq (SortedRange a) where
   SortedRange a
x == :: SortedRange a -> SortedRange a -> Bool
== SortedRange a
y = SortedRange a -> SortedRange a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SortedRange a
x SortedRange a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord a => Ord (SortedRange a) where
   compare :: SortedRange a -> SortedRange a -> Ordering
compare (SortedRange Range a
a) (SortedRange Range a
b) =
      case (Bound a -> Bound a -> Ordering)
-> ExtBound a -> ExtBound a -> Ordering
forall a.
(Bound a -> Bound a -> Ordering)
-> ExtBound a -> ExtBound a -> Ordering
compareExtBound Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareLower (Range a -> ExtBound a
forall a. Range a -> ExtBound a
lowerExtBound Range a
a) (Range a -> ExtBound a
forall a. Range a -> ExtBound a
lowerExtBound Range a
b) of
         Ordering
EQ -> (Bound a -> Bound a -> Ordering)
-> ExtBound a -> ExtBound a -> Ordering
forall a.
(Bound a -> Bound a -> Ordering)
-> ExtBound a -> ExtBound a -> Ordering
compareExtBound Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Ordering
compareHigher (Range a -> ExtBound a
forall a. Range a -> ExtBound a
upperExtBound Range a
a) (Range a -> ExtBound a
forall a. Range a -> ExtBound a
upperExtBound Range a
b)
         Ordering
r  -> Ordering
r