--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Interval.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Intervals
--
--------------------------------------------------------------------------------
{-# LANGUAGE UndecidableInstances #-}
module HGeometry.Interval.Class
  ( Interval_
  , pattern Interval_
  , IntervalLike_
  , ConstructableInterval_(..)

  , ClosedInterval_
  , pattern ClosedInterval_
  , ConstructableClosedInterval_(..)
  , clampTo

  , OpenInterval_
  , pattern OpenInterval_
  , ConstructableOpenInterval_(..)

  , HasStart(..)
  , HasEnd(..)
  , startAndEnd

  , StartPointOf
  , EndPointOf
  , HasStartPoint(..)
  , HasEndPoint(..)
  , startAndEndPoint


  , inInterval, stabsInterval
  , compareInterval
  , compareIntervalExact
  , CompareInterval(..)

  , shiftLeft, shiftRight
  -- , flipInterval
  , duration
  , module HGeometry.Interval.EndPoint
  ) where

import Control.Lens
import Data.Default
import Data.Kind (Type,Constraint)
import HGeometry.Boundary
import HGeometry.Ext
import HGeometry.Interval.EndPoint
import HGeometry.Properties
import HGeometry.ByIndex

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

-- $setup
-- >>> import HGeometry.Interval.EndPoint
-- >>> import HGeometry.Interval

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

-- | Things that have a start point
class HasStart seg p | seg -> p where
  -- | Lens to access the start point
  start :: Lens' seg p

-- | Things that have an end point
class HasEnd seg p | seg -> p where
  -- | Lens to access the ending point
  end :: Lens' seg p

-- | Get both the start and end of something that has a start and end.
startAndEnd   :: (HasStart seg p, HasEnd seg p) => seg -> (p,p)
startAndEnd :: forall seg p. (HasStart seg p, HasEnd seg p) => seg -> (p, p)
startAndEnd seg
i = (seg
iseg -> Getting p seg p -> p
forall s a. s -> Getting a s a -> a
^.Getting p seg p
forall seg p. HasStart seg p => Lens' seg p
Lens' seg p
start,seg
iseg -> Getting p seg p -> p
forall s a. s -> Getting a s a -> a
^.Getting p seg p
forall seg p. HasEnd seg p => Lens' seg p
Lens' seg p
end)

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

-- | Things that have a start point
class HasStartPoint seg p | seg -> p where
  -- | Lens to access the start point
  startPoint :: Lens' seg p

-- | Things that have an end point
class HasEndPoint seg p | seg -> p where
  -- | Lens to access the ending point
  endPoint :: Lens' seg p

-- | Get both the start and end of something that has a start and end.
startAndEndPoint   :: (HasStartPoint seg s, HasEndPoint seg e) => seg -> (s,e)
startAndEndPoint :: forall seg s e.
(HasStartPoint seg s, HasEndPoint seg e) =>
seg -> (s, e)
startAndEndPoint seg
i = (seg
iseg -> Getting s seg s -> s
forall s a. s -> Getting a s a -> a
^.Getting s seg s
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' seg s
startPoint, seg
iseg -> Getting e seg e -> e
forall s a. s -> Getting a s a -> a
^.Getting e seg e
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' seg e
endPoint)

-- | type family to declare the type of startpoint for an interval, the
-- idea is to define this as one of the endpoinst form the Endpoints module
type family StartPointOf interval

-- | type family to declare the type of endpoint for an interval, the
-- idea is to define this as one of the endpoinst form the Endpoints module
type family EndPointOf interval

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

-- | A class for types representing interval like objects
type IntervalLike_ :: Type -> Type -> Constraint
class ( HasStart interval point, HasStartPoint interval (StartPointOf interval)
      , HasEnd   interval point, HasEndPoint   interval (EndPointOf interval)
      , EndPoint_ (EndPointOf interval), IxValue (EndPointOf interval) ~ point
      , EndPoint_ (StartPointOf interval), IxValue (StartPointOf interval) ~ point
      ) => IntervalLike_ interval point | interval -> point where
  {-# MINIMAL  #-}

-- | A class for types representing Intervals
type Interval_ :: Type -> Type -> Constraint
class ( IntervalLike_ interval r
      , NumType interval ~ r
      ) => Interval_ interval r | interval -> r where

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

-- | A class for constructable intervals
type ConstructableInterval_ :: Type -> Type -> Constraint
class  Interval_ interval point => ConstructableInterval_ interval point where
  {-# MINIMAL mkInterval #-}

  -- | Construct an interval given its start and end point.
  --
  -- pre: start < end
  mkInterval :: StartPointOf interval -> EndPointOf interval -> interval

  -- | Construct an interval given two points. This makes sure
  -- the start-point comes before the endpoint.
  --
  -- pre: it is possible to construct a valid, non-empty interval this way.
  --      so if either endpoint is open the endpoints should not coincide.
  buildInterval :: ( Ord point
                   , StartPointOf interval ~ EndPointOf interval
                   ) => StartPointOf interval -> EndPointOf interval -> interval
  buildInterval StartPointOf interval
a EndPointOf interval
b
    | (EndPointOf interval
StartPointOf interval
aEndPointOf interval
-> Getting point (EndPointOf interval) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (EndPointOf interval) point
(IxValue (EndPointOf interval)
 -> Const point (IxValue (EndPointOf interval)))
-> EndPointOf interval -> Const point (EndPointOf interval)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (EndPointOf interval)
  (EndPointOf interval)
  (IxValue (EndPointOf interval))
  (IxValue (EndPointOf interval))
_endPoint) point -> point -> Bool
forall a. Ord a => a -> a -> Bool
<= (EndPointOf interval
bEndPointOf interval
-> Getting point (EndPointOf interval) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (EndPointOf interval) point
(IxValue (EndPointOf interval)
 -> Const point (IxValue (EndPointOf interval)))
-> EndPointOf interval -> Const point (EndPointOf interval)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (EndPointOf interval)
  (EndPointOf interval)
  (IxValue (EndPointOf interval))
  (IxValue (EndPointOf interval))
_endPoint) = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval StartPointOf interval
a EndPointOf interval
b
    | Bool
otherwise                        = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval EndPointOf interval
StartPointOf interval
b EndPointOf interval
StartPointOf interval
a
  {-# INLINE buildInterval #-}


--------------------------------------------------------------------------------
-- * Closed Intervals

-- | A class representing closed intervals, i.e. intervals that include their endpoints
type ClosedInterval_ :: Type -> Type -> Constraint
class ( Interval_ interval r
      , StartPointOf interval ~ EndPoint Closed r
      , EndPointOf interval ~ EndPoint Closed r
      ) => ClosedInterval_ interval r where

-- | A class representing constructable closed intervals
class ( ClosedInterval_ interval r
      , ConstructableInterval_ interval r
      ) => ConstructableClosedInterval_ interval r where

  -- | Construct an interval given its start and end point.
  mkClosedInterval     :: r -> r -> interval
  mkClosedInterval r
s r
e = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval (r -> EndPoint 'Closed r
forall r. r -> EndPoint 'Closed r
ClosedE r
s) (r -> EndPoint 'Closed r
forall r. r -> EndPoint 'Closed r
ClosedE r
e)
  {-# MINIMAL #-}

  -- | Construct an interval given two points. This makes sure
  -- the start-point comes before the endpoint.
  buildClosedInterval     :: Ord r => r -> r -> interval
  buildClosedInterval r
a r
b = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
(ConstructableInterval_ interval point, Ord point,
 StartPointOf interval ~ EndPointOf interval) =>
StartPointOf interval -> EndPointOf interval -> interval
buildInterval (r -> EndPoint 'Closed r
forall r. r -> EndPoint 'Closed r
ClosedE r
a) (r -> EndPoint 'Closed r
forall r. r -> EndPoint 'Closed r
ClosedE r
b)
  {-# INLINE buildClosedInterval #-}


-- | Pattern matching on an arbitrary closed interval
pattern ClosedInterval_     :: ClosedInterval_ interval r => r -> r -> interval
pattern $mClosedInterval_ :: forall {r} {interval} {r}.
ClosedInterval_ interval r =>
interval -> (r -> r -> r) -> ((# #) -> r) -> r
ClosedInterval_ l u <- (startAndEnd -> (l,u))
{-# COMPLETE ClosedInterval_ #-}
--   where
--     ClosedInterval_ l u = mkClosedInterval l u
-- {-# INLINE ClosedInterval_ #-}

-- | Clamps a value to an interval. I.e. if the value lies outside the range we
-- report the closest value "in the range".
--
-- >>> clampTo (ClosedInterval 0 10) 20
-- 10
-- >>> clampTo (ClosedInterval 0 10) (-20)
-- 0
-- >>> clampTo (ClosedInterval 0 10) 5
-- 5
clampTo                         :: (ClosedInterval_ interval r, Ord r) => interval -> r -> r
clampTo :: forall interval r.
(ClosedInterval_ interval r, Ord r) =>
interval -> r -> r
clampTo (ClosedInterval_ r
l r
u) r
x = (r
x r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
l) r -> r -> r
forall a. Ord a => a -> a -> a
`min` r
u

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


-- | A class representing open intervals, i.e. intervals that exclude their endpoints
class ( Interval_ interval r
      , StartPointOf interval ~ EndPoint Open r
      , EndPointOf interval ~ EndPoint Open r
      ) => OpenInterval_ interval r | interval -> r where

-- | Constructable Open intervals
class ( OpenInterval_ interval r
      , ConstructableInterval_ interval r
      ) => ConstructableOpenInterval_ interval r | interval -> r where
  -- | Construct an interval given its start s and end point t.
  --
  -- pre: s < t
  mkOpenInterval     :: r -> r -> interval
  mkOpenInterval r
s r
e = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval (r -> EndPoint 'Open r
forall r. r -> EndPoint 'Open r
OpenE r
s) (r -> EndPoint 'Open r
forall r. r -> EndPoint 'Open r
OpenE r
e)
  {-# MINIMAL #-}

-- | Pattern matching on an arbitrary open interval
pattern OpenInterval_     :: OpenInterval_ interval r => r -> r -> interval
pattern $mOpenInterval_ :: forall {r} {interval} {r}.
OpenInterval_ interval r =>
interval -> (r -> r -> r) -> ((# #) -> r) -> r
OpenInterval_ l u <- (startAndEnd -> (l,u))
  -- where
  --   OpenInterval_ l u = mkOpenInterval l u
{-# COMPLETE OpenInterval_ #-}

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

-- | Pattern to match on intervals
pattern Interval_     :: Interval_ interval r
                      => StartPointOf interval -> EndPointOf interval -> interval
pattern $mInterval_ :: forall {r} {interval} {r}.
Interval_ interval r =>
interval
-> (StartPointOf interval -> EndPointOf interval -> r)
-> ((# #) -> r)
-> r
Interval_ s t <- (startAndEndPoint -> (s,t))
{-# COMPLETE Interval_ #-}
  -- where
  --   Interval_ s t = mkInterval s t


-- | 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       :: forall interval r.
                    ( Ord r
                    , Interval_ interval r
                    )
                 => r -> interval -> PointLocationResult
r
x inInterval :: forall interval r.
(Ord r, Interval_ interval r) =>
r -> interval -> PointLocationResult
`inInterval` interval
i =
    case r
x r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start) 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` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end) of
              Ordering
LT -> PointLocationResult
Inside
              Ordering
EQ -> PointLocationResult
OnBoundary
              Ordering
GT -> PointLocationResult
Outside

-- | Test if the point lies inside in,or on the boundary of, the
-- interval.
--
-- Note that even if the boundary of the interval is open we may
-- return "OnBoundary".
stabsInterval       :: forall interval r.
                       ( Ord r
                       , Interval_ interval r
                       )
                    => r -> interval -> Bool
r
q stabsInterval :: forall interval r.
(Ord r, Interval_ interval r) =>
r -> interval -> Bool
`stabsInterval` interval
i = r
q r -> interval -> PointLocationResult
forall interval r.
(Ord r, Interval_ interval r) =>
r -> interval -> PointLocationResult
`inInterval` interval
i PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResult
Outside

-- | test if te point appears before (=LT), in (=EQ), or after (=GT) te interval.
--
-- >>> 1 `compareInterval` (OpenInterval 0 2)
-- EQ
-- >>> 1 `compareInterval` (OpenInterval 0 1)
-- GT
-- >>> 1 `compareInterval` (ClosedInterval 0 1)
-- EQ
-- >>> 10 `compareInterval` (OpenInterval 1 10)
-- GT
-- >>> 10 `compareInterval` (ClosedInterval 0 1)
-- GT
compareInterval     :: (Ord r, Interval_ interval r) => r -> interval -> Ordering
compareInterval :: forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
compareInterval r
q interval
i = case r
q r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start) of
      Ordering
LT -> Ordering
LT
      Ordering
EQ -> if interval
iinterval
-> Getting EndPointType interval EndPointType -> EndPointType
forall s a. s -> Getting a s a -> a
^.(StartPointOf interval
 -> Const EndPointType (StartPointOf interval))
-> interval -> Const EndPointType interval
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' interval (StartPointOf interval)
startPoint((StartPointOf interval
  -> Const EndPointType (StartPointOf interval))
 -> interval -> Const EndPointType interval)
-> ((EndPointType -> Const EndPointType EndPointType)
    -> StartPointOf interval
    -> Const EndPointType (StartPointOf interval))
-> Getting EndPointType interval EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StartPointOf interval -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> StartPointOf interval
-> Const EndPointType (StartPointOf interval)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to StartPointOf interval -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Open then Ordering
LT else Ordering
EQ
            -- since the interval is non-degenerate, the right endpoint must be strictly
            -- larger than the left endpoint
      Ordering
GT -> case r
q r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end) of
              Ordering
LT -> Ordering
EQ
              Ordering
EQ -> if interval
iinterval
-> Getting EndPointType interval EndPointType -> EndPointType
forall s a. s -> Getting a s a -> a
^.(EndPointOf interval -> Const EndPointType (EndPointOf interval))
-> interval -> Const EndPointType interval
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' interval (EndPointOf interval)
endPoint((EndPointOf interval -> Const EndPointType (EndPointOf interval))
 -> interval -> Const EndPointType interval)
-> ((EndPointType -> Const EndPointType EndPointType)
    -> EndPointOf interval -> Const EndPointType (EndPointOf interval))
-> Getting EndPointType interval EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPointOf interval -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> EndPointOf interval
-> Const EndPointType (EndPointOf interval)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EndPointOf interval -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Open then Ordering
GT else Ordering
EQ
              Ordering
GT -> Ordering
GT

-- | test if te point appears before, in, or after te interval, or on one of its
-- endpoints.
--
-- >>> 1 `compareIntervalExact` (OpenInterval 0 2)
-- Interior
-- >>> 1 `compareIntervalExact` (OpenInterval 0 1)
-- OnEnd
-- >>> 1 `compareIntervalExact` (ClosedInterval 0 1)
-- OnEnd
-- >>> 10 `compareIntervalExact` (OpenInterval 1 10)
-- OnEnd
-- >>> 10 `compareIntervalExact` (ClosedInterval 0 1)
-- After
compareIntervalExact     :: (Ord r, Interval_ interval r) => r -> interval -> CompareInterval
compareIntervalExact :: forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
compareIntervalExact r
q interval
i = case r
q r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start) of
      Ordering
LT -> CompareInterval
Before
      Ordering
EQ -> CompareInterval
OnStart
      Ordering
GT -> case r
q r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end) of
              Ordering
LT -> CompareInterval
Interior
              Ordering
EQ -> CompareInterval
OnEnd
              Ordering
GT -> CompareInterval
After

-- | Data type to represent the result of where a point is with respect to an interval.
data CompareInterval = Before | OnStart | Interior | OnEnd | After
  deriving (Int -> CompareInterval -> ShowS
[CompareInterval] -> ShowS
CompareInterval -> String
(Int -> CompareInterval -> ShowS)
-> (CompareInterval -> String)
-> ([CompareInterval] -> ShowS)
-> Show CompareInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompareInterval -> ShowS
showsPrec :: Int -> CompareInterval -> ShowS
$cshow :: CompareInterval -> String
show :: CompareInterval -> String
$cshowList :: [CompareInterval] -> ShowS
showList :: [CompareInterval] -> ShowS
Show,ReadPrec [CompareInterval]
ReadPrec CompareInterval
Int -> ReadS CompareInterval
ReadS [CompareInterval]
(Int -> ReadS CompareInterval)
-> ReadS [CompareInterval]
-> ReadPrec CompareInterval
-> ReadPrec [CompareInterval]
-> Read CompareInterval
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompareInterval
readsPrec :: Int -> ReadS CompareInterval
$creadList :: ReadS [CompareInterval]
readList :: ReadS [CompareInterval]
$creadPrec :: ReadPrec CompareInterval
readPrec :: ReadPrec CompareInterval
$creadListPrec :: ReadPrec [CompareInterval]
readListPrec :: ReadPrec [CompareInterval]
Read,CompareInterval -> CompareInterval -> Bool
(CompareInterval -> CompareInterval -> Bool)
-> (CompareInterval -> CompareInterval -> Bool)
-> Eq CompareInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompareInterval -> CompareInterval -> Bool
== :: CompareInterval -> CompareInterval -> Bool
$c/= :: CompareInterval -> CompareInterval -> Bool
/= :: CompareInterval -> CompareInterval -> Bool
Eq,Eq CompareInterval
Eq CompareInterval =>
(CompareInterval -> CompareInterval -> Ordering)
-> (CompareInterval -> CompareInterval -> Bool)
-> (CompareInterval -> CompareInterval -> Bool)
-> (CompareInterval -> CompareInterval -> Bool)
-> (CompareInterval -> CompareInterval -> Bool)
-> (CompareInterval -> CompareInterval -> CompareInterval)
-> (CompareInterval -> CompareInterval -> CompareInterval)
-> Ord CompareInterval
CompareInterval -> CompareInterval -> Bool
CompareInterval -> CompareInterval -> Ordering
CompareInterval -> CompareInterval -> CompareInterval
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
$ccompare :: CompareInterval -> CompareInterval -> Ordering
compare :: CompareInterval -> CompareInterval -> Ordering
$c< :: CompareInterval -> CompareInterval -> Bool
< :: CompareInterval -> CompareInterval -> Bool
$c<= :: CompareInterval -> CompareInterval -> Bool
<= :: CompareInterval -> CompareInterval -> Bool
$c> :: CompareInterval -> CompareInterval -> Bool
> :: CompareInterval -> CompareInterval -> Bool
$c>= :: CompareInterval -> CompareInterval -> Bool
>= :: CompareInterval -> CompareInterval -> Bool
$cmax :: CompareInterval -> CompareInterval -> CompareInterval
max :: CompareInterval -> CompareInterval -> CompareInterval
$cmin :: CompareInterval -> CompareInterval -> CompareInterval
min :: CompareInterval -> CompareInterval -> CompareInterval
Ord)

-- | Shifts the interval to the left by delta
shiftLeft         :: ( Num r, Interval_ interval r) => r -> interval -> interval
shiftLeft :: forall r interval.
(Num r, Interval_ interval r) =>
r -> interval -> interval
shiftLeft r
delta interval
i = interval
iinterval -> (interval -> interval) -> interval
forall a b. a -> (a -> b) -> b
&(r -> Identity r) -> interval -> Identity interval
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start ((r -> Identity r) -> interval -> Identity interval)
-> (r -> r) -> interval -> interval
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> r -> r
forall a. Num a => a -> a -> a
subtract r
delta
                     interval -> (interval -> interval) -> interval
forall a b. a -> (a -> b) -> b
&(r -> Identity r) -> interval -> Identity interval
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end   ((r -> Identity r) -> interval -> Identity interval)
-> (r -> r) -> interval -> interval
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> r -> r
forall a. Num a => a -> a -> a
subtract r
delta

-- | Shifts the interval to the right by delta
shiftRight         :: ( Num r, Interval_ interval r ) => r -> interval -> interval
shiftRight :: forall r interval.
(Num r, Interval_ interval r) =>
r -> interval -> interval
shiftRight r
delta interval
i = interval
iinterval -> (interval -> interval) -> interval
forall a b. a -> (a -> b) -> b
&(r -> Identity r) -> interval -> Identity interval
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start ((r -> Identity r) -> interval -> Identity interval)
-> (r -> r) -> interval -> interval
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (r -> r -> r
forall a. Num a => a -> a -> a
+ r
delta)
                      interval -> (interval -> interval) -> interval
forall a b. a -> (a -> b) -> b
&(r -> Identity r) -> interval -> Identity interval
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end   ((r -> Identity r) -> interval -> Identity interval)
-> (r -> r) -> interval -> interval
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (r -> r -> r
forall a. Num a => a -> a -> a
+ r
delta)

-- -- | Flips the start and endpoint of the interval.
-- flipInterval :: Interval_ interval r => interval -> interval
-- flipInterval = uncurry mkInterval . swap . startAndEndPoint

-- | Get the duration, or length of an interval.
duration   :: (Interval_ interval r, Num r) => interval -> r
duration :: forall interval r. (Interval_ interval r, Num r) => interval -> r
duration interval
i = interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end r -> r -> r
forall a. Num a => a -> a -> a
- interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start


--------------------------------------------------------------------------------
-- * Instances for :+

instance HasStart seg p => HasStart (seg :+ extra) p where
  start :: Lens' (seg :+ extra) p
start = (seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> (seg :+ extra)
-> f (seg :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasStart seg p => Lens' seg p
Lens' seg p
start
instance HasEnd seg p => HasEnd (seg :+ extra) p where
  end :: Lens' (seg :+ extra) p
end = (seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> (seg :+ extra)
-> f (seg :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasEnd seg p => Lens' seg p
Lens' seg p
end
instance HasStartPoint seg p => HasStartPoint (seg :+ extra) p where
  startPoint :: Lens' (seg :+ extra) p
startPoint = (seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> (seg :+ extra)
-> f (seg :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' seg p
startPoint
instance HasEndPoint seg p => HasEndPoint (seg :+ extra) p where
  endPoint :: Lens' (seg :+ extra) p
endPoint = (seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((seg -> f seg) -> (seg :+ extra) -> f (seg :+ extra))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> (seg :+ extra)
-> f (seg :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' seg p
endPoint

type instance StartPointOf (interval :+ extra) = StartPointOf interval
type instance EndPointOf (interval :+ extra) = EndPointOf interval

instance ( IntervalLike_ interval point
         ) => IntervalLike_ (interval :+ extra) point where

instance ( Interval_ interval r
         ) => Interval_ (interval :+ extra) r

instance ( ClosedInterval_ interval r
         ) => ClosedInterval_ (interval :+ extra) r

instance ( OpenInterval_ interval r
         ) => OpenInterval_ (interval :+ extra) r

instance ( ConstructableInterval_ interval point
         , Default extra
         ) => ConstructableInterval_ (interval :+ extra) point where
  mkInterval :: StartPointOf (interval :+ extra)
-> EndPointOf (interval :+ extra) -> interval :+ extra
mkInterval StartPointOf (interval :+ extra)
s EndPointOf (interval :+ extra)
t = StartPointOf interval -> EndPointOf interval -> interval
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval StartPointOf interval
StartPointOf (interval :+ extra)
s EndPointOf interval
EndPointOf (interval :+ extra)
t interval -> extra -> interval :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def

instance ( ConstructableClosedInterval_ interval r
         , Default extra
         ) => ConstructableClosedInterval_ (interval :+ extra) r where
  mkClosedInterval :: r -> r -> interval :+ extra
mkClosedInterval r
s r
t = r -> r -> interval
forall interval r.
ConstructableClosedInterval_ interval r =>
r -> r -> interval
mkClosedInterval r
s r
t interval -> extra -> interval :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def

instance ( ConstructableOpenInterval_ interval r
         , Default extra
         ) => ConstructableOpenInterval_ (interval :+ extra) r where
  mkOpenInterval :: r -> r -> interval :+ extra
mkOpenInterval r
s r
t = r -> r -> interval
forall interval r.
ConstructableOpenInterval_ interval r =>
r -> r -> interval
mkOpenInterval r
s r
t interval -> extra -> interval :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def

--------------------------------------------------------------------------------
-- * Instances for WithIndex

instance HasStart seg p => HasStart (ByIndex ix seg) p where
  start :: Lens' (ByIndex ix seg) p
start = (seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg)
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue((seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> ByIndex ix seg
-> f (ByIndex ix seg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasStart seg p => Lens' seg p
Lens' seg p
start
instance HasEnd seg p => HasEnd (ByIndex ix seg) p where
  end :: Lens' (ByIndex ix seg) p
end = (seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg)
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue((seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> ByIndex ix seg
-> f (ByIndex ix seg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasEnd seg p => Lens' seg p
Lens' seg p
end
instance HasStartPoint seg p => HasStartPoint (ByIndex ix seg) p where
  startPoint :: Lens' (ByIndex ix seg) p
startPoint = (seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg)
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue((seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> ByIndex ix seg
-> f (ByIndex ix seg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' seg p
startPoint
instance HasEndPoint seg p => HasEndPoint (ByIndex ix seg) p where
  endPoint :: Lens' (ByIndex ix seg) p
endPoint = (seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg)
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue((seg -> f seg) -> ByIndex ix seg -> f (ByIndex ix seg))
-> ((p -> f p) -> seg -> f seg)
-> (p -> f p)
-> ByIndex ix seg
-> f (ByIndex ix seg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> f p) -> seg -> f seg
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' seg p
endPoint

instance ( IntervalLike_ interval point
         ) => IntervalLike_ (ByIndex ix interval) point where

instance ( Interval_ interval r
         ) => Interval_ (ByIndex ix interval) r

instance ( ClosedInterval_ interval r
         ) => ClosedInterval_ (ByIndex ix interval) r

instance ( OpenInterval_ interval r
         ) => OpenInterval_ (ByIndex ix interval) r

type instance StartPointOf (ByIndex ix interval) = StartPointOf interval
type instance EndPointOf   (ByIndex ix interval) = EndPointOf interval