From 0566d160bd130c94ffb7eec15cbd0f85094d4263 Mon Sep 17 00:00:00 2001
From: Alice Rixte <alice.rixte@gmail.com>
Date: Sun, 25 Jan 2026 14:53:56 +0100
Subject: [PATCH] Add fromUnorderedBounds constructor

---
 src/Data/Interval.hs          |  1 +
 src/Data/Interval/Internal.hs | 45 +++++++++++++++++++++++++++++++++++
 test/TestInterval.hs          | 13 ++++++++++
 3 files changed, 59 insertions(+)

diff --git a/src/Data/Interval.hs b/src/Data/Interval.hs
index 251e326..73f4ec9 100644
--- a/src/Data/Interval.hs
+++ b/src/Data/Interval.hs
@@ -35,6 +35,7 @@ module Data.Interval
   , (<..<=)
   , (<=..<)
   , (<..<)
+  , fromUnorderedBounds
   , whole
   , empty
   , singleton
diff --git a/src/Data/Interval/Internal.hs b/src/Data/Interval/Internal.hs
index dec0f79..74dd72a 100644
--- a/src/Data/Interval/Internal.hs
+++ b/src/Data/Interval/Internal.hs
@@ -9,6 +9,7 @@ module Data.Interval.Internal
   , lowerBound'
   , upperBound'
   , interval
+  , fromUnorderedBounds
   , empty
   , restrictMapKeysToInterval
   , withoutMapKeysFromInterval
@@ -232,6 +233,50 @@ interval = \case
   (PosInf, _) -> const Empty
 {-# INLINE interval #-}
 
+-- | Same as 'interval' but swaps the lower and upper bounds when given in
+-- reverse order.
+fromUnorderedBounds
+  :: (Ord r)
+  => (Extended r, Boundary) -- ^ lower or upper bound and whether it is included
+  -> (Extended r, Boundary) -- ^ upper or upper bound and whether it is included
+  -> Interval r
+fromUnorderedBounds = \case
+  (NegInf, _) -> \case
+    (NegInf, _) -> Empty
+    (Finite r, Open) -> LessThan r
+    (Finite r, Closed) -> LessOrEqual r
+    (PosInf, _) -> Whole
+  (Finite p, Open) -> \case
+    (NegInf, _) -> LessThan p
+    (Finite q, Open) -> case p `compare` q of
+      LT -> BothOpen p q
+      GT -> BothOpen q p
+      EQ -> Empty
+    (Finite q, Closed) -> case p `compare` q of
+      LT -> LeftOpen p q
+      GT -> RightOpen q p
+      EQ -> Empty
+    (PosInf, _) -> GreaterThan p
+  (Finite p, Closed) -> \case
+    (NegInf, _) -> LessOrEqual p
+    (Finite q, Open) -> case p `compare` q of
+      LT -> RightOpen p q
+      GT -> LeftOpen q p
+      EQ -> Empty
+    (Finite q, Closed) -> case p `compare` q of
+      LT -> BothClosed p q
+      EQ -> Point p
+      GT -> BothClosed q p
+    (PosInf, _) -> GreaterOrEqual p
+  (PosInf, _) -> \case
+    (NegInf, _) -> Whole
+    (Finite r, Open) -> GreaterThan r
+    (Finite r, Closed) -> GreaterOrEqual r
+    (PosInf, _) -> Empty
+{-# INLINE fromUnorderedBounds #-}
+
+------------------------------------------------------------------------------
+
 -- | \(O(\log n)\). Restrict a 'Map' to the keys contained in a given
 -- 'Interval'.
 --
diff --git a/test/TestInterval.hs b/test/TestInterval.hs
index 8dc0ef2..683a5e3 100644
--- a/test/TestInterval.hs
+++ b/test/TestInterval.hs
@@ -95,6 +95,19 @@ prop_distinct_singleton_intersection =
       Interval.intersection (Interval.singleton r1) (Interval.singleton r2)
       == Interval.empty
 
+{--------------------------------------------------------------------
+  fromUnorderedBounds
+--------------------------------------------------------------------}
+
+prop_fromUnorderedBounds_consistent_with_interval =
+  forAll arbitrary $ \ (a :: Extended Rational) bounda b boundb ->
+    if a <= b then
+      Interval.interval (a, bounda) (b, boundb) ==
+      Interval.fromUnorderedBounds (a, bounda) (b, boundb)
+    else
+      Interval.interval (b, boundb) (a, bounda) ==
+      Interval.fromUnorderedBounds (a, bounda) (b, boundb)
+
 {--------------------------------------------------------------------
   Intersection
 --------------------------------------------------------------------}