{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-|
Module      : Interval Algebra
Description : Implementation of Allen's interval algebra
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
Stability   : experimental

The @IntervalAlgebra@ module provides data types and related classes for the 
interval-based temporal logic described in [Allen (1983)](https://doi.org/10.1145/182.358434)
and axiomatized in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x). 

A good primer on Allen's algebra can be [found here](https://thomasalspaugh.org/pub/fnd/allen.html).

= Design

The module is built around five typeclasses designed to separate concerns of 
constructing, relating, and combining @'Interval'@s: 

1. @'Intervallic'@ provides an interface to the data structure of an @'Interval'@, 
   defining how an @'Interval' a@ is constructed.
2. @'IntervalAlgebraic'@ provides an interface to the @'IntervalRelation's@, 
   the workhorse of Allen's temporal logic.
3. @'IntervalCombinable'@ provides an interface to methods of combining two
   @'Interval's@.
4. @'IntervalSizeable'@ provides methods for measuring and modifying the size
   of an interval.
5. @'IntervalFilterable'@ provides methods for filtering 'Witherable.Filterable' collections
   of intervals.

An advantage of nested typeclass design is that developers can define an 
@'Interval'@ of type @a@ with just the amount of structure that they need.

== Total Ordering of @Interval@s 

The modules makes the (opinionated) choice of a total ordering for @'Intervallic'@ 
@'Interval'@s. Namely, the ordering is based on first ordering the 'begin's 
then the 'end's.

= Development

This module is under development and the API may change in the future.
-}


module IntervalAlgebra(

    -- * Classes
      Intervallic(..)
    , IntervalAlgebraic(..)
    , IntervalCombinable(..)
    , IntervalSizeable(..)
    , IntervalFilterable(..)

    -- * Types
    , Interval
    , IntervalRelation
    , ComparativePredicateOf
) where

import Prelude (Eq, Ord, Show, Read
               , Maybe(..), Either(..), String, Integer, Int, Bool(..), Num
               , Foldable (maximum, minimum, foldMap, foldr)
               , otherwise, flip, show, fst, snd, min, max, any, negate, not
               , (++), (==), (&&), (<), (>), (<=), ($), (+), (-), (.))
import Data.Time as DT ( Day, addDays, diffDays, addGregorianYearsClip, calendarYear )
import Data.Semigroup ( Semigroup((<>)) )
import GHC.Base (Applicative(pure))
import Witherable ( Filterable(filter) )

{- | An @'Interval' a@ is a pair of @a@s \( (x, y) \text{ where } x < y\). The
@'Intervallic'@ class provides a safe @'parseInterval'@ function that returns a 
@'Left'@ error if \(y < x\) and 'unsafeInterval' as constructor for creating an
interval that may not be valid. 
-}
newtype Interval a = Interval (a, a) deriving (Interval a -> Interval a -> Bool
(Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool) -> Eq (Interval a)
forall a. Eq a => Interval a -> Interval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval a -> Interval a -> Bool
$c/= :: forall a. Eq a => Interval a -> Interval a -> Bool
== :: Interval a -> Interval a -> Bool
$c== :: forall a. Eq a => Interval a -> Interval a -> Bool
Eq)

