{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Safe #-}
module Data.Order.Interval (
Interval (),
imap,
(...),
iempty,
singleton,
contains,
endpts,
) where
import safe Data.Bifunctor (bimap)
import safe qualified Data.Eq as Eq
import safe Data.Order
import safe Data.Order.Syntax
import safe Prelude hiding (Bounded, Eq (..), Ord (..), until)
data Interval a = Empty | Interval !a !a deriving (Int -> Interval a -> ShowS
[Interval a] -> ShowS
Interval a -> String
(Int -> Interval a -> ShowS)
-> (Interval a -> String)
-> ([Interval a] -> ShowS)
-> Show (Interval a)
forall a. Show a => Int -> Interval a -> ShowS
forall a. Show a => [Interval a] -> ShowS
forall a. Show a => Interval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval a] -> ShowS
$cshowList :: forall a. Show a => [Interval a] -> ShowS
show :: Interval a -> String
$cshow :: forall a. Show a => Interval a -> String
showsPrec :: Int -> Interval a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Interval a -> ShowS
Show)
imap :: Preorder b => (a -> b) -> Interval a -> Interval b
imap :: (a -> b) -> Interval a -> Interval b
imap a -> b
f = Interval b -> ((b, b) -> Interval b) -> Maybe (b, b) -> Interval b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Interval b
forall a. Interval a
iempty ((b -> b -> Interval b) -> (b, b) -> Interval b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> b -> Interval b
forall a. Preorder a => a -> a -> Interval a
(...)) (Maybe (b, b) -> Interval b)
-> (Interval a -> Maybe (b, b)) -> Interval a -> Interval b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> (b, b)) -> Maybe (a, a) -> Maybe (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a -> b) -> (a, a) -> (b, b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f a -> b
f) (Maybe (a, a) -> Maybe (b, b))
-> (Interval a -> Maybe (a, a)) -> Interval a -> Maybe (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval a -> Maybe (a, a)
forall a. Interval a -> Maybe (a, a)
endpts
infix 3 ...
(...) :: Preorder a => a -> a -> Interval a
a
x ... :: a -> a -> Interval a
... a
y = case a -> a -> Maybe Ordering
forall a. Preorder a => a -> a -> Maybe Ordering
pcompare a
x a
y of
Just Ordering
LT -> a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
x a
y
Just Ordering
EQ -> a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
x a
y
Maybe Ordering
_ -> Interval a
forall a. Interval a
Empty
{-# INLINE (...) #-}
iempty :: Interval a
iempty :: Interval a
iempty = Interval a
forall a. Interval a
Empty
{-# INLINE iempty #-}
singleton :: a -> Interval a
singleton :: a -> Interval a
singleton a
a = a -> a -> Interval a
forall a. a -> a -> Interval a
Interval a
a a
a
{-# INLINE singleton #-}
endpts :: Interval a -> Maybe (a, a)
endpts :: Interval a -> Maybe (a, a)
endpts Interval a
Empty = Maybe (a, a)
forall a. Maybe a
Nothing
endpts (Interval a
x a
y) = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
x, a
y)
{-# INLINE endpts #-}
contains :: Preorder a => Interval a -> a -> Bool
contains :: Interval a -> a -> Bool
contains Interval a
Empty a
_ = Bool
False
contains (Interval a
x a
y) a
p = a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
p Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
y
instance Eq a => Eq (Interval a) where
Interval a
Empty == :: Interval a -> Interval a -> Bool
== Interval a
Empty = Bool
True
Interval a
Empty == Interval a
_ = Bool
False
Interval a
_ == Interval a
Empty = Bool
False
Interval a
x a
y == Interval a
x' a
y' = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y'
instance Preorder a => Preorder (Interval a) where
Interval a
Empty <~ :: Interval a -> Interval a -> Bool
<~ Interval a
_ = Bool
True
Interval a
_ <~ Interval a
Empty = Bool
False
Interval a
x a
y <~ Interval a
x' a
y' = a
x' a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
x Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
y'