{-|
Module      : Interval Algebra Utilities
Description : Functions for operating on containers of Intervals.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
Stability   : experimental

In the examples below, @iv@ is a synonym for 'beginerval' used to save space.
-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}

module IntervalAlgebra.IntervalUtilities (
      relations
    , relations'
    , intersect
    , combineIntervals
    , combineIntervals'
    , gaps
    , gaps'
    , durations
    , clip
    , gapsWithin
    , nothingIf
    , nothingIfNone
    , nothingIfAny
    , nothingIfAll

    -- * Operations on Meeting sequences of intervals
    , foldMeetingSafe
    , formMeetingSequence

    -- * Filtering functions
    , compareIntervals
    , filterBefore
    , filterMeets
    , filterOverlaps
    , filterFinishedBy
    , filterContains
    , filterStarts
    , filterEquals
    , filterStartedBy
    , filterDuring
    , filterFinishes
    , filterOverlappedBy
    , filterMetBy
    , filterAfter
    , filterDisjoint
    , filterNotDisjoint
    , filterConcur
    , filterWithin
    , filterEnclose
    , filterEnclosedBy

) where

import GHC.Base         ( (<*>), seq)
import GHC.Show         ( Show )
import GHC.Num          ( )
import GHC.Int          ( Int ) 
import Control.Applicative
                        ( Applicative(pure) )
import Data.Bool        ( Bool, otherwise, not )
import Data.Eq          ( Eq((==)) )
import Data.Foldable    ( Foldable(null, foldl', toList), all, any )
import Data.Function    ( ($), (.), flip )
import Data.Functor     ( Functor(fmap) )
import Data.Monoid      ( Monoid(mempty) )
import Data.Maybe       ( Maybe(..), maybe, maybeToList, mapMaybe, catMaybes, fromMaybe )
import Data.List        ( (++), map )
import Data.Ord         ( Ord(min, max) )
import Data.Semigroup   ( Semigroup((<>)) )
import Data.Tuple       ( fst )
import Safe             ( headMay, lastMay, initSafe, tailSafe)
import Witherable       ( Filterable(filter) )
import IntervalAlgebra  ( Interval
                        , Intervallic(..)
                        , IntervalAlgebraic(..)
                        , IntervalCombinable(..)
                        , IntervalSizeable(..)
                        , IntervalRelation(..)
                        , ComparativePredicateOf
                        , beginerval
                        , enderval
                        , extenterval )
import IntervalAlgebra.PairedInterval
                        ( PairedInterval
                        , mkPairedInterval
                        , getPairData
                        , equalPairData )
-------------------------------------------------
-- Unexported utilties used in functions below --
-------------------------------------------------

-- Just a synonym used to examples to save typing
iv :: Int -> Int -> Interval Int
iv :: Int -> Int -> Interval Int
iv = Int -> Int -> Interval Int
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval

-- Fold over consecutive pairs of foldable structure and collect the results in 
-- a monoidal structure.
foldlAccume :: (Foldable f, Applicative m, Monoid (m a))=>
      (b -> b -> a) -- ^ @f@: a function to apply to consecutive elements of @f b@
    -> f b
    -> m a
foldlAccume :: (b -> b -> a) -> f b -> m a
foldlAccume b -> b -> a
f f b
x = (m a, Maybe b) -> m a
forall a b. (a, b) -> a
fst ((m a, Maybe b) -> m a) -> (m a, Maybe b) -> m a
forall a b. (a -> b) -> a -> b
$ ((m a, Maybe b) -> b -> (m a, Maybe b))
-> (m a, Maybe b) -> f b -> (m a, Maybe b)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> b -> a) -> (m a, Maybe b) -> b -> (m a, Maybe b)
forall (f :: * -> *) a b.
(Monoid (f a), Applicative f) =>
(b -> b -> a) -> (f a, Maybe b) -> b -> (f a, Maybe b)
applyAccume b -> b -> a
f) (m a
forall a. Monoid a => a
mempty, Maybe b
forall a. Maybe a
Nothing) f b
x

-- Apply a function and accumulate the results in a monoidal structure.
applyAccume :: (Monoid (f a), Applicative f) =>
       (b -> b -> a)  -- ^ @f@: a function combining two @b@s to get an @a@
    -> (f a, Maybe b) -- ^ a pair (accumulating monoid for @b@s, optional @a@)
    -> b              -- ^ this will be the second argument to @f@
    -> (f a, Maybe b)
applyAccume :: (b -> b -> a) -> (f a, Maybe b) -> b -> (f a, Maybe b)
applyAccume b -> b -> a
f (f a
fs, Maybe b
Nothing) b
x = (f a
fs, b -> Maybe b
forall a. a -> Maybe a
Just b
x)
applyAccume b -> b -> a
f (f a
fs, Just b
x)  b
y = (f a
fs f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> b -> a
f b
x b
y), b -> Maybe b
forall a. a -> Maybe a
Just b
y)

-- Lifts a list to a foldable, applicative monoid 
liftListToFoldable :: ( Applicative f
                      , Monoid (f a)
                      , Foldable f) =>
    [a] -> f a