{- | 

The 'IntervalRelation' type enumerates the thirteen possible ways that two 
@'Interval' a@ objects can relate according to the interval algebra.

=== Meets, Metby

> x `meets` y
> y `metBy` x

@ 
x: |-----|
y:       |-----| 
@

=== Before, After

> x `before` y
> y `after` x

@ 
x: |-----|  
y:          |-----|
@


=== Overlaps, OverlappedBy

> x `overlaps` y
> y `overlappedBy` x

@ 
x: |-----|
y:     |-----|
@

=== Starts, StartedBy

> x `starts` y
> y `startedBy` x

@ 
x: |---| 
y: |-----|
@

=== Finishes, FinishedBy

> x `finishes` y
> y `finishedBy` x

@ 
x:   |---| 
y: |-----|
@

=== During, Contains

> x `during` y
> y `contains` x

@ 
x:   |-| 
y: |-----|
@

=== Equal

> x `equal` y
> y `equal` x

@ 
x: |-----| 
y: |-----|
@

-}
data IntervalRelation =
      Meets
    | MetBy
    | Before
    | After
    | Overlaps
    | OverlappedBy
    | Starts
    | StartedBy
    | Finishes
    | FinishedBy
    | During
    | Contains
    | Equals
    deriving (Int -> IntervalRelation -> ShowS
[IntervalRelation] -> ShowS
IntervalRelation -> String
(Int -> IntervalRelation -> ShowS)
-> (IntervalRelation -> String)
-> ([IntervalRelation] -> ShowS)
-> Show IntervalRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntervalRelation] -> ShowS
$cshowList :: [IntervalRelation] -> ShowS
show :: IntervalRelation -> String
$cshow :: IntervalRelation -> String
showsPrec :: Int -> IntervalRelation -> ShowS
$cshowsPrec :: Int -> IntervalRelation -> ShowS
Show, ReadPrec [IntervalRelation]
ReadPrec IntervalRelation
Int -> ReadS IntervalRelation
ReadS [IntervalRelation]
(Int -> ReadS IntervalRelation)
-> ReadS [IntervalRelation]
-> ReadPrec IntervalRelation
-> ReadPrec [IntervalRelation]
-> Read IntervalRelation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntervalRelation]
$creadListPrec :: ReadPrec [IntervalRelation]
readPrec :: ReadPrec IntervalRelation
$creadPrec :: ReadPrec IntervalRelation
readList :: ReadS [IntervalRelation]
$creadList :: ReadS [IntervalRelation]
readsPrec :: Int -> ReadS IntervalRelation
$creadsPrec :: Int -> ReadS IntervalRelation
Read)

{-
Misc
-}

-- | Defines a predicate of two objects of type @a@.
type ComparativePredicateOf a = (a -> a -> Bool)

{- | 
The @'Intervallic'@ typeclass specifies how an @'Interval' a@s is constructed.
It also includes functions for getting the @'begin'@ and @'end'@ of an @'Interval' a@.
-}
class (Ord a, Show a) => Intervallic a where

    -- | Safely parse a pair of @a@s to create an @'Interval' a@.
    parseInterval :: a -> a -> Either String (Interval a)
    parseInterval a
x a
y
        -- TODO: create more general framework for error handling
        |  a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x    = String -> Either String (Interval a)
forall a b. a -> Either a b
Left  (String -> Either String (Interval a))
-> String -> Either String (Interval a)
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
        | Bool
otherwise = Interval a -> Either String (Interval a)
forall a b. b -> Either a b
Right (Interval a -> Either String (Interval a))
-> Interval a -> Either String (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
y)

    {- | Create a new @'Interval' a@. This function is __not__ safe as it does 
       not enforce that \(x < y\). Use with caution. It is meant to be helper 
       function in early prototyping of this package. This function may be 
       deprecated in future releases.
    -}
    unsafeInterval :: a -> a -> Interval a
    unsafeInterval a
