{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module IntervalAlgebra(
Intervallic(..)
, IntervalAlgebraic(..)
, IntervalCombinable(..)
, Moment(..)
, IntervalSizeable(..)
, IntervalFilterable(..)
, Interval
, IntervalRelation(..)
, ComparativePredicateOf
) where
import Prelude (Eq, Ord, Show, Read, Enum(..), Bounded(..), Ordering (LT)
, Maybe(..), Either(..), String, Integer, Int, Bool(..), Num
, Foldable (maximum, minimum, foldMap, foldr)
, map, 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 Data.Set(Set, fromList, difference, intersection, union, map, toList)
import Data.Ord( Ord(..), Ordering(..))
import GHC.Base (Applicative(pure))
import Witherable ( Filterable(filter) )
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)
data IntervalRelation a =
Meets
| MetBy
| Before
| After
| Overlaps
| OverlappedBy
| Starts
| StartedBy
| Finishes
| FinishedBy
| During
| Contains
| Equals
deriving (IntervalRelation a -> IntervalRelation a -> Bool
(IntervalRelation a -> IntervalRelation a -> Bool)
-> (IntervalRelation a -> IntervalRelation a -> Bool)
-> Eq (IntervalRelation a)
forall a. IntervalRelation a -> IntervalRelation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalRelation a -> IntervalRelation a -> Bool
$c/= :: forall a. IntervalRelation a -> IntervalRelation a -> Bool
== :: IntervalRelation a -> IntervalRelation a -> Bool
$c== :: forall a. IntervalRelation a -> IntervalRelation a -> Bool
Eq, Int -> IntervalRelation a -> ShowS
[IntervalRelation a] -> ShowS
IntervalRelation a -> String
(Int -> IntervalRelation a -> ShowS)
-> (IntervalRelation a -> String)
-> ([IntervalRelation a] -> ShowS)
-> Show (IntervalRelation a)
forall a. Int -> IntervalRelation a -> ShowS
forall a. [IntervalRelation a] -> ShowS
forall a. IntervalRelation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntervalRelation a] -> ShowS
$cshowList :: forall a. [IntervalRelation a] -> ShowS
show :: IntervalRelation a -> String
$cshow :: forall a. IntervalRelation a -> String
showsPrec :: Int -> IntervalRelation a -> ShowS
$cshowsPrec :: forall a. Int -> IntervalRelation a -> ShowS
Show, ReadPrec [IntervalRelation a]
ReadPrec (IntervalRelation a)
Int -> ReadS (IntervalRelation a)
ReadS [IntervalRelation a]
(Int -> ReadS (IntervalRelation a))
-> ReadS [IntervalRelation a]
-> ReadPrec (IntervalRelation a)
-> ReadPrec [IntervalRelation a]
-> Read (IntervalRelation a)
forall a. ReadPrec [IntervalRelation a]
forall a. ReadPrec (IntervalRelation a)
forall a. Int -> ReadS (IntervalRelation a)
forall a. ReadS [IntervalRelation a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntervalRelation a]
$creadListPrec :: forall a. ReadPrec [IntervalRelation a]
readPrec :: ReadPrec (IntervalRelation a)
$creadPrec :: forall a. ReadPrec (IntervalRelation a)
readList :: ReadS [IntervalRelation a]
$creadList :: forall a. ReadS [IntervalRelation a]
readsPrec :: Int -> ReadS (IntervalRelation a)
$creadsPrec :: forall a. Int -> ReadS (IntervalRelation a)
Read)
instance Bounded (IntervalRelation a) where
minBound :: IntervalRelation a
minBound = IntervalRelation a
forall a. IntervalRelation a
Before
maxBound :: IntervalRelation a
maxBound = IntervalRelation a
forall a. IntervalRelation a
After
instance Enum (IntervalRelation a) where
fromEnum :: IntervalRelation a -> Int
fromEnum IntervalRelation a
r = case IntervalRelation a
r of
IntervalRelation a
Before -> Int
0
IntervalRelation a
Meets -> Int
1
IntervalRelation a
Overlaps -> Int
2
IntervalRelation a
FinishedBy -> Int
3
IntervalRelation a
Contains -> Int
4
IntervalRelation a
Starts -> Int
5
IntervalRelation a
Equals -> Int
6
IntervalRelation a
StartedBy -> Int
7
IntervalRelation a
During -> Int
8
IntervalRelation a
Finishes -> Int
9
IntervalRelation a
OverlappedBy -> Int
10
IntervalRelation a
MetBy -> Int
11
IntervalRelation a
After -> Int
12
toEnum :: Int -> IntervalRelation a
toEnum Int
i = case Int
i of
Int
0 -> IntervalRelation a
forall a. IntervalRelation a
Before
Int
1 -> IntervalRelation a
forall a. IntervalRelation a
Meets
Int
2 -> IntervalRelation a
forall a. IntervalRelation a
Overlaps
Int
3 -> IntervalRelation a
forall a. IntervalRelation a
FinishedBy
Int
4 -> IntervalRelation a
forall a. IntervalRelation a
Contains
Int
5 -> IntervalRelation a
forall a. IntervalRelation a
Starts
Int
6 -> IntervalRelation a
forall a. IntervalRelation a
Equals
Int
7 -> IntervalRelation a
forall a. IntervalRelation a
StartedBy
Int
8 -> IntervalRelation a
forall a. IntervalRelation a
During
Int
9 -> IntervalRelation a
forall a. IntervalRelation a
Finishes
Int
10 -> IntervalRelation a
forall a. IntervalRelation a
OverlappedBy
Int
11 -> IntervalRelation a
forall a. IntervalRelation a
MetBy
Int
12 -> IntervalRelation a
forall a. IntervalRelation a
After
instance Ord (IntervalRelation a) where
compare :: IntervalRelation a -> IntervalRelation a -> Ordering
compare IntervalRelation a
x IntervalRelation a
y = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntervalRelation a -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation a
x) (IntervalRelation a -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation a
y)
intervalRelations :: Set (IntervalRelation a)
intervalRelations :: Set (IntervalRelation a)
intervalRelations = [IntervalRelation a] -> Set (IntervalRelation a)
forall a. Ord a => [a] -> Set a
fromList ((Int -> IntervalRelation a) -> [Int] -> [IntervalRelation a]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Int -> IntervalRelation a
forall a. Enum a => Int -> a
toEnum [Int
0..Int
12] ::[IntervalRelation a])
converseRelation :: IntervalRelation a -> IntervalRelation a
converseRelation :: IntervalRelation a -> IntervalRelation a
converseRelation IntervalRelation a
x = Int -> IntervalRelation a
forall a. Enum a => Int -> a
toEnum (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- IntervalRelation a -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation a
x)
type ComparativePredicateOf a = (a -> a -> Bool)
class (Ord a, Show a) => Intervallic a where
parseInterval :: a -> a -> Either String (Interval a)
parseInterval a
x a
y
| 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)
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)
begin, end :: Interval a -> a
begin (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x
end (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x
class (Eq a, Intervallic a) => IntervalAlgebraic a where
relate :: Interval a -> Interval a -> IntervalRelation a
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 a
forall a. IntervalRelation a
Before
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`after` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
After
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`meets` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
Meets
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`metBy` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
MetBy
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`overlaps` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
Overlaps
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`overlappedBy` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
OverlappedBy
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`starts` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
Starts
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`startedBy` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
StartedBy
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`finishes` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
Finishes
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`finishedBy` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
FinishedBy
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`during` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
During
| Interval a
x ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
`contains` Interval a
y = IntervalRelation a
forall a. IntervalRelation a
Contains
| Bool
otherwise = IntervalRelation a
forall a. IntervalRelation a
Equals
predicate' :: IntervalRelation a -> ComparativePredicateOf (Interval a)
predicate' IntervalRelation a
r =
case IntervalRelation a
r of
IntervalRelation a
Before -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
before
IntervalRelation a
Meets -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
meets
IntervalRelation a
Overlaps -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
overlaps
IntervalRelation a
FinishedBy -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
finishedBy
IntervalRelation a
Contains -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
contains
IntervalRelation a
Starts -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
starts
IntervalRelation a
Equals -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
equals
IntervalRelation a
StartedBy -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
startedBy
IntervalRelation a
During -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
during
IntervalRelation a
Finishes -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
finishes
IntervalRelation a
OverlappedBy -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
overlappedBy
IntervalRelation a
MetBy -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
metBy
IntervalRelation a
After -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
after
predicates :: Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)]
predicates Set (IntervalRelation a)
x = (IntervalRelation a -> ComparativePredicateOf (Interval a))
-> [IntervalRelation a] -> [ComparativePredicateOf (Interval a)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map IntervalRelation a -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
IntervalRelation a -> ComparativePredicateOf (Interval a)
predicate' (Set (IntervalRelation a) -> [IntervalRelation a]
forall a. Set a -> [a]
toList Set (IntervalRelation a)
x)
predicate :: Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
predicate = [ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
[ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
unionPredicates([ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a))
-> (Set (IntervalRelation a)
-> [ComparativePredicateOf (Interval a)])
-> Set (IntervalRelation a)
-> ComparativePredicateOf (Interval a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)]
forall a.
IntervalAlgebraic a =>
Set (IntervalRelation a) -> [ComparativePredicateOf (Interval a)]
predicates
toSet :: [IntervalRelation a] -> Set (IntervalRelation a)
toSet = [IntervalRelation a] -> Set (IntervalRelation a)
forall a. Ord a => [a] -> Set a
fromList
complement :: Set (IntervalRelation a) -> Set (IntervalRelation a)
complement = Set (IntervalRelation a)
-> Set (IntervalRelation a) -> Set (IntervalRelation a)
forall a. Ord a => Set a -> Set a -> Set a
difference Set (IntervalRelation a)
forall a. Set (IntervalRelation a)
intervalRelations
intersection :: Set (IntervalRelation a)
-> Set (IntervalRelation a)
-> Set (IntervalRelation a)
intersection = Set (IntervalRelation a)
-> Set (IntervalRelation a) -> Set (IntervalRelation a)
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.intersection
union :: Set (IntervalRelation a)
-> Set (IntervalRelation a)
-> Set (IntervalRelation a)
union = Set (IntervalRelation a)
-> Set (IntervalRelation a) -> Set (IntervalRelation a)
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.union
converse :: Set (IntervalRelation a)
-> Set (IntervalRelation a)
converse = (IntervalRelation a -> IntervalRelation a)
-> Set (IntervalRelation a) -> Set (IntervalRelation a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Data.Set.map IntervalRelation a -> IntervalRelation a
forall a. IntervalRelation a -> IntervalRelation a
converseRelation
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
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
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
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
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
precedes, precededBy :: ComparativePredicateOf (Interval a)
precedes = ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
starts
precededBy = ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
startedBy
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
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
unionPredicates :: [ComparativePredicateOf (Interval a)] ->
ComparativePredicateOf (Interval a)
unionPredicates [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
(<|>) :: ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
(<|>) ComparativePredicateOf (Interval a)
f ComparativePredicateOf (Interval a)
g = [ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
[ComparativePredicateOf (Interval a)]
-> ComparativePredicateOf (Interval a)
unionPredicates [ComparativePredicateOf (Interval a)
f, ComparativePredicateOf (Interval a)
g]
disjointRelations :: Set (IntervalRelation a)
disjointRelations = [IntervalRelation a] -> Set (IntervalRelation a)
forall a.
IntervalAlgebraic a =>
[IntervalRelation a] -> Set (IntervalRelation a)
toSet [IntervalRelation a
forall a. IntervalRelation a
Before, IntervalRelation a
forall a. IntervalRelation a
After, IntervalRelation a
forall a. IntervalRelation a
Meets, IntervalRelation a
forall a. IntervalRelation a
MetBy]
withinRelations :: Set (IntervalRelation a)
withinRelations = [IntervalRelation a] -> Set (IntervalRelation a)
forall a.
IntervalAlgebraic a =>
[IntervalRelation a] -> Set (IntervalRelation a)
toSet [IntervalRelation a
forall a. IntervalRelation a
During, IntervalRelation a
forall a. IntervalRelation a
Starts, IntervalRelation a
forall a. IntervalRelation a
Finishes, IntervalRelation a
forall a. IntervalRelation a
Equals]
disjoint :: ComparativePredicateOf (Interval a)
disjoint = Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
predicate Set (IntervalRelation a)
forall a. IntervalAlgebraic a => Set (IntervalRelation a)
disjointRelations
notDisjoint :: ComparativePredicateOf (Interval a)
notDisjoint = Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
predicate (Set (IntervalRelation a) -> Set (IntervalRelation a)
forall a.
IntervalAlgebraic a =>
Set (IntervalRelation a) -> Set (IntervalRelation a)
complement Set (IntervalRelation a)
forall a. IntervalAlgebraic a => Set (IntervalRelation a)
disjointRelations)
within :: ComparativePredicateOf (Interval a)
within = Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
Set (IntervalRelation a) -> ComparativePredicateOf (Interval a)
predicate Set (IntervalRelation a)
forall a. IntervalAlgebraic a => Set (IntervalRelation a)
withinRelations
class (Intervallic a, Num b, Ord b) => Moment a b| a -> b where
moment :: b
moment = b
1
class (Intervallic a, Moment a b, Num b, Ord b) => IntervalSizeable a b| a -> b where
duration :: Interval a -> b
duration Interval a
x = a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (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
x)
add :: b -> a -> a
diff :: a -> a -> b
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 (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add b
s (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Interval a -> a
forall a. Intervallic a => Interval a -> a
begin Interval a
p, b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add b
e (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Interval a -> a
forall a. Intervallic a => Interval a -> a
end Interval a
p)
where s :: b
s = if b
l b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< (forall b. Moment a b => b
forall a b. Moment a b => b
moment @a) then b
0 else b -> b
forall a. Num a => a -> a
negate b
l
e :: b
e = if b
r b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< (forall b. Moment a b => b
forall a b. Moment a b => b
moment @a) then b
0 else b
r
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
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
beginerval :: b -> a -> Interval a
beginerval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (b -> b -> b
forall a. Ord a => a -> a -> a
max (forall b. Moment a b => b
forall a b. Moment a b => b
moment @a) b
dur) a
x)
enderval :: b -> a -> Interval a
enderval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (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 (forall b. Moment a b => b
forall a b. Moment a b => b
moment @a) b
dur) a
x, a
x)
class (IntervalAlgebraic a) => IntervalCombinable a where
(.+.) :: 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
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)
(><) :: 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
(<+>):: (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 )
intersect :: Interval a -> Interval a -> Maybe (Interval a)
intersect Interval a
x Interval a
y
| ComparativePredicateOf (Interval a)
forall a.
IntervalAlgebraic a =>
ComparativePredicateOf (Interval a)
disjoint Interval a
x Interval a
y = Maybe (Interval a)
forall a. Maybe a
Nothing
| Bool
otherwise = 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 (a
b, a
e)
where b :: a
b = a -> a -> a
forall a. Ord a => a -> a -> a
max (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
min (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)
class (Filterable f, IntervalAlgebraic a) => IntervalFilterable f a where
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)
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
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
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
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
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
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
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
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
filterDisjoint :: Interval a -> f (Interval a) -> f (Interval a)
filterDisjoint = 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)
disjoint
filterNotDisjoint :: Interval a -> f (Interval a) -> f (Interval a)
filterNotDisjoint = 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)
notDisjoint
filterWithin :: Interval a -> f (Interval a) -> f (Interval a)
filterWithin = 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)
disjoint
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 Moment Int Int
instance IntervalSizeable Int Int where
add :: Int -> Int -> Int
add = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
diff :: Int -> Int -> Int
diff = (-)
instance IntervalFilterable [] Int
instance Intervallic Integer
instance IntervalAlgebraic Integer
instance IntervalCombinable Integer
instance Moment Integer Integer
instance IntervalSizeable Integer Integer where
add :: Integer -> Integer -> Integer
add = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
diff :: Integer -> Integer -> Integer
diff = (-)
instance IntervalFilterable [] Integer
instance Intervallic DT.Day
instance IntervalAlgebraic DT.Day
instance IntervalCombinable DT.Day
instance Moment DT.Day Integer
instance IntervalSizeable DT.Day Integer where
add :: Integer -> Day -> Day
add = Integer -> Day -> Day
addDays
diff :: Day -> Day -> Integer
diff = Day -> Day -> Integer
diffDays
instance IntervalFilterable [] DT.Day