liftListToFoldable :: [a] -> f a
liftListToFoldable = (f a -> a -> f a) -> f a -> [a] -> f a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\f a
x a
y -> f a
x f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y) f a
forall a. Monoid a => a
mempty

-- Used to combine two lists by combining the last element of @x@ and the first 
-- element of @y@ by @f@. The combining function @f@ will generally return a 
-- singleton list in the case that the last of x and head of y can be combined
-- or a two element list in the case they cannot.
listCombiner :: (Maybe a -> Maybe a -> [a]) -- ^ f
                -> [a] -- ^ x
                -> [a] -- ^ y
                -> [a]
listCombiner :: (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner Maybe a -> Maybe a -> [a]
f [a]
x [a]
y = [a] -> [a]
forall a. [a] -> [a]
initSafe [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> Maybe a -> [a]
f ([a] -> Maybe a
forall a. [a] -> Maybe a
lastMay [a]
x) ([a] -> Maybe a
forall a. [a] -> Maybe a
headMay [a]
y) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
tailSafe [a]
y

-- | Returns a list of the 'IntervalRelation' between each consecutive pair 
--   of intervals. This the specialized form of 'relations'' which can return
--   any 'Applicative', 'Monoid' structure.
--
-- >>> relations [iv 1 0, iv 1 1] 
-- [Meets]
relations :: (IntervalAlgebraic i a, Foldable f)=>
       f (i a)
    -> [IntervalRelation (i a)]
relations :: f (i a) -> [IntervalRelation (i a)]
relations = f (i a) -> [IntervalRelation (i a)]
forall (i :: * -> *) a (f :: * -> *) (m :: * -> *).
(IntervalAlgebraic i a, Foldable f, Applicative m,
 Monoid (m (IntervalRelation (i a)))) =>
f (i a) -> m (IntervalRelation (i a))
relations'

-- | A generic form of 'relations' which can output any 'Applicative' and 
--   'Monoid' structure. 
-- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]
-- [Meets]
--
relations' :: ( IntervalAlgebraic i a
              , Foldable f
              , Applicative m
              , Monoid (m (IntervalRelation (i a))) )=>
        f (i a)
     -> m (IntervalRelation (i a))
relations' :: f (i a) -> m (IntervalRelation (i a))
relations' = (i a -> i a -> IntervalRelation (i a))
-> f (i a) -> m (IntervalRelation (i a))
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Applicative m, Monoid (m a)) =>
(b -> b -> a) -> f b -> m a
foldlAccume i a -> i a -> IntervalRelation (i a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
i a -> i a -> IntervalRelation (i a)
relate

-- | Forms a 'Just' new interval from the intersection of two intervals, 
--   provided the intervals are not disjoint.
intersect :: (IntervalSizeable a b, IntervalAlgebraic i a) => 
    i a -> i a -> Maybe (Interval a)
intersect :: i a -> i a -> Maybe (Interval a)
intersect i a
x i a
y
    | ComparativePredicateOf (i a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
disjoint i a
x i 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
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff a
e a
b) a
b
        where b :: a
b = a -> a -> a
forall a. Ord a => a -> a -> a
max (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i a
y)
              e :: a
e = a -> a -> a
forall a. Ord a => a -> a -> a
min (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i a
y)

-- | Returns a (possibly empty) container of intervals consisting of the gaps 
--   between intervals in the input. *To work properly, the input should be
--   sorted*. See 'gaps'' for a version that returns a list.
--
-- >>> gaps [iv 4 1, iv 4 8, iv 3 11]
-- [(5, 8)]
gaps :: (IntervalCombinable Interval a
         , Applicative f
         , Monoid (f (Interval a))
         , Foldable f) =>
      f (Interval a) ->
      f (Interval a)
gaps :: f (Interval a) -> f (Interval a)
gaps f (Interval a)
x = [Interval a] -> f (Interval a)
forall (f :: * -> *) a.
(Applicative f, Monoid (f a), Foldable f) =>
[a] -> f a
liftListToFoldable (f (Interval a) -> [Interval a]
forall a (f :: * -> *).
(IntervalCombinable Interval a, Applicative f,
 Monoid (f (Interval a)), Foldable f) =>
f (Interval a) -> [Interval a]
gaps' f (Interval a)
x)

-- | Returns a (possibly empty) list of intervals consisting of the gaps between
--   intervals in the input container. *To work properly, the input should be 
--   sorted*. This version outputs a list. See 'gaps' for a version that lifts
--   the result to same input structure @f@.
gaps' :: (IntervalCombinable Interval a
         , Applicative f
         , Monoid (f (Interval a))
         , Foldable f) =>
      f (Interval a) ->
      [Interval a]
gaps' :: f (Interval a) -> [Interval a]
gaps' f (Interval a)
x = [Maybe (Interval a)] -> [Interval a]
forall a. [Maybe a] -> [a]
catMaybes ((Interval a -> Interval a -> Maybe (Interval a))
-> f (Interval a) -> [Maybe (Interval a)]
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Applicative m, Monoid (m a)) =>
(b -> b -> a) -> f b -> m a
foldlAccume Interval a -> Interval a -> Maybe (Interval a)
forall (i :: * -> *) a.
IntervalCombinable i a =>
i a -> i a -> Maybe (i a)
(><) f (Interval a)
x)

-- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@.
--
-- >>> durations [iv 9 1, iv 10 2, iv 1 5]
-- [9,10,1]
durations :: (Functor f, Intervallic i a, IntervalSizeable a b)=>
       f (i a)
    -> f b
durations :: f (i a) -> f b
durations = (i a -> b) -> f (i a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
duration

-- | In the case that x y are not disjoint, clips y to the extent of x.
-- 
-- >>> clip (iv 5 0) (iv 3 3)
-- Just (3, 5)
--
-- >>> clip (iv 3 0) (iv 2 4)
-- Nothing
clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>
       Interval a
    -> Interval a
    -> Maybe (Interval a)
clip :: Interval a -> Interval a -> Maybe (Interval a)
clip Interval a
x Interval a
y
   | ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
overlaps Interval a
x 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
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval   (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
x) (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
y)) (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
x)
   | ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
overlappedBy Interval a
x 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
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
y) (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
x)) (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
x)
   | ComparativePredicateOf (Interval a)
jx Interval a
x Interval a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just Interval a
x
   | ComparativePredicateOf (Interval a)
jy Interval a
x Interval a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just Interval a
y
   | ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
disjoint Interval a
x Interval a
y     = Maybe (Interval a)
forall a. Maybe a
Nothing
   where jy :: ComparativePredicateOf (Interval a)
jy = ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
equals ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
startedBy ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
contains ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
finishedBy
         jx :: ComparativePredicateOf (Interval a)
jx = ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
starts ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
during ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
finishes

-- | Applies 'gaps' to all the non-disjoint intervals in @x@ that are *not* disjoint
-- from @i@. Intervals that 'overlaps' or are 'overlappedBy' @i@ are 'clip'ped 
-- to @i@, so that all the intervals are 'within' @i@. If there are no gaps, then
-- 'Nothing' is returned.
--
-- >>> gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]
-- Just [(5, 7),(9, 10)]
--
gapsWithin :: ( Applicative f
               , Foldable f
               , Monoid (f (Interval a))
               , IntervalSizeable a b
               , IntervalCombinable Interval a
               , Filterable f
               , IntervalAlgebraic Interval a)=>
     Interval a     -- ^ i
  -> f (Interval a) -- ^ x
  -> Maybe (f (Interval a))
gapsWithin :: Interval a -> f (Interval a) -> Maybe (f (Interval a))
gapsWithin Interval a
i f (Interval a)
x
  | f (Interval a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Interval a)
ivs  = Maybe (f (Interval a))
forall a. Maybe a
Nothing
  | Bool
otherwise = f (Interval a) -> Maybe (f (Interval a))
forall a. a -> Maybe a
Just (f (Interval a) -> Maybe (f (Interval a)))
-> f (Interval a) -> Maybe (f (Interval a))
forall a b. (a -> b) -> a -> b
$ f (Interval a) -> f (Interval a)
forall a (f :: * -> *).
(IntervalCombinable Interval a, Applicative f,
 Monoid (f (Interval a)), Foldable f) =>
f (Interval a) -> f (Interval a)
gaps (f (Interval a) -> f (Interval a))
-> f (Interval a) -> f (Interval a)
forall a b. (a -> b) -> a -> b
$ Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
s f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> f (Interval a)
ivs 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
e
        where s :: Interval a
s   = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval   b
0 (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
i)
              e :: Interval a
e   = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
0 (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
i)
              nd :: [Interval a]
nd  = f (Interval a) -> [Interval a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Interval a -> f (Interval a) -> f (Interval a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint Interval a
i f (Interval a)
x)
              ivs :: f (Interval a)
ivs = [Interval a] -> f (Interval a)
forall (f :: * -> *) a.
(Applicative f, Monoid (f a), Foldable f) =>
[a] -> f a
liftListToFoldable ((Interval a -> Maybe (Interval a)) -> [Interval a] -> [Interval a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Interval a -> Interval a -> Maybe (Interval a)
forall a b.
(IntervalAlgebraic Interval a, IntervalSizeable a b) =>
Interval a -> Interval a -> Maybe (Interval a)
clip Interval a
i) [Interval a]
nd)

-- The Box is an internal type used to hold accumulated, combined intervals in 
-- 'combineIntervals''.
newtype Box a = Box { Box a -> [a]
unBox :: [a] }

packBoxes :: [a] -> [Box a]
packBoxes :: [a] -> [Box a]
packBoxes  = (a -> Box a) -> [a] -> [Box a]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\a
z -> [a] -> Box a
forall a. [a] -> Box a
Box [a
z])

instance (Ord a, Show a, IntervalCombinable i a) => Semigroup (Box (i a)) where
    Box [i a]
x <> :: Box (i a) -> Box (i a) -> Box (i a)
<> Box [i a]
y = [i a] -> Box (i a)
forall a. [a] -> Box a
Box ([i a] -> Box (i a)) -> [i a] -> Box (i a)
forall a b. (a -> b) -> a -> b
$ (Maybe (i a) -> Maybe (i a) -> [i a]) -> [i a] -> [i a] -> [i a]
forall a. (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner Maybe (i a) -> Maybe (i a) -> [i a]
forall (i :: * -> *) a.
IntervalCombinable i a =>
Maybe (i a) -> Maybe (i a) -> [i a]
(<->) [i a]
x [i a]
y

-- | Returns a container of intervals where any intervals that meet or share support
--   are combined into one interval. *To work properly, the input should 
--   be sorted*. See 'combineIntervals'' for a version that works only on lists.
--
-- >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
-- [(0, 12),(13, 15)]
combineIntervals :: ( IntervalAlgebraic Interval a
                    , Applicative f
                    , Monoid (f (Interval a))
                    , Foldable f ) =>
      f (Interval a) ->
      f (Interval a)
combineIntervals :: f (Interval a) -> f (Interval a)
combineIntervals f (Interval a)
x = [Interval a] -> f (Interval a)
forall (f :: * -> *) a.
(Applicative f, Monoid (f a), Foldable f) =>
[a] -> f a
liftListToFoldable ([Interval a] -> [Interval a]
forall a.
IntervalAlgebraic Interval a =>
[Interval a] -> [Interval a]
combineIntervals' ([Interval a] -> [Interval a]) -> [Interval a] -> [Interval a]
forall a b. (a -> b) -> a -> b
$ f (Interval a) -> [Interval a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Interval a)
x)

-- | Returns a list of intervals where any intervals that meet or share support
--   are combined into one interval. *To work properly, the input list should 
--   be sorted*. 
--
-- >>> combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
-- [(0, 12),(13, 15)]
combineIntervals' :: (IntervalAlgebraic Interval a) => 
        [Interval a] -> [Interval a]
combineIntervals' :: [Interval a] -> [Interval a]
combineIntervals' [Interval a]
l = Box (Interval a) -> [Interval a]
forall a. Box a -> [a]
unBox (Box (Interval a) -> [Interval a])
-> Box (Interval a) -> [Interval a]
forall a b. (a -> b) -> a -> b
$ (Box (Interval a) -> Box (Interval a) -> Box (Interval a))
-> Box (Interval a) -> [Box (Interval a)] -> Box (Interval a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Box (Interval a) -> Box (Interval a) -> Box (Interval a)
forall a. Semigroup a => a -> a -> a
(<>) ([Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box []) ([Interval a] -> [Box (Interval a)]
forall a. [a] -> [Box a]
packBoxes [Interval a]
l)

-- Internal function for combining maybe intervals in the 'combineIntervals'' 
-- function
(<->) :: (IntervalCombinable i a) =>
       Maybe (i a)
    -> Maybe (i a)
    -> [i a]
<-> :: Maybe (i a) -> Maybe (i a) -> [i a]
(<->) Maybe (i a)
Nothing Maybe (i a)
Nothing   = []
(<->) Maybe (i a)
Nothing (Just i a
y)  = [i a
y]
(<->) (Just i a
x) Maybe (i a)
Nothing  = [i a
x]
(<->) (Just i a
x) (Just i a
y) = i a -> i a -> [i a]
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Semigroup (f (i a)), Applicative f) =>
i a -> i a -> f (i a)
(<+>) i a
x i a
y



-- | Given a predicate combinator, a predicate, and list of intervals, returns 
--   the input unchanged if the predicate combinator is @True@. Otherwise, returns
--   an empty list. See 'nothingIfAny' and 'nothingIfNone' for examples.
nothingIf :: (Monoid (f (i a)), Filterable f, IntervalAlgebraic i a)=>
     ((i a -> Bool) -> f (i a) -> Bool) -- ^ e.g. 'any' or 'all'
  -> (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIf :: ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
quantifier i a -> Bool
predicate f (i a)
x = if (i a -> Bool) -> f (i a) -> Bool
quantifier i a -> Bool
predicate f (i a)
x then Maybe (f (i a))
forall a. Maybe a
Nothing else f (i a) -> Maybe (f (i a))
forall a. a -> Maybe a
Just f (i a)
x

-- | Returns the 'Nothing' if *none* of the element of input satisfy
--   the predicate condition.
-- 
-- For example, the following returns 'Nothing' because none of the intervals
-- in the input list 'starts' (3, 5).
--
-- >>> nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]
-- Nothing
--
-- In the following, (3, 5) 'starts' (3, 6), so 'Just' the input is returned.
--
-- >>> nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]
-- Just [(3, 6),(5, 6)]
--
nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfNone :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfNone = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f, IntervalAlgebraic i a) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (\i a -> Bool
f f (i a)
x -> (Bool -> Bool
not(Bool -> Bool) -> (f (i a) -> Bool) -> f (i a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any i a -> Bool
f) f (i a)
x)

-- | Returns 'Nothing' if *any* of the element of input satisfy the predicate condition.
nothingIfAny :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAny :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfAny = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f, IntervalAlgebraic i a) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any

-- | Returns 'Nothing' if *all* of the element of input satisfy the predicate condition
nothingIfAll :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAll :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfAll = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f, IntervalAlgebraic i a) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all

{- | 
Filter functions provides means for filtering 'Filterable' containers of 
@'Intervallic i a'@s based on @'IntervalAlgebraic'@ relations.
-}

-- | Lifts a predicate to be able to compare two different 'IntervalAlgebraic' 
--   structure by comparing the intervals contain within each. 
compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
   ComparativePredicateOf (Interval a)
    -> i0 a
    -> i1 a
    -> Bool
compareIntervals :: ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool
compareIntervals ComparativePredicateOf (Interval a)
pf i0 a
x i1 a
y = ComparativePredicateOf (Interval a)
pf (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i1 a
y)

-- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s 
--   by comparing the @Interval a@s that of an @i0 a@. 
filterMaker :: (Filterable f
                , IntervalAlgebraic Interval a
                , IntervalAlgebraic i0 a
                , IntervalAlgebraic i1 a) =>
        ComparativePredicateOf (Interval a)
      -> i0 a
      -> (f (i1 a) -> f (i1 a))
filterMaker :: ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
f i0 a
p = (i1 a -> Bool) -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
Witherable.filter (ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool
compareIntervals ComparativePredicateOf (Interval a)
f i0 a
p)

-- | Filter by 'overlaps'.
filterOverlaps :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterOverlaps :: i0 a -> f (i1 a) -> f (i1 a)
filterOverlaps = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
overlaps

-- | Filter by 'overlappedBy'.
filterOverlappedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterOverlappedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterOverlappedBy = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
overlappedBy

-- | Filter by 'before'.
filterBefore :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterBefore :: i0 a -> f (i1 a) -> f (i1 a)
filterBefore = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
before

-- | Filter by 'after'.
filterAfter :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterAfter :: i0 a -> f (i1 a) -> f (i1 a)
filterAfter = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
after

-- | Filter by 'starts'.
filterStarts :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterStarts :: i0 a -> f (i1 a) -> f (i1 a)
filterStarts = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
starts

-- | Filter by 'startedBy'.
filterStartedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterStartedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterStartedBy = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
startedBy

-- | Filter by 'finishes'.
filterFinishes :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterFinishes :: i0 a -> f (i1 a) -> f (i1 a)
filterFinishes = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
finishes

-- | Filter by'finishedBy'.
filterFinishedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterFinishedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterFinishedBy = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
finishedBy

-- | Filter by 'meets'.
filterMeets :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterMeets :: i0 a -> f (i1 a) -> f (i1 a)
filterMeets = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
meets

-- | Filter by 'metBy'.
filterMetBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterMetBy :: i0 a -> f (i1 a) -> f (i1 a)
filterMetBy = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
metBy

-- | Filter by 'during'.
filterDuring :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterDuring :: i0 a -> f (i1 a) -> f (i1 a)
filterDuring = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
during

-- | Filter by 'contains'.
filterContains :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterContains :: i0 a -> f (i1 a) -> f (i1 a)
filterContains = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
contains

-- | Filter by 'equals'.
filterEquals :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEquals :: i0 a -> f (i1 a) -> f (i1 a)
filterEquals = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
equals

-- | Filter by 'disjoint'.
filterDisjoint :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterDisjoint :: i0 a -> f (i1 a) -> f (i1 a)
filterDisjoint = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
disjoint

-- | Filter by 'notDisjoint'.
filterNotDisjoint :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint :: i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
notDisjoint

-- | Filter by 'concur'.
filterConcur ::  (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterConcur :: i0 a -> f (i1 a) -> f (i1 a)
filterConcur = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
concur

-- | Filter by 'within'.
filterWithin :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterWithin :: i0 a -> f (i1 a) -> f (i1 a)
filterWithin = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
within

-- | Filter by 'enclose'.
filterEnclose :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEnclose :: i0 a -> f (i1 a) -> f (i1 a)
filterEnclose = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
enclose

-- | Filter by 'enclosedBy'.
filterEnclosedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEnclosedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterEnclosedBy = ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, IntervalAlgebraic Interval a,
 IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> f (i1 a) -> f (i1 a)
filterMaker ComparativePredicateOf (Interval a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
enclosedBy

-- | Folds over a list of Paired Intervals and in the case that the 'getPairData' 
--   is equal between two sequential meeting intervals, these two intervals are 
--   combined into one. This function is "safe" in the sense that if the input is
--   invalid and contains any sequential pairs of intervals with an @IntervalRelation@,
--   other than 'Meets', then the function returns an empty list. 
foldMeetingSafe :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>
           [ PairedInterval b a ] -- ^ Be sure this only contains intervals 
                                  --   that sequentially 'meets'.
        -> [ PairedInterval b a ]
foldMeetingSafe :: [PairedInterval b a] -> [PairedInterval b a]
foldMeetingSafe [PairedInterval b a]
l = [PairedInterval b a]
-> (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> Maybe (Meeting [PairedInterval b a])
-> [PairedInterval b a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a. Meeting a -> a
getMeeting (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a]
-> [PairedInterval b a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting) ([PairedInterval b a] -> Maybe (Meeting [PairedInterval b a])
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
[i a] -> Maybe (Meeting [i a])
parseMeeting [PairedInterval b a]
l)

-- | Folds over a list of Meeting Paired Intervals and in the case that the 'getPairData' 
--   is equal between two sequential meeting intervals, these two intervals are 
--   combined into one.  
foldMeeting :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>
            Meeting [PairedInterval b a ]
        ->  Meeting [PairedInterval b a ]
foldMeeting :: Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a]
l) = (Meeting [PairedInterval b a]
 -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a]
-> [Meeting [PairedInterval b a]]
-> Meeting [PairedInterval b a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
joinMeetingPairedInterval ([PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting []) ([PairedInterval b a] -> [Meeting [PairedInterval b a]]
forall a. [a] -> [Meeting [a]]
packMeeting [PairedInterval b a]
l)

-- This type identifies that @a@ contains intervals that sequentially meet one 
-- another.
newtype Meeting a = Meeting { Meeting a -> a
getMeeting :: a } deriving (Meeting a -> Meeting a -> Bool
(Meeting a -> Meeting a -> Bool)
-> (Meeting a -> Meeting a -> Bool) -> Eq (Meeting a)
forall a. Eq a => Meeting a -> Meeting a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meeting a -> Meeting a -> Bool
$c/= :: forall a. Eq a => Meeting a -> Meeting a -> Bool
== :: Meeting a -> Meeting a -> Bool
$c== :: forall a. Eq a => Meeting a -> Meeting a -> Bool
Eq, Int -> Meeting a -> ShowS
[Meeting a] -> ShowS
Meeting a -> String
(Int -> Meeting a -> ShowS)
-> (Meeting a -> String)
-> ([Meeting a] -> ShowS)
-> Show (Meeting a)
forall a. Show a => Int -> Meeting a -> ShowS
forall a. Show a => [Meeting a] -> ShowS
forall a. Show a => Meeting a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meeting a] -> ShowS
$cshowList :: forall a. Show a => [Meeting a] -> ShowS
show :: Meeting a -> String
$cshow :: forall a. Show a => Meeting a -> String
showsPrec :: Int -> Meeting a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Meeting a -> ShowS
Show)

-- Box up Meeting.
packMeeting :: [a] -> [Meeting [a]]
packMeeting :: [a] -> [Meeting [a]]
packMeeting = (a -> Meeting [a]) -> [a] -> [Meeting [a]]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\a
z -> [a] -> Meeting [a]
forall a. a -> Meeting a
Meeting [a
z])

-- Test a list of intervals to be sure they all meet; if not return Nothing.
parseMeeting :: (IntervalAlgebraic i a)=> [i a] -> Maybe (Meeting [i a])
parseMeeting :: [i a] -> Maybe (Meeting [i a])
parseMeeting [i a]
x
    | (IntervalRelation (i a) -> Bool)
-> [IntervalRelation (i a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( IntervalRelation (i a) -> IntervalRelation (i a) -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation (i a)
forall a. IntervalRelation a
Meets ) ([i a] -> [IntervalRelation (i a)]
forall (i :: * -> *) a (f :: * -> *).
(IntervalAlgebraic i a, Foldable f) =>
f (i a) -> [IntervalRelation (i a)]
relations [i a]
x) = Meeting [i a] -> Maybe (Meeting [i a])
forall a. a -> Maybe a
Just (Meeting [i a] -> Maybe (Meeting [i a]))
-> Meeting [i a] -> Maybe (Meeting [i a])
forall a b. (a -> b) -> a -> b
$ [i a] -> Meeting [i a]
forall a. a -> Meeting a
Meeting [i a]
x
    | Bool
otherwise = Maybe (Meeting [i a])
forall a. Maybe a
Nothing

-- A specific case of 'joinMeeting' for @PairedIntervals@.
joinMeetingPairedInterval :: (Eq b, Ord a, Show a) =>
                  Meeting [PairedInterval b a]
               -> Meeting [PairedInterval b a]
               -> Meeting [PairedInterval b a]
joinMeetingPairedInterval :: Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
joinMeetingPairedInterval = ComparativePredicateOf (PairedInterval b a)
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf (PairedInterval b a)
forall b a. Eq b => ComparativePredicateOf (PairedInterval b a)
equalPairData

-- A general function for combining any two @Meeting [i a]@ by 'listCombiner'.
joinMeeting :: (IntervalAlgebraic i a) =>
       ComparativePredicateOf (i a)
    -> Meeting [ i a ]
    -> Meeting [ i a ]
    -> Meeting [ i a ]
joinMeeting :: ComparativePredicateOf (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf (i a)
f (Meeting [i a]
x) (Meeting [i a]
y) = [i a] -> Meeting [i a]
forall a. a -> Meeting a
Meeting ([i a] -> Meeting [i a]) -> [i a] -> Meeting [i a]
forall a b. (a -> b) -> a -> b
$ (Maybe (i a) -> Maybe (i a) -> [i a]) -> [i a] -> [i a] -> [i a]
forall a. (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner (ComparativePredicateOf (i a) -> Maybe (i a) -> Maybe (i a) -> [i a]
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a) -> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf (i a)
f) [i a]
x [i a]
y

-- The intervals @x@ and @y@ should meet! The predicate function @p@ determines
-- when the two intervals that meet should be combined.
join2MeetingWhen :: (IntervalAlgebraic i a) =>
       ComparativePredicateOf (i a)
    -> Maybe (i a)
    -> Maybe (i a)
    -> [i a]
join2MeetingWhen :: ComparativePredicateOf (i a) -> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf (i a)
p Maybe (i a)
Nothing Maybe (i a)
Nothing   = []
join2MeetingWhen ComparativePredicateOf (i a)
p Maybe (i a)
Nothing (Just i a
y)  = [i a
y]
join2MeetingWhen ComparativePredicateOf (i a)
p (Just i a
x) Maybe (i a)
Nothing  = [i a
x]
join2MeetingWhen ComparativePredicateOf (i a)
p (Just i a
x) (Just i a
y)
    | ComparativePredicateOf (i a)
p i a
x i a
y      = [ i a -> Interval a -> i a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval i a
y (i a -> i a -> Interval a
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
i a -> i a -> Interval a
extenterval i a
x i a
y) ]
    | Bool
otherwise  =  i a -> [i a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure i a
x [i a] -> [i a] -> [i a]
forall a. Semigroup a => a -> a -> a
<> i a -> [i a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure i a
y

{- | 
Takes two *ordered* events, x <= y, and "disjoins" them in the case that the
two events have different states, creating a sequence (list) of new events that 
sequentially meet one another. Since x <= y, there are 7 possible interval
relations between x and y. If the states of x and y are equal and x is not 
before y, then x and y are combined into a single event. 
-}
disjoinPaired :: ( Eq b
                 , Monoid b
                 , IntervalAlgebraic (PairedInterval b) a
                 , IntervalSizeable a c) =>
       (PairedInterval b) a
    -> (PairedInterval b) a
    -> Meeting [(PairedInterval b) a]
disjoinPaired :: PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
disjoinPaired PairedInterval b a
o PairedInterval b a
e
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`before` PairedInterval b a
y      = [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ PairedInterval b a
x, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
e1 a
b2 b
forall a. Monoid a => a
mempty, PairedInterval b a
y ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`meets` PairedInterval b a
y       = Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ PairedInterval b a
x, PairedInterval b a
y ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`overlaps` PairedInterval b a
y    = Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
b2 a
e1 b
sc, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
e1 a
e2 b
s2 ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`finishedBy` PairedInterval b a
y  = Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i2 b
sc ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`contains` PairedInterval b a
y    = Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
b2 a
e2 b
sc, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
e2 a
e1 b
s1 ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`starts` PairedInterval b a
y      = Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(IntervalAlgebraic (PairedInterval b) a, Eq b) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i1 b
sc, a -> a -> b -> PairedInterval b a
forall b. a -> a -> b -> PairedInterval b a
evp a
e1 a
e2 b
s2 ]
   | PairedInterval b a
x ComparativePredicateOf (PairedInterval b a)
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
`equals` PairedInterval b a
y      = [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [ Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i1 b
sc ]
   where x :: PairedInterval b a
x  = PairedInterval b a -> PairedInterval b a -> PairedInterval b a
forall a. Ord a => a -> a -> a
min PairedInterval b a
o PairedInterval b a
e
         y :: PairedInterval b a
y  = PairedInterval b a -> PairedInterval b a -> PairedInterval b a
forall a. Ord a => a -> a -> a
max PairedInterval b a
o PairedInterval b a
e
         i1 :: Interval a
i1 = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
x
         i2 :: Interval a
i2 = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
y
         s1 :: b
s1 = PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
x
         s2 :: b
s2 = PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
y
         sc :: b
sc = b
s1 b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
s2
         b1 :: a
b1 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin PairedInterval b a
x
         b2 :: a
b2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin PairedInterval b a
y
         e1 :: a
e1 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end PairedInterval b a
x
         e2 :: a
e2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end PairedInterval b a
y
         ev :: Interval a -> b -> PairedInterval b a
ev = (b -> Interval a -> PairedInterval b a)
-> Interval a -> b -> PairedInterval b a
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> Interval a -> PairedInterval b a
forall b a. b -> Interval a -> PairedInterval b a
mkPairedInterval
         evp :: a -> a -> b -> PairedInterval b a
evp = \a
b a
e b
s -> Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev (c -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> c
forall a b. IntervalSizeable a b => a -> a -> b
diff a
e a
b) a
b) b
s

{- | 
The internal function for converting a non-disjoint, ordered sequence of
events into a disjoint, ordered sequence of events. The function operates
by recursion on a pair of events and the input events. The first of the 
is the accumulator set -- the disjoint events that need no longer be 
compared to input events. The second of the pair are disjoint events that
still need to be compared to be input events. 
-}
mtEvt :: ( Monoid b, Eq b, IntervalSizeable a c) =>
       ([(PairedInterval b) a ], [(PairedInterval b) a ])
    -> [(PairedInterval b) a ]
    -> [(PairedInterval b) a ]
mtEvt :: ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([PairedInterval b a]
acc, PairedInterval b a
o:[PairedInterval b a]
os) []     = [PairedInterval b a]
acc [PairedInterval b a]
-> [PairedInterval b a] -> [PairedInterval b a]
forall a. [a] -> [a] -> [a]
++ PairedInterval b a
oPairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
:[PairedInterval b a]
os           -- the "final" pattern
mtEvt ([PairedInterval b a]
acc, [])   []     = [PairedInterval b a]
acc                 -- another "final" pattern 
mtEvt ([PairedInterval b a]
acc, [])   (PairedInterval b a
e:[PairedInterval b a]
es) = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([PairedInterval b a]
acc, [PairedInterval b a
e]) [PairedInterval b a]
es -- the "initialize" pattern
mtEvt ([PairedInterval b a]
acc, PairedInterval b a
o:[PairedInterval b a]
os) (PairedInterval b a
e:[PairedInterval b a]
es)                       -- the "operating" patterns 
     -- If input event is equal to the first comparator, skip the comparison.
    | PairedInterval b a
e PairedInterval b a -> PairedInterval b a -> Bool
forall a. Eq a => a -> a -> Bool
== PairedInterval b a
o    = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([PairedInterval b a]
acc, PairedInterval b a
oPairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
:[PairedInterval b a]
os) [PairedInterval b a]
es

     {- If the period of o is either before or meets the period of e, then 
     the first of the combined events can be put into the accumulator. 
     That is, since the inputs events are ordered, once the beginning of o 
     is before or meets e, then we are assured that all periods up to the 
     beginning of o are fully disjoint and subsequent input events will 
     not overlap these in any way. -}
    | (PairedInterval b a -> PairedInterval b a -> Bool
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
before (PairedInterval b a -> PairedInterval b a -> Bool)
-> (PairedInterval b a -> PairedInterval b a -> Bool)
-> PairedInterval b a
-> PairedInterval b a
-> Bool
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
-> ComparativePredicateOf (i a) -> ComparativePredicateOf (i a)
<|> PairedInterval b a -> PairedInterval b a -> Bool
forall (i :: * -> *) a.
IntervalAlgebraic i a =>
ComparativePredicateOf (i a)
meets) PairedInterval b a
o PairedInterval b a
e = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([PairedInterval b a]
acc [PairedInterval b a]
-> [PairedInterval b a] -> [PairedInterval b a]
forall a. [a] -> [a] -> [a]
++ [PairedInterval b a]
nh, ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([], [PairedInterval b a]
nt) [PairedInterval b a]
os ) [PairedInterval b a]
es

    --The standard recursive operation.
    | Bool
otherwise = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([PairedInterval b a]
acc,  ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([], [PairedInterval b a]
n) [PairedInterval b a]
os ) [PairedInterval b a]
es
  where n :: [PairedInterval b a]
n  = Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a. Meeting a -> a
getMeeting (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
forall b a c.
(Eq b, Monoid b, IntervalAlgebraic (PairedInterval b) a,
 IntervalSizeable a c) =>
PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
disjoinPaired PairedInterval b a
o PairedInterval b a
e
        nh :: [PairedInterval b a]
nh = Maybe (PairedInterval b a) -> [PairedInterval b a]
forall a. Maybe a -> [a]
maybeToList ([PairedInterval b a] -> Maybe (PairedInterval b a)
forall a. [a] -> Maybe a
headMay [PairedInterval b a]
n)
        nt :: [PairedInterval b a]
nt = [PairedInterval b a] -> [PairedInterval b a]
forall a. [a] -> [a]
tailSafe [PairedInterval b a]
n

{- | 
Convert an ordered sequence of @PairedInterval b a@. that may have any interval relation
('before', 'starts', etc) into a sequence of sequentially meeting @PairedInterval b a@. 
That is, a sequence where one the end of one interval meets the beginning of 
the subsequent event. The 'getPairData' of the input @PairedIntervals@ are
combined using the Monoid '<>' function, hence the pair data must be a 
'Monoid' instance.
-}
formMeetingSequence :: ( Eq b
                       , Monoid b
                       , IntervalSizeable a c) =>
           [ PairedInterval b a ]
        -> [ PairedInterval b a ]
formMeetingSequence :: [PairedInterval b a] -> [PairedInterval b a]
formMeetingSequence [PairedInterval b a]
x = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([], []) (([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
mtEvt ([], []) [PairedInterval b a]
x) 
   -- the second pass of mtEvt is to handle the situation where the first pass
   -- disjoins all the events correctly into a meeting sequence but -- due to 
   -- nesting of intervals in the input -- some of the sequential pairs have
   -- the same data after the first pass. The second pass merges any sequential
   -- intervals that have the same data.
   --
   -- There is probably a more efficient way to do this.