{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Interval.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
--------------------------------------------------------------------------------
module Data.Geometry.Interval.Util where

import Control.DeepSeq
import Control.Lens
import Data.Range
import GHC.Generics (Generic)


-- | Open on left endpoint; so Closed before open
newtype L r = L { L r -> EndPoint r
_unL :: EndPoint r } deriving (Int -> L r -> ShowS
[L r] -> ShowS
L r -> String
(Int -> L r -> ShowS)
-> (L r -> String) -> ([L r] -> ShowS) -> Show (L r)
forall r. Show r => Int -> L r -> ShowS
forall r. Show r => [L r] -> ShowS
forall r. Show r => L r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L r] -> ShowS
$cshowList :: forall r. Show r => [L r] -> ShowS
show :: L r -> String
$cshow :: forall r. Show r => L r -> String
showsPrec :: Int -> L r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> L r -> ShowS
Show,L r -> L r -> Bool
(L r -> L r -> Bool) -> (L r -> L r -> Bool) -> Eq (L r)
forall r. Eq r => L r -> L r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: L r -> L r -> Bool
$c/= :: forall r. Eq r => L r -> L r -> Bool
== :: L r -> L r -> Bool
$c== :: forall r. Eq r => L r -> L r -> Bool
Eq,(forall x. L r -> Rep (L r) x)
-> (forall x. Rep (L r) x -> L r) -> Generic (L r)
forall x. Rep (L r) x -> L r
forall x. L r -> Rep (L r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (L r) x -> L r
forall r x. L r -> Rep (L r) x
$cto :: forall r x. Rep (L r) x -> L r
$cfrom :: forall r x. L r -> Rep (L r) x
Generic,L r -> ()
(L r -> ()) -> NFData (L r)
forall r. NFData r => L r -> ()
forall a. (a -> ()) -> NFData a
rnf :: L r -> ()
$crnf :: forall r. NFData r => L r -> ()
NFData)
makeLenses ''L
instance Ord r => Ord (L r) where
  L r
a compare :: L r -> L r -> Ordering
`compare` L r
b = EndPoint r -> (r, Bool)
forall a. EndPoint a -> (a, Bool)
f ( L r -> EndPoint r
forall r. L r -> EndPoint r
_unL L r
a) (r, Bool) -> (r, Bool) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EndPoint r -> (r, Bool)
forall a. EndPoint a -> (a, Bool)
f (L r -> EndPoint r
forall r. L r -> EndPoint r
_unL L r
b)
    where
      f :: EndPoint a -> (a, Bool)
f (Open a
x)   = (a
x,Bool
True)
      f (Closed a
x) = (a
x,Bool
False)

-- | Order on right endpoint; so Open before Closed
newtype R r = R { R r -> EndPoint r
_unR :: EndPoint r } deriving (Int -> R r -> ShowS
[R r] -> ShowS
R r -> String
(Int -> R r -> ShowS)
-> (R r -> String) -> ([R r] -> ShowS) -> Show (R r)
forall r. Show r => Int -> R r -> ShowS
forall r. Show r => [R r] -> ShowS
forall r. Show r => R r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [R r] -> ShowS
$cshowList :: forall r. Show r => [R r] -> ShowS
show :: R r -> String
$cshow :: forall r. Show r => R r -> String
showsPrec :: Int -> R r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> R r -> ShowS
Show,R r -> R r -> Bool
(R r -> R r -> Bool) -> (R r -> R r -> Bool) -> Eq (R r)
forall r. Eq r => R r -> R r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: R r -> R r -> Bool
$c/= :: forall r. Eq r => R r -> R r -> Bool
== :: R r -> R r -> Bool
$c== :: forall r. Eq r => R r -> R r -> Bool
Eq,Eq (R r)
Eq (R r)
-> (R r -> R r -> Ordering)
-> (R r -> R r -> Bool)
-> (R r -> R r -> Bool)
-> (R r -> R r -> Bool)
-> (R r -> R r -> Bool)
-> (R r -> R r -> R r)
-> (R r -> R r -> R r)
-> Ord (R r)
R r -> R r -> Bool
R r -> R r -> Ordering
R r -> R r -> R r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall r. Ord r => Eq (R r)
forall r. Ord r => R r -> R r -> Bool
forall r. Ord r => R r -> R r -> Ordering
forall r. Ord r => R r -> R r -> R r
min :: R r -> R r -> R r
$cmin :: forall r. Ord r => R r -> R r -> R r
max :: R r -> R r -> R r
$cmax :: forall r. Ord r => R r -> R r -> R r
>= :: R r -> R r -> Bool
$c>= :: forall r. Ord r => R r -> R r -> Bool
> :: R r -> R r -> Bool
$c> :: forall r. Ord r => R r -> R r -> Bool
<= :: R r -> R r -> Bool
$c<= :: forall r. Ord r => R r -> R r -> Bool
< :: R r -> R r -> Bool
$c< :: forall r. Ord r => R r -> R r -> Bool
compare :: R r -> R r -> Ordering
$ccompare :: forall r. Ord r => R r -> R r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (R r)
Ord,(forall x. R r -> Rep (R r) x)
-> (forall x. Rep (R r) x -> R r) -> Generic (R r)
forall x. Rep (R r) x -> R r
forall x. R r -> Rep (R r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (R r) x -> R r
forall r x. R r -> Rep (R r) x
$cto :: forall r x. Rep (R r) x -> R r
$cfrom :: forall r x. R r -> Rep (R r) x
Generic,R r -> ()
(R r -> ()) -> NFData (R r)
forall r. NFData r => R r -> ()
forall a. (a -> ()) -> NFData a
rnf :: R r -> ()
$crnf :: forall r. NFData r => R r -> ()
NFData)
makeLenses ''R