x a
y = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
y)

    -- | Access the ends of an @'Interval' a@ .
    begin, end :: Interval a -> a
    begin (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x --  \( \text{begin}(x, y) = x \)
    end   (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x --  \( \text{end}(x, y) = y \)

{- |
The @'IntervalAlgebraic'@ typeclass specifies the functions and relational 
operators for interval-based temporal logic. The typeclass defines the 
relational operators for intervals, plus other useful utilities such as 
@'disjoint'@, @'in''@, and @'composeRelations'@.
-}
class (Eq a, Intervallic a) => IntervalAlgebraic a where

    -- | Compare two intervals to determine their 'IntervalRelation'.
    relate :: Interval a -> Interval a -> IntervalRelation
    relate Interval a
x Interval a
y
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`before` Interval a
y       = IntervalRelation
Before
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`after`  Interval a
y       = IntervalRelation
After
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`meets`  Interval a
y       = IntervalRelation
Meets
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`metBy`  Interval a
y       = IntervalRelation
MetBy
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`overlaps` Interval a
y     = IntervalRelation
Overlaps
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`overlappedBy` Interval a
y = IntervalRelation
OverlappedBy
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`starts` Interval a
y       = IntervalRelation
Starts
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`startedBy` Interval a
y    = IntervalRelation
StartedBy
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`finishes` Interval a
y     = IntervalRelation
Finishes
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`finishedBy` Interval a
y   = IntervalRelation
FinishedBy
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`during` Interval a
y       = IntervalRelation
During
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`contains` Interval a
y     = IntervalRelation
Contains
        | Bool
otherwise          = IntervalRelation
Equals

    -- | Does x equal y?
    equals                 :: ComparativePredicateOf (Interval a)
    equals   Interval a
x Interval a
y  = Interval a
x ComparativePredicateOf (Interval a)
forall a. Eq a => a -> a -> Bool
== Interval a
y

    -- | Does x meet y? Is y metBy x?
    meets, metBy           :: ComparativePredicateOf (Interval a)
    meets    Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y
    metBy         = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
meets

    -- | Is x before y? Is x after y?
    before, after          :: ComparativePredicateOf (Interval a)
    before   Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y
    after         = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
before

    -- | Does x overlap y? Is x overlapped by y?
    overlaps, overlappedBy :: ComparativePredicateOf (Interval a)
    overlaps Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y Bool -> Bool -> Bool
&& Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y Bool -> Bool -> Bool
&& Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y
    overlappedBy  = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
overlaps

    -- | Does x start y? Is x started by y?
    starts, startedBy      :: ComparativePredicateOf (Interval a)
    starts   Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y Bool -> Bool -> Bool
&& (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y)
    startedBy     = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
starts

    -- | Does x finish y? Is x finished by y?
    finishes, finishedBy   :: ComparativePredicateOf (Interval a)
    finishes Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y Bool -> Bool -> Bool
&& Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y
    finishedBy    = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
finishes

    -- | Is x during y? Does x contain y?
    during, contains       :: ComparativePredicateOf (Interval a)
    during   Interval a
x Interval a
y  = Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y Bool -> Bool -> Bool
&& Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y
    contains      = ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
during

    -- ** Interval Algebra utilities

    -- | Compose a list of interval relations with _or_ to create a new
    -- @'ComparativePredicateOf' 'Interval' a@. For example, 
    -- @composeRelations [before, meets]@ creates a predicate function determining
    -- if one interval is either before or meets another interval.
    composeRelations       :: [ComparativePredicateOf (Interval a)] ->
                               ComparativePredicateOf (Interval a)
    composeRelations [ComparativePredicateOf (Interval a)]
fs Interval a
x Interval a
y = (ComparativePredicateOf (Interval a) -> Bool)
-> [ComparativePredicateOf (Interval a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ ComparativePredicateOf (Interval a)
f -> ComparativePredicateOf (Interval a)
f Interval a
x Interval a
y) [ComparativePredicateOf (Interval a)]
fs

    -- | Are x and y disjoint ('before', 'after', 'meets', or 'metBy')?
    disjoint               :: ComparativePredicateOf (Interval a)
    disjoint = [ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
[ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
composeRelations [ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
before, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
after, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
meets, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
metBy]

    -- | Is x contained in y in any sense ('during', 'starts', 'finishes' 
    -- or 'equals'?
    in'                    :: ComparativePredicateOf (Interval a)
    in' = [ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
[ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
composeRelations [ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
during, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
starts, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
finishes, ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
equals]


{- |
The 'IntervalSizeable' typeclass provides functions to determine the size of
and to resize an 'Interval a'.
-}
class (Intervallic a, Num b, Ord b) => IntervalSizeable a b| a -> b where

    -- | Determine the duration of an 'Interval a'.
    duration :: Interval a -> b

    -- | Sets the length of a moment for an 'Interval a'.
    moment :: a -> b
    moment a
x = b
1
    -- TODO: The reason is function takes an argument of type @a@ is due to
    --       ambiguous types warnings. I couldn't figure out how to avoid the
    --       warnings without turning on AllowAmbiguousTypes Pragma. Is there a
    --       better way to handle this?

    -- | Shifts an @a@. Most often, the @c@ will be the same
    -- type as the @a@. But for example, if @a@ is 'Day' then @c@ would be 'Int'.
    add :: b -> a -> a

    -- | Resize an 'Interval a' to by expanding to "left" by @max l moment@ 
    --   and to the "right" by @min r moment@. 
    expand :: b -> b -> Interval a -> Interval a
    expand b
l b
r Interval a
p = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
s, a
e)
      where s :: a
s = b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (b -> b
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Ord a => a -> a -> a
max b
l (a -> b
forall a b. IntervalSizeable a b => a -> b
moment (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
p))) (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
p)
            e :: a
e = b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (b -> b -> b
forall a. Ord a => a -> a -> a
min b
r (a -> b
forall a b. IntervalSizeable a b => a -> b
moment (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
p))) (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
p)

    -- | Expands an 'Interval a' to left by i.
    expandl :: b -> Interval a -> Interval a
    expandl b
i = b -> b -> Interval a -> Interval a
forall a b.
IntervalSizeable a b =>
b -> b -> Interval a -> Interval a
expand b
i b
0

    -- | Expands an 'Interval a' to right by i.
    expandr :: b -> Interval a -> Interval a
    expandr = b -> b -> Interval a -> Interval a
forall a b.
IntervalSizeable a b =>
b -> b -> Interval a -> Interval a
expand b
0

{- |
The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining
two @'Interval's@.
-}
class (IntervalAlgebraic a) => IntervalCombinable a where

    -- | Maybe form a new @'Interval'@ by the union of two @'Interval'@s that 'meets'.
    (.+.) :: Interval a -> Interval a -> Maybe (Interval a)
    (.+.) Interval a
x Interval a
y
      | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`meets` Interval a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x, Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y)
      | Bool
otherwise   = Maybe (Interval a)
forall a. Maybe a
Nothing

    -- | Creates a new @Interval@ spanning the extent x and y
    extenterval :: Interval a -> Interval a -> Interval a
    extenterval Interval a
x Interval a
y = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
s, a
e)
       where s :: a
s = a -> a -> a
forall a. Ord a => a -> a -> a
min (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x) (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y)
             e :: a
e = a -> a -> a
forall a. Ord a => a -> a -> a
max (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x) (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y)

    -- | If @x@ is 'before' @y@, then form a new @Just Interval a@ from the 
    --   interval in the "gap" between @x@ and @y@ from the 'end' of @x@ to the
    --   'begin' of @y@. Otherwise, 'Nothing'.
    (><) ::  Interval a -> Interval a -> Maybe (Interval a)
    (><) Interval a
x Interval a
y
        | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`before` Interval a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval ( Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x, Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y )
        | Bool
otherwise    = Maybe (Interval a)
forall a. Maybe a
Nothing

    -- | If @x@ is 'before' @y@, return @f x@ appended to @f y@. Otherwise, 
    --   return 'extenterval' of @x@ and @y@ (wrapped in @f@). This is useful for 
    --   folding over an *ordered* container of @Interval@s and combining intervals 
    --   when @x@ is *not* 'before' @y@.
    (<+>):: (Semigroup (f (Interval a)), Applicative f) =>
            Interval a ->
            Interval a ->
            f (Interval a)
    (<+>) Interval a
x Interval a
y
      | Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`before` Interval a
y = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
x f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
y
      | Bool
otherwise    = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Interval a -> Interval a -> Interval a
forall a.
IntervalCombinable a =>
Interval a -> Interval a -> Interval a
extenterval Interval a
x Interval a
y )

{- | 
The @'IntervalFilterable'@ class provides functions for filtering 'Filterable's of 
@'Interval'@s based on @'IntervalAlgebraic'@ relations.
-}
class (Filterable f, IntervalAlgebraic a) => IntervalFilterable f a where

    -- |Creates a function for filtering a 'Witherable.Filterable' of @Interval a@s based on a predicate
    filterMaker :: ComparativePredicateOf (Interval a) 
                   -> Interval a 
                   -> (f (Interval a) -> f (Interval a))
    filterMaker ComparativePredicateOf (Interval a)
f Interval a
p = (Interval a -> Bool) -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
Witherable.filter (ComparativePredicateOf (Interval a)
`f` Interval a
p)

    -- | Filter a 'Witherable.Filterable' of @Interval a@s to those that 'overlaps' the @Interval a@
    --   in the first argument.
    filterOverlaps :: Interval a -> f (Interval a) -> f (Interval a)
    filterOverlaps = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
overlaps

    -- | Filter a 'Witherable.Filterable' of @Interval a@s to those 'overlappedBy' the @Interval a@
    --   in the first argument.
    filterOverlappedBy :: Interval a -> f (Interval a) -> f (Interval a)
    filterOverlappedBy = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
overlappedBy

    -- | Filter a 'Witherable.Filterable' of Interval as to those 'before' the @Interval a@
    --   in the first argument.
    filterBefore :: Interval a -> f (Interval a) -> f (Interval a)
    filterBefore = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
before

    -- | Filter a 'Witherable.Filterable' of Interval as to those 'after' the @Interval a@
    --   in the first argument.
    filterAfter :: Interval a -> f (Interval a) -> f (Interval a)
    filterAfter = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
after

    -- | Filter a 'Witherable.Filterable' of Interval as to those that 'meets' the @Interval a@
    --   in the first argument.
    filterMeets :: Interval a -> f (Interval a) -> f (Interval a)
    filterMeets = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
meets

    -- | Filter a 'Witherable.Filterable' of Interval as to those 'metBy' the @Interval a@
    --   in the first argument.
    filterMetBy :: Interval a -> f (Interval a) -> f (Interval a)
    filterMetBy = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
metBy

    -- | Filter a 'Witherable.Filterable' of Interval as to those 'during' the @Interval a@
    --   in the first argument.
    filterDuring :: Interval a -> f (Interval a) -> f (Interval a)
    filterDuring = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
during

    -- | Filter a 'Witherable.Filterable' of Interval as to those that 'contains' the @Interval a@
    --   in the first argument.
    filterContains :: Interval a -> f (Interval a) -> f (Interval a)
    filterContains = ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a.
IntervalFilterable f a =>
ComparativePredicateOf (Interval a)
-> Interval a -> f (Interval a) -> f (Interval a)
filterMaker ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
contains

{-
Instances
-}

-- | Imposes a total ordering on @'Interval' a@ based on first ordering the 
--   'begin's then the 'end's.
instance (Intervallic a) => Ord (Interval a) where
    <= :: Interval a -> Interval a -> Bool
(<=) Interval a
x Interval a
y
      | Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y = Bool
True
      | Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y = Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y
      | Bool
otherwise = Bool
False
    < :: Interval a -> Interval a -> Bool
(<)  Interval a
x Interval a
y
      | Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y = Bool
True
      | Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
y = Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
y
      | Bool
otherwise = Bool
False

instance (Intervallic a, Show a) => Show (Interval a) where
   show :: Interval a -> String
show Interval a
x = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Intervallic Int
instance IntervalAlgebraic Int
instance IntervalCombinable Int
instance IntervalSizeable Int Int where
    add :: Int -> Int -> Int
add = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
    duration :: Interval Int -> Int
duration Interval Int
x = Interval Int -> Int
forall a. Intervallic a => Interval a -> a
end Interval Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Interval Int -> Int
forall a. Intervallic a => Interval a -> a
begin Interval Int
x
instance IntervalFilterable [] Int

instance Intervallic Integer
instance IntervalAlgebraic Integer
instance IntervalCombinable Integer
instance IntervalSizeable Integer Integer where
    add :: Integer -> Integer -> Integer
add = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
    duration :: Interval Integer -> Integer
duration Interval Integer
x = Interval Integer -> Integer
forall a. Intervallic a => Interval a -> a
end Interval Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Interval Integer -> Integer
forall a. Intervallic a => Interval a -> a
begin Interval Integer
x
instance IntervalFilterable [] Integer

instance Intervallic DT.Day
instance IntervalAlgebraic DT.Day
instance IntervalCombinable DT.Day
instance IntervalSizeable DT.Day Integer where
    add :: Integer -> Day -> Day
add = Integer -> Day -> Day
addDays
    duration :: Interval Day -> Integer
duration Interval Day
x = Day -> Day -> Integer
diffDays (Interval Day -> Day
forall a. Intervallic a => Interval a -> a
end Interval Day
x) (Interval Day -> Day
forall a. Intervallic a => Interval a -> a
begin Interval Day
x)
instance IntervalFilterable [] DT.Day