--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Interval
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Interval(
                               -- * 1 dimensional Intervals
                               Interval (Interval, OpenInterval,ClosedInterval)
                             , fromRange, toRange
                             , _Range

                               -- * querying the start and end of intervals
                             , HasStart(..), HasEnd(..)
                             -- * Working with intervals
                             , intersectsInterval, inInterval
                             , shiftLeft'

                             , asProperInterval, flipInterval

                             , module Data.Range
                             ) where

import           Control.DeepSeq
import           Control.Lens (Iso', Lens', iso, (%~), (&), (^.))
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Boundary
import           Data.Geometry.Properties
import           Data.Range
import           Data.Semigroup (Arg (..))
import qualified Data.Traversable as T
import           Data.Vinyl
import           Data.Vinyl.CoRec
import           GHC.Generics (Generic)
import           Test.QuickCheck

--------------------------------------------------------------------------------

-- | An Interval is essentially a 'Data.Range' but with possible payload
--
-- We can think of an interval being defined as:
--
-- >>> data Interval a r = Interval (EndPoint (r :+ a)) (EndPoint (r :+ a))
newtype Interval a r = GInterval (Range (r :+ a))
                     deriving (Interval a r -> Interval a r -> Bool
(Interval a r -> Interval a r -> Bool)
-> (Interval a r -> Interval a r -> Bool) -> Eq (Interval a r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a r. (Eq r, Eq a) => Interval a r -> Interval a r -> Bool
/= :: Interval a r -> Interval a r -> Bool
$c/= :: forall a r. (Eq r, Eq a) => Interval a r -> Interval a r -> Bool
== :: Interval a r -> Interval a r -> Bool
$c== :: forall a r. (Eq r, Eq a) => Interval a r -> Interval a r -> Bool
Eq,(forall x. Interval a r -> Rep (Interval a r) x)
-> (forall x. Rep (Interval a r) x -> Interval a r)
-> Generic (Interval a r)
forall x. Rep (Interval a r) x -> Interval a r
forall x. Interval a r -> Rep (Interval a r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a r x. Rep (Interval a r) x -> Interval a r
forall a r x. Interval a r -> Rep (Interval a r) x
$cto :: forall a r x. Rep (Interval a r) x -> Interval a r
$cfrom :: forall a r x. Interval a r -> Rep (Interval a r) x
Generic,Gen (Interval a r)
Gen (Interval a r)
-> (Interval a r -> [Interval a r]) -> Arbitrary (Interval a r)
Interval a r -> [Interval a r]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall a r.
(Arbitrary r, Arbitrary a, Ord r, Ord a) =>
Gen (Interval a r)
forall a r.
(Arbitrary r, Arbitrary a, Ord r, Ord a) =>
Interval a r -> [Interval a r]
shrink :: Interval a r -> [Interval a r]
$cshrink :: forall a r.
(Arbitrary r, Arbitrary a, Ord r, Ord a) =>
Interval a r -> [Interval a r]
arbitrary :: Gen (Interval a r)
$carbitrary :: forall a r.
(Arbitrary r, Arbitrary a, Ord r, Ord a) =>
Gen (Interval a r)
Arbitrary)

-- | Cast an interval to a range.
toRange :: Interval a r -> Range (r :+ a)
toRange :: Interval a r -> Range (r :+ a)
toRange (GInterval Range (r :+ a)
r) = Range (r :+ a)
r

-- | Intervals and ranges are isomorphic.
_Range :: Iso' (Interval a r) (Range (r :+ a))
_Range :: p (Range (r :+ a)) (f (Range (r :+ a)))
-> p (Interval a r) (f (Interval a r))
_Range = (Interval a r -> Range (r :+ a))
-> (Range (r :+ a) -> Interval a r)
-> Iso
     (Interval a r) (Interval a r) (Range (r :+ a)) (Range (r :+ a))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Interval a r -> Range (r :+ a)
forall a r. Interval a r -> Range (r :+ a)
toRange Range (r :+ a) -> Interval a r
forall r a. Range (r :+ a) -> Interval a r
fromRange
{-# INLINE _Range #-}

-- | Constrct an interval from a Range
fromRange :: Range (r :+ a) -> Interval a r
fromRange :: Range (r :+ a) -> Interval a r
fromRange = Range (r :+ a) -> Interval a r
forall a r. Range (r :+ a) -> Interval a r
GInterval

deriving instance (NFData a, NFData r) => NFData (Interval a r)

instance (Show a, Show r) => Show (Interval a r) where
  show :: Interval a r -> String
show ~(Interval EndPoint (r :+ a)
l EndPoint (r :+ a)
u) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Interval (", EndPoint (r :+ a) -> String
forall a. Show a => a -> String
show EndPoint (r :+ a)
l, String
") (", EndPoint (r :+ a) -> String
forall a. Show a => a -> String
show EndPoint (r :+ a)
u,String
")"]

instance Functor (Interval a) where
  fmap :: (a -> b) -> Interval a a -> Interval a b
fmap a -> b
f (GInterval Range (a :+ a)
r) = Range (b :+ a) -> Interval a b
forall a r. Range (r :+ a) -> Interval a r
GInterval (Range (b :+ a) -> Interval a b) -> Range (b :+ a) -> Interval a b
forall a b. (a -> b) -> a -> b
$ ((a :+ a) -> b :+ a) -> Range (a :+ a) -> Range (b :+ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a :+ a) -> b :+ a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) Range (a :+ a)
r

instance F.Foldable (Interval a) where
  foldMap :: (a -> m) -> Interval a a -> m
foldMap a -> m
f (GInterval Range (a :+ a)
r) = ((a :+ a) -> m) -> Range (a :+ a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((a :+ a) -> a) -> (a :+ a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a :+ a) -> Getting a (a :+ a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (a :+ a) a
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)) Range (a :+ a)
r

instance T.Traversable (Interval a) where
  traverse :: (a -> f b) -> Interval a a -> f (Interval a b)
traverse a -> f b
f (GInterval Range (a :+ a)
r) = Range (b :+ a) -> Interval a b
forall a r. Range (r :+ a) -> Interval a r
GInterval (Range (b :+ a) -> Interval a b)
-> f (Range (b :+ a)) -> f (Interval a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a :+ a) -> f (b :+ a)) -> Range (a :+ a) -> f (Range (b :+ a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (a :+ a) -> f (b :+ a)
f' Range (a :+ a)
r
    where
      f' :: (a :+ a) -> f (b :+ a)
f' = (a -> f b) -> (a -> f a) -> (a :+ a) -> f (b :+ a)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Bifunctor Interval where
  bimap :: (a -> b) -> (c -> d) -> Interval a c -> Interval b d
bimap a -> b
f c -> d
g (GInterval Range (c :+ a)
r) = Range (d :+ b) -> Interval b d
forall a r. Range (r :+ a) -> Interval a r
GInterval (Range (d :+ b) -> Interval b d) -> Range (d :+ b) -> Interval b d
forall a b. (a -> b) -> a -> b
$ ((c :+ a) -> d :+ b) -> Range (c :+ a) -> Range (d :+ b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (a -> b) -> (c :+ a) -> d :+ b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap c -> d
g a -> b
f) Range (c :+ a)
r


-- type instance IntersectionOf r (Interval b r) = [NoIntersection, r]
-- -- somehow: GHC does not understand the r here cannot be 'Interval a r' itself :(

-- instance Ord r => r `HasIntersectionWith` Interval b r where
--   x `intersects` r = x `inRange` fmap (^.core) (r^._Range )


-- instance Ord r => r `IsIntersectableWith` Interval b r where
--   x `intersect` r | x `intersects` r = coRec x
--                   | otherwise        = coRec NoIntersection

-- | Test if a value lies in an interval. Note that the difference between
--  inInterval and inRange is that the extra value is *not* used in the
--  comparison with inInterval, whereas it is in inRange.
intersectsInterval       :: Ord r => r -> Interval a r -> Bool
r
x intersectsInterval :: r -> Interval a r -> Bool
`intersectsInterval` Interval a r
r = r
x r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` ((r :+ a) -> r) -> Range (r :+ a) -> Range r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r :+ a) -> Getting r (r :+ a) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (r :+ a) r
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Interval a r
rInterval a r
-> Getting (Range (r :+ a)) (Interval a r) (Range (r :+ a))
-> Range (r :+ a)
forall s a. s -> Getting a s a -> a
^.Getting (Range (r :+ a)) (Interval a r) (Range (r :+ a))
forall a r. Iso' (Interval a r) (Range (r :+ a))
_Range )


-- | Compute where the given query value is with respect to the interval.
--
-- Note that even if the boundary of the interval is open we may
-- return "OnBoundary".
inInterval :: Ord r => r -> Interval a r -> PointLocationResult
r
x inInterval :: r -> Interval a r -> PointLocationResult
`inInterval` (Interval EndPoint (r :+ a)
l EndPoint (r :+ a)
r) =
  case r
x r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (EndPoint (r :+ a)
lEndPoint (r :+ a) -> Getting r (EndPoint (r :+ a)) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> EndPoint (r :+ a) -> Const r (EndPoint (r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ a) -> Const r (r :+ a))
 -> EndPoint (r :+ a) -> Const r (EndPoint (r :+ a)))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (EndPoint (r :+ a)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
    Ordering
LT -> PointLocationResult
Outside
    Ordering
EQ -> PointLocationResult
OnBoundary
    Ordering
GT -> case r
x r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (EndPoint (r :+ a)
rEndPoint (r :+ a) -> Getting r (EndPoint (r :+ a)) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> EndPoint (r :+ a) -> Const r (EndPoint (r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ a) -> Const r (r :+ a))
 -> EndPoint (r :+ a) -> Const r (EndPoint (r :+ a)))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (EndPoint (r :+ a)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
            Ordering
LT -> PointLocationResult
Inside
            Ordering
EQ -> PointLocationResult
OnBoundary
            Ordering
GT -> PointLocationResult
Outside


pattern OpenInterval       :: (r :+ a) -> (r :+ a) -> Interval a r
pattern $bOpenInterval :: (r :+ a) -> (r :+ a) -> Interval a r
$mOpenInterval :: forall r r a.
Interval a r -> ((r :+ a) -> (r :+ a) -> r) -> (Void# -> r) -> r
OpenInterval   l u = GInterval (OpenRange   l u)

pattern ClosedInterval     :: (r :+ a) -> (r :+ a) -> Interval a r
pattern $bClosedInterval :: (r :+ a) -> (r :+ a) -> Interval a r
$mClosedInterval :: forall r r a.
Interval a r -> ((r :+ a) -> (r :+ a) -> r) -> (Void# -> r) -> r
ClosedInterval l u = GInterval (ClosedRange l u)


pattern Interval     :: EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
pattern $bInterval :: EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
$mInterval :: forall r r a.
Interval a r
-> (EndPoint (r :+ a) -> EndPoint (r :+ a) -> r)
-> (Void# -> r)
-> r
Interval l u = GInterval (Range l u)
{-# COMPLETE Interval #-}

--------------------------------------------------------------------------------

class HasStart t where
  type StartCore t
  type StartExtra t
  start :: Lens' t (StartCore t :+ StartExtra t)

instance HasStart (Interval a r) where
  type StartCore (Interval a r) = r
  type StartExtra (Interval a r) = a
  start :: ((StartCore (Interval a r) :+ StartExtra (Interval a r))
 -> f (StartCore (Interval a r) :+ StartExtra (Interval a r)))
-> Interval a r -> f (Interval a r)
start = (Range (r :+ a) -> f (Range (r :+ a)))
-> Interval a r -> f (Interval a r)
forall a r. Iso' (Interval a r) (Range (r :+ a))
_Range((Range (r :+ a) -> f (Range (r :+ a)))
 -> Interval a r -> f (Interval a r))
-> (((r :+ a) -> f (r :+ a))
    -> Range (r :+ a) -> f (Range (r :+ a)))
-> ((r :+ a) -> f (r :+ a))
-> Interval a r
-> f (Interval a r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
-> Range (r :+ a) -> f (Range (r :+ a))
forall a. Lens' (Range a) (EndPoint a)
lower((EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
 -> Range (r :+ a) -> f (Range (r :+ a)))
-> (((r :+ a) -> f (r :+ a))
    -> EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
-> ((r :+ a) -> f (r :+ a))
-> Range (r :+ a)
-> f (Range (r :+ a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((r :+ a) -> f (r :+ a))
-> EndPoint (r :+ a) -> f (EndPoint (r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint
  {-# INLINE start #-}

class HasEnd t where
  type EndCore t
  type EndExtra t
  end :: Lens' t (EndCore t :+ EndExtra t)

instance HasEnd (Interval a r) where
  type EndCore (Interval a r) = r
  type EndExtra (Interval a r) = a
  end :: ((EndCore (Interval a r) :+ EndExtra (Interval a r))
 -> f (EndCore (Interval a r) :+ EndExtra (Interval a r)))
-> Interval a r -> f (Interval a r)
end = (Range (r :+ a) -> f (Range (r :+ a)))
-> Interval a r -> f (Interval a r)
forall a r. Iso' (Interval a r) (Range (r :+ a))
_Range((Range (r :+ a) -> f (Range (r :+ a)))
 -> Interval a r -> f (Interval a r))
-> (((r :+ a) -> f (r :+ a))
    -> Range (r :+ a) -> f (Range (r :+ a)))
-> ((r :+ a) -> f (r :+ a))
-> Interval a r
-> f (Interval a r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
-> Range (r :+ a) -> f (Range (r :+ a))
forall a. Lens' (Range a) (EndPoint a)
upper((EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
 -> Range (r :+ a) -> f (Range (r :+ a)))
-> (((r :+ a) -> f (r :+ a))
    -> EndPoint (r :+ a) -> f (EndPoint (r :+ a)))
-> ((r :+ a) -> f (r :+ a))
-> Range (r :+ a)
-> f (Range (r :+ a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((r :+ a) -> f (r :+ a))
-> EndPoint (r :+ a) -> f (EndPoint (r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint
  {-# INLINE end #-}

type instance Dimension (Interval a r) = 1
type instance NumType   (Interval a r) = r


type instance IntersectionOf (Interval a r) (Interval b r)
  = [NoIntersection, Interval (Either a b) r]

instance Ord r => Interval a r `HasIntersectionWith` Interval b r
instance Ord r => Interval a r `IsIntersectableWith` Interval b r where

  nonEmptyIntersection :: proxy (Interval a r)
-> proxy (Interval b r)
-> Intersection (Interval a r) (Interval b r)
-> Bool
nonEmptyIntersection = proxy (Interval a r)
-> proxy (Interval b r)
-> Intersection (Interval a r) (Interval b r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  (GInterval Range (r :+ a)
r) intersect :: Interval a r
-> Interval b r -> Intersection (Interval a r) (Interval b r)
`intersect` (GInterval Range (r :+ b)
s) = CoRec Identity '[NoIntersection, Range (Arg r (r :+ Either a b))]
-> Handlers
     '[NoIntersection, Range (Arg r (r :+ Either a b))]
     (CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Range (Arg r (r :+ Either a b))
r' Range (Arg r (r :+ Either a b))
-> Range (Arg r (r :+ Either a b))
-> Intersection
     (Range (Arg r (r :+ Either a b))) (Range (Arg r (r :+ Either a b)))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Range (Arg r (r :+ Either a b))
s') (Handlers
   '[NoIntersection, Range (Arg r (r :+ Either a b))]
   (CoRec Identity '[NoIntersection, Interval (Either a b) r])
 -> CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> Handlers
     '[NoIntersection, Range (Arg r (r :+ Either a b))]
     (CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall a b. (a -> b) -> a -> b
$
         (NoIntersection
 -> CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> Handler
     (CoRec Identity '[NoIntersection, Interval (Either a b) r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec Identity '[NoIntersection, Interval (Either a b) r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Interval (Either a b) r]))
     '[Range (Arg r (r :+ Either a b))]
-> Handlers
     '[NoIntersection, Range (Arg r (r :+ Either a b))]
     (CoRec Identity '[NoIntersection, Interval (Either a b) r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Range (Arg r (r :+ Either a b))
 -> CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> Handler
     (CoRec Identity '[NoIntersection, Interval (Either a b) r])
     (Range (Arg r (r :+ Either a b)))
forall b a. (a -> b) -> Handler b a
H (\(Range EndPoint (Arg r (r :+ Either a b))
l EndPoint (Arg r (r :+ Either a b))
u)    -> Interval (Either a b) r
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Interval (Either a b) r
 -> CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> (Range (r :+ Either a b) -> Interval (Either a b) r)
-> Range (r :+ Either a b)
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range (r :+ Either a b) -> Interval (Either a b) r
forall a r. Range (r :+ a) -> Interval a r
GInterval (Range (r :+ Either a b)
 -> CoRec Identity '[NoIntersection, Interval (Either a b) r])
-> Range (r :+ Either a b)
-> CoRec Identity '[NoIntersection, Interval (Either a b) r]
forall a b. (a -> b) -> a -> b
$ EndPoint (r :+ Either a b)
-> EndPoint (r :+ Either a b) -> Range (r :+ Either a b)
forall a. EndPoint a -> EndPoint a -> Range a
Range (EndPoint (Arg r (r :+ Either a b))
lEndPoint (Arg r (r :+ Either a b))
-> (EndPoint (Arg r (r :+ Either a b))
    -> EndPoint (r :+ Either a b))
-> EndPoint (r :+ Either a b)
forall a b. a -> (a -> b) -> b
&(Arg r (r :+ Either a b) -> Identity (r :+ Either a b))
-> EndPoint (Arg r (r :+ Either a b))
-> Identity (EndPoint (r :+ Either a b))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint ((Arg r (r :+ Either a b) -> Identity (r :+ Either a b))
 -> EndPoint (Arg r (r :+ Either a b))
 -> Identity (EndPoint (r :+ Either a b)))
-> (Arg r (r :+ Either a b) -> r :+ Either a b)
-> EndPoint (Arg r (r :+ Either a b))
-> EndPoint (r :+ Either a b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Arg r (r :+ Either a b) -> r :+ Either a b
forall a b. Arg a b -> b
g)
                                                         (EndPoint (Arg r (r :+ Either a b))
uEndPoint (Arg r (r :+ Either a b))
-> (EndPoint (Arg r (r :+ Either a b))
    -> EndPoint (r :+ Either a b))
-> EndPoint (r :+ Either a b)
forall a b. a -> (a -> b) -> b
&(Arg r (r :+ Either a b) -> Identity (r :+ Either a b))
-> EndPoint (Arg r (r :+ Either a b))
-> Identity (EndPoint (r :+ Either a b))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint ((Arg r (r :+ Either a b) -> Identity (r :+ Either a b))
 -> EndPoint (Arg r (r :+ Either a b))
 -> Identity (EndPoint (r :+ Either a b)))
-> (Arg r (r :+ Either a b) -> r :+ Either a b)
-> EndPoint (Arg r (r :+ Either a b))
-> EndPoint (r :+ Either a b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Arg r (r :+ Either a b) -> r :+ Either a b
forall a b. Arg a b -> b
g) )
      Handler
  (CoRec Identity '[NoIntersection, Interval (Either a b) r])
  (Range (Arg r (r :+ Either a b)))
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Interval (Either a b) r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Interval (Either a b) r]))
     '[Range (Arg r (r :+ Either a b))]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Interval (Either a b) r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      r' :: Range (Arg r (r :+ Either a b))
      r' :: Range (Arg r (r :+ Either a b))
r' = ((r :+ a) -> Arg r (r :+ Either a b))
-> Range (r :+ a) -> Range (Arg r (r :+ Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(r
x :+ a
a) -> r -> (r :+ Either a b) -> Arg r (r :+ Either a b)
forall a b. a -> b -> Arg a b
Arg r
x (r
x r -> Either a b -> r :+ Either a b
forall core extra. core -> extra -> core :+ extra
:+ a -> Either a b
forall a b. a -> Either a b
Left a
a))  Range (r :+ a)
r
      s' :: Range (Arg r (r :+ Either a b))
      s' :: Range (Arg r (r :+ Either a b))
s' = ((r :+ b) -> Arg r (r :+ Either a b))
-> Range (r :+ b) -> Range (Arg r (r :+ Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(r
x :+ b
b) -> r -> (r :+ Either a b) -> Arg r (r :+ Either a b)
forall a b. a -> b -> Arg a b
Arg r
x (r
x r -> Either a b -> r :+ Either a b
forall core extra. core -> extra -> core :+ extra
:+ b -> Either a b
forall a b. b -> Either a b
Right b
b)) Range (r :+ b)
s

      g :: Arg a b -> b
g (Arg a
_ b
x) = b
x

-- | Shifts the interval to the left by delta
shiftLeft'       :: Num r => r -> Interval a r -> Interval a r
shiftLeft' :: r -> Interval a r -> Interval a r
shiftLeft' r
delta = (r -> r) -> Interval a r -> Interval a r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (r -> r -> r
forall a. Num a => a -> a -> a
subtract r
delta)


-- | Makes sure the start and endpoint are oriented such that the
-- starting value is smaller than the ending value.
asProperInterval                                     :: Ord r => Interval p r -> Interval p r
asProperInterval :: Interval p r -> Interval p r
asProperInterval Interval p r
i | (Interval p r
iInterval p r -> Getting r (Interval p r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ p) -> Const r (r :+ p))
-> Interval p r -> Const r (Interval p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ p) -> Const r (r :+ p))
 -> Interval p r -> Const r (Interval p r))
-> ((r -> Const r r) -> (r :+ p) -> Const r (r :+ p))
-> Getting r (Interval p r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ p) -> Const r (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> (Interval p r
iInterval p r -> Getting r (Interval p r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ p) -> Const r (r :+ p))
-> Interval p r -> Const r (Interval p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ p) -> Const r (r :+ p))
 -> Interval p r -> Const r (Interval p r))
-> ((r -> Const r r) -> (r :+ p) -> Const r (r :+ p))
-> Getting r (Interval p r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ p) -> Const r (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) = Interval p r -> Interval p r
forall a r. Interval a r -> Interval a r
flipInterval Interval p r
i
                   | Bool
otherwise                       = Interval p r
i

-- | Flips the start and endpoint of the interval.
flipInterval :: Interval a r -> Interval a r
flipInterval :: Interval a r -> Interval a r
flipInterval = (Range (r :+ a) -> Identity (Range (r :+ a)))
-> Interval a r -> Identity (Interval a r)
forall a r. Iso' (Interval a r) (Range (r :+ a))
_Range ((Range (r :+ a) -> Identity (Range (r :+ a)))
 -> Interval a r -> Identity (Interval a r))
-> (Range (r :+ a) -> Range (r :+ a))
-> Interval a r
-> Interval a r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(Range EndPoint (r :+ a)
s EndPoint (r :+ a)
t) -> EndPoint (r :+ a) -> EndPoint (r :+ a) -> Range (r :+ a)
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint (r :+ a)
t EndPoint (r :+ a)
s