{-|
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

-}

{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module IntervalAlgebra.IntervalUtilities
  (

    -- * Fold over sequential intervals
    combineIntervals
  , combineIntervalsL
  , combineIntervalsFromSorted
  , combineIntervalsFromSortedL
  , rangeInterval
  , gaps
  , gapsL
  , gapsWithin

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

    -- * Withering functions

    -- ** Clear containers based on predicate
  , nothingIf
  , nothingIfNone
  , nothingIfAny
  , nothingIfAll

    -- ** Filter containers based on predicate
  , filterBefore
  , filterMeets
  , filterOverlaps
  , filterFinishedBy
  , filterContains
  , filterStarts
  , filterEquals
  , filterStartedBy
  , filterDuring
  , filterFinishes
  , filterOverlappedBy
  , filterMetBy
  , filterAfter
  , filterDisjoint
  , filterNotDisjoint
  , filterConcur
  , filterWithin
  , filterEncloses
  , filterEnclosedBy

    -- * Functions for manipulating intervals
  , lookback
  , lookahead

    -- * Gaps
  , makeGapsWithinPredicate
  , pairGaps
  , anyGapsWithinAtLeastDuration
  , allGapsWithinLessThanDuration

    -- * Misc utilities
  , relations
  , relationsL
  , intersect
  , clip
  , durations
  ) where

import safe           Control.Applicative            (Applicative (pure),
                                                      liftA2, (<$>), (<*>))
import qualified Control.Foldl                  as L
import safe           Control.Monad                  (Functor (fmap))
import safe           Data.Bool                      (Bool (..), not, otherwise,
                                                      (&&), (||))
import safe           Data.Eq                        (Eq ((==)))
import safe           Data.Foldable                  (Foldable (foldl', foldr, null, toList),
                                                      all, any, or)
import safe           Data.Function                  (flip, ($), (.))
import safe           Data.List                      (map, reverse, sortOn)
import safe           Data.Maybe                     (Maybe (..), maybe,
                                                      maybeToList)
import safe           Data.Monoid                    (Monoid (mempty))
import safe           Data.Ord                       (Ord (max, min), (<), (>=))
import safe           Data.Semigroup                 (Semigroup ((<>)))
import safe           Data.Traversable               (Traversable (sequenceA))
import safe           Data.Tuple                     (fst, uncurry)
import safe           GHC.Int                        (Int)
import safe           GHC.Show                       (Show)
import safe           IntervalAlgebra.Core           (ComparativePredicateOf1,
                                                      ComparativePredicateOf2,
                                                      Interval,
                                                      IntervalCombinable ((><)),
                                                      IntervalRelation (..),
                                                      IntervalSizeable (diff, duration),
                                                      Intervallic (..), after,
                                                      before, begin, beginerval,
                                                      beginervalFromEnd, bi,
                                                      concur, contains,
                                                      disjoint, during,
                                                      enclosedBy, encloses, end,
                                                      enderval,
                                                      endervalFromBegin, equals,
                                                      extenterval, finishedBy,
                                                      finishes, meets, metBy,
                                                      notDisjoint, overlappedBy,
                                                      overlaps, relate,
                                                      startedBy, starts, within,
                                                      (<|>))
import safe           IntervalAlgebra.PairedInterval (PairedInterval,
                                                      equalPairData,
                                                      getPairData,
                                                      makePairedInterval)
import safe           Safe                           (headMay, initSafe,
                                                      lastMay, tailSafe)
import safe           Witherable                     (Filterable (filter),
                                                      Witherable (..),
                                                      catMaybes, mapMaybe)

{- $setup
>>> import GHC.List ( (++), zip )
>>> import IntervalAlgebra.IntervalDiagram
>>> import Prettyprinter ( pretty )
-}

-------------------------------------------------
-- Unexported utilties used in functions below --
-------------------------------------------------

-- An internal utility function for creating a @Fold@ that maps over a structure
-- by consecutive pairs into a new structure.
makeFolder :: (Monoid (m b), Applicative m) => (a -> a -> b) -> L.Fold a (m b)
makeFolder :: forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder a -> a -> b
f = ((m b, Maybe a) -> a -> (m b, Maybe a))
-> (m b, Maybe a) -> ((m b, Maybe a) -> m b) -> Fold a (m b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (m b, Maybe a) -> a -> (m b, Maybe a)
forall {f :: * -> *}.
(Semigroup (f b), Applicative f) =>
(f b, Maybe a) -> a -> (f b, Maybe a)
step (m b, Maybe a)
forall {a}. (m b, Maybe a)
begin (m b, Maybe a) -> m b
forall {a} {b}. (a, b) -> a
done
 where
  begin :: (m b, Maybe a)
begin = (m b
forall a. Monoid a => a
mempty, Maybe a
forall a. Maybe a
Nothing)
  step :: (f b, Maybe a) -> a -> (f b, Maybe a)
step (f b
fs, Maybe a
Nothing) a
y = (f b
fs, a -> Maybe a
forall a. a -> Maybe a
Just a
y)
  step (f b
fs, Just a
x ) a
y = (f b
fs f b -> f b -> f b
forall a. Semigroup a => a -> a -> a
<> b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> b
f a
x a
y), a -> Maybe a
forall a. a -> Maybe a
Just a
y)
  done :: (a, b) -> a
done (a
fs, b
_) = a
fs

-- | Create a predicate function that checks whether within a provided spanning
--   interval, are there (e.g. any, all) gaps of (e.g. <, <=, >=, >) a specified
--   duration among  the input intervals?
makeGapsWithinPredicate
  :: ( Monoid (t (Interval a))
     , Monoid (t (Maybe (Interval a)))
     , Applicative t
     , Witherable.Witherable t
     , IntervalSizeable a b
     , Intervallic i0
     , IntervalCombinable i1 a
     )
  => ((b -> Bool) -> t b -> Bool)
  -> (b -> b -> Bool)
  -> (b -> i0 a -> t (i1 a) -> Bool)
makeGapsWithinPredicate :: forall (t :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
 Applicative t, Witherable t, IntervalSizeable a b, Intervallic i0,
 IntervalCombinable i1 a) =>
((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
f b -> b -> Bool
op b
gapDuration i0 a
interval t (i1 a)
l =
  Bool -> (t (Interval a) -> Bool) -> Maybe (t (Interval a)) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((b -> Bool) -> t b -> Bool
f (b -> b -> Bool
`op` b
gapDuration) (t b -> Bool) -> (t (Interval a) -> t b) -> t (Interval a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Interval a) -> t b
forall (f :: * -> *) (i :: * -> *) a b.
(Functor f, Intervallic i, IntervalSizeable a b) =>
f (i a) -> f b
durations) (i0 a -> t (i1 a) -> Maybe (t (Interval a))
forall (f :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Applicative f, Witherable f, Monoid (f (Interval a)),
 Monoid (f (Maybe (Interval a))), IntervalSizeable a b,
 Intervallic i0, IntervalCombinable i1 a) =>
i0 a -> f (i1 a) -> Maybe (f (Interval a))
gapsWithin i0 a
interval t (i1 a)
l)

-- | Gets the durations of gaps (via 'IntervalAlgebra.(><)') between all pairs
--   of the input.
pairGaps
  :: (Intervallic i, IntervalSizeable a b, IntervalCombinable i a)
  => [i a]
  -> [Maybe b]
pairGaps :: forall (i :: * -> *) a b.
(Intervallic i, IntervalSizeable a b, IntervalCombinable i a) =>
[i a] -> [Maybe b]
pairGaps [i a]
es = ((i a, i a) -> Maybe b) -> [(i a, i a)] -> [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((i a -> b) -> Maybe (i a) -> Maybe 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) =>
i a -> b
duration (Maybe (i a) -> Maybe b)
-> ((i a, i a) -> Maybe (i a)) -> (i a, i a) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> i a -> Maybe (i a)) -> (i a, i a) -> Maybe (i a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry i a -> i a -> Maybe (i a)
forall (i :: * -> *) a.
IntervalCombinable i a =>
i a -> i a -> Maybe (i a)
(><)) ([i a] -> [(i a, i a)]
forall {a}. [a] -> [(a, a)]
pairs [i a]
es)
-- Generate all pair-wise combinations of a single list.
-- pairs :: [a] -> [(a, a)]
-- copied from the hgeometry library
-- (https://hackage.haskell.org/package/hgeometry-0.12.0.4/docs/src/Data.Geometry.Arrangement.Internal.html#allPairs)
 where
  pairs :: [a] -> [(a, a)]
pairs = [a] -> [(a, a)]
forall {a}. [a] -> [(a, a)]
go
   where
    go :: [a] -> [(a, a)]
go []       = []
    go (a
x : [a]
xs) = (a -> (a, a)) -> [a] -> [(a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x, ) [a]
xs [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. Semigroup a => a -> a -> a
<> [a] -> [(a, a)]
go [a]
xs

-- | Creates a new @Interval@ of a provided lookback duration ending at the
--   'begin' of the input interval.
--
-- >>> lookback 4 (beginerval 10 (1 :: Int))
-- (-3, 1)
lookback
  :: (Intervallic i, IntervalSizeable a b)
  => b   -- ^ lookback duration
  -> i a
  -> Interval a
lookback :: forall (i :: * -> *) a b.
(Intervallic i, IntervalSizeable a b) =>
b -> i a -> Interval a
lookback b
d i a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x)

-- | Creates a new @Interval@ of a provided lookahead duration beginning at the
--   'end' of the input interval.
--
-- >>> lookahead 4 (beginerval 1 (1 :: Int))
-- (2, 6)
lookahead
  :: (Intervallic i, IntervalSizeable a b)
  => b   -- ^ lookahead duration
  -> i a
  -> Interval a
lookahead :: forall (i :: * -> *) a b.
(Intervallic i, IntervalSizeable a b) =>
b -> i a -> Interval a
lookahead b
d i a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
x)

-- | Within a provided spanning interval, are there any gaps of at least the
--   specified duration among the input intervals?
anyGapsWithinAtLeastDuration
  :: ( IntervalSizeable a b
     , Intervallic i0
     , IntervalCombinable i1 a
     , Monoid (t (Interval a))
     , Monoid (t (Maybe (Interval a)))
     , Applicative t
     , Witherable.Witherable t
     )
  => b       -- ^ duration of gap
  -> i0 a  -- ^ within this interval
  -> t (i1 a)
  -> Bool
anyGapsWithinAtLeastDuration :: forall a b (i0 :: * -> *) (i1 :: * -> *) (t :: * -> *).
(IntervalSizeable a b, Intervallic i0, IntervalCombinable i1 a,
 Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
 Applicative t, Witherable t) =>
b -> i0 a -> t (i1 a) -> Bool
anyGapsWithinAtLeastDuration = ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
forall (t :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
 Applicative t, Witherable t, IntervalSizeable a b, Intervallic i0,
 IntervalCombinable i1 a) =>
((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

-- | Within a provided spanning interval, are all gaps less than the specified
--   duration among the input intervals?
--
-- >>> allGapsWithinLessThanDuration 30 (beginerval 100 (0::Int)) [beginerval 5 (-1), beginerval 99 10]
-- True
allGapsWithinLessThanDuration
  :: ( IntervalSizeable a b
     , Intervallic i0
     , IntervalCombinable i1 a
     , Monoid (t (Interval a))
     , Monoid (t (Maybe (Interval a)))
     , Applicative t
     , Witherable.Witherable t
     )
  => b       -- ^ duration of gap
  -> i0 a  -- ^ within this interval
  -> t (i1 a)
  -> Bool
allGapsWithinLessThanDuration :: forall a b (i0 :: * -> *) (i1 :: * -> *) (t :: * -> *).
(IntervalSizeable a b, Intervallic i0, IntervalCombinable i1 a,
 Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
 Applicative t, Witherable t) =>
b -> i0 a -> t (i1 a) -> Bool
allGapsWithinLessThanDuration = ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
forall (t :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
 Applicative t, Witherable t, IntervalSizeable a b, Intervallic i0,
 IntervalCombinable i1 a) =>
((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(<)


-- 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 :: forall a. (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. Semigroup 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. Semigroup a => a -> a -> a
<> [a] -> [a]
forall a. [a] -> [a]
tailSafe [a]
y
{-# INLINABLE listCombiner #-}

-- | Returns a list of the 'IntervalRelation' between each consecutive pair
--   of intervals. This is just a specialized 'relations' which returns a list.
--
-- >>> relationsL [bi 1 0, bi 1 1]
-- [Meets]
--
relationsL
  :: (Foldable f, Ord a, Intervallic i) => f (i a) -> [IntervalRelation]
relationsL :: forall (f :: * -> *) a (i :: * -> *).
(Foldable f, Ord a, Intervallic i) =>
f (i a) -> [IntervalRelation]
relationsL = f (i a) -> [IntervalRelation]
forall (f :: * -> *) (m :: * -> *) a (i :: * -> *).
(Foldable f, Applicative m, Ord a, Intervallic i,
 Monoid (m IntervalRelation)) =>
f (i a) -> m IntervalRelation
relations

-- | A generic form of 'relations' which can output any 'Applicative' and
--   'Monoid' structure.
--
-- >>> (relations [bi 1 0,bi 1 1]) :: [IntervalRelation]
-- [Meets]
--
--
relations
  :: ( Foldable f
     , Applicative m
     , Ord a
     , Intervallic i
     , Monoid (m IntervalRelation)
     )
  => f (i a)
  -> m IntervalRelation
relations :: forall (f :: * -> *) (m :: * -> *) a (i :: * -> *).
(Foldable f, Applicative m, Ord a, Intervallic i,
 Monoid (m IntervalRelation)) =>
f (i a) -> m IntervalRelation
relations = Fold (i a) (m IntervalRelation) -> f (i a) -> m IntervalRelation
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((i a -> i a -> IntervalRelation) -> Fold (i a) (m IntervalRelation)
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder i a -> i a -> IntervalRelation
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate)
{-# INLINABLE relations #-}

-- | Forms a 'Just' new interval from the intersection of two intervals,
--   provided the intervals are not disjoint.
--
-- >>> intersect (bi 5 0) (bi 2 3)
-- Just (3, 5)
--
intersect
  :: (Intervallic i, IntervalSizeable a b) => i a -> i a -> Maybe (Interval a)
intersect :: forall (i :: * -> *) a b.
(Intervallic i, IntervalSizeable a b) =>
i a -> i a -> Maybe (Interval a)
intersect i a
x i a
y | ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 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 => i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => 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 => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
y)

-- Internal function which folds over a structure by consecutive pairs, returing
-- gaps between each pair (@Nothing@ if no such gap exists).
gapsM
  :: ( IntervalCombinable i a
     , Traversable f
     , Monoid (f (Maybe (Interval a)))
     , Applicative f
     )
  => f (i a)
  -> f (Maybe (Interval a))
gapsM :: forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
 Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> f (Maybe (Interval a))
gapsM = Fold (i a) (f (Maybe (Interval a)))
-> f (i a) -> f (Maybe (Interval a))
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((i a -> i a -> Maybe (Interval a))
-> Fold (i a) (f (Maybe (Interval a)))
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder (\i a
i i a
j -> i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
i Interval a -> Interval a -> Maybe (Interval a)
forall (i :: * -> *) a.
IntervalCombinable i a =>
i a -> i a -> Maybe (i a)
>< i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
j))
{-# INLINABLE gapsM #-}

{- | Returns a @Maybe@ container of intervals consisting of the gaps between
intervals in the input. __To work properly, the input should be sorted.__ See
'gapsL' for a version that always returns a list.

>>> x1 = bi 4 1
>>> x2 = bi 4 8
>>> x3 = bi 3 11
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(8, 12),(11, 14)]
>>> gaps ivs
Nothing
>>> pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []
 ----          <- [x1]
        ----   <- [x2]
           --- <- [x3]
==============

>>> x1 = bi 4 1
>>> x2 = bi 3 7
>>> x3 = bi 2 13
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(7, 10),(13, 15)]
>>> gapIvs = gaps ivs
>>> gapIvs
Just [(5, 7),(10, 13)]
>>> :{
case gapIvs of
  Nothing -> pretty ""
  (Just x) -> pretty $
    standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(x, "gapIvs")]
:}
 ----           <- [x1]
       ---      <- [x2]
             -- <- [x3]
     --   ---   <- [gapIvs]
===============
-}
gaps
  :: ( IntervalCombinable i a
     , Traversable f
     , Monoid (f (Maybe (Interval a)))
     , Applicative f
     )
  => f (i a)
  -> Maybe (f (Interval a))
gaps :: forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
 Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> Maybe (f (Interval a))
gaps = f (Maybe (Interval a)) -> Maybe (f (Interval a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (f (Maybe (Interval a)) -> Maybe (f (Interval a)))
-> (f (i a) -> f (Maybe (Interval a)))
-> f (i a)
-> Maybe (f (Interval a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (i a) -> f (Maybe (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
 Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> f (Maybe (Interval a))
gapsM
{-# INLINABLE gaps #-}

{- | 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@.

>>> x1 = bi 4 1
>>> x2 = bi 4 8
>>> x3 = bi 3 11
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(8, 12),(11, 14)]
>>> gapIvs = gapsL ivs
>>> gapIvs
[]
>>> :{
pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []
:}
 ----          <- [x1]
        ----   <- [x2]
           --- <- [x3]
==============

>>> x1 = bi 4 1
>>> x2 = bi 3 7
>>> x3 = bi 2 13
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(7, 10),(13, 15)]
>>> gapIvs = gapsL ivs
>>> gapIvs
[(5, 7),(10, 13)]
>>> :{
pretty $
  standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(gapIvs, "gapIvs")]
:}
 ----           <- [x1]
       ---      <- [x2]
             -- <- [x3]
     --   ---   <- [gapIvs]
===============
-}
gapsL
  :: ( IntervalCombinable i a
     , Applicative f
     , Monoid (f (Maybe (Interval a)))
     , Traversable f
     )
  => f (i a)
  -> [Interval a]
gapsL :: forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Applicative f,
 Monoid (f (Maybe (Interval a))), Traversable f) =>
f (i a) -> [Interval a]
gapsL f (i a)
x = [Interval a]
-> (f (Interval a) -> [Interval a])
-> Maybe (f (Interval a))
-> [Interval a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] f (Interval a) -> [Interval a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f (i a) -> Maybe (f (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
 Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> Maybe (f (Interval a))
gaps f (i a)
x)
{-# INLINABLE gapsL #-}

-- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@.
--
-- >>> durations [bi 9 1, bi 10 2, bi 1 5 :: Interval Int]
-- [9,10,1]
--
durations :: (Functor f, Intervallic i, IntervalSizeable a b) => f (i a) -> f b
durations :: forall (f :: * -> *) (i :: * -> *) a b.
(Functor f, Intervallic i, IntervalSizeable a b) =>
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) =>
i a -> b
duration

-- | In the case that x y are not disjoint, clips y to the extent of x.
--
-- >>> clip (bi 5 0) ((bi 3 3) :: Interval Int)
-- Just (3, 5)
--
-- >>> clip (bi 3 0) ((bi 2 4) :: Interval Int)
-- Nothing
--
clip
  :: (Intervallic i0, Intervallic i1, IntervalSizeable a b)
  => i0 a
  -> i1 a
  -> Maybe (Interval a)
clip :: forall (i0 :: * -> *) (i1 :: * -> *) a b.
(Intervallic i0, Intervallic i1, IntervalSizeable a b) =>
i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
x i1 a
y
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 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 (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x) (i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy i0 a
x i1 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 (i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
jx i0 a
x i1 a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
jy i0 a
x i1 a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y)
  | Bool
otherwise        = Maybe (Interval a)
forall a. Maybe a
Nothing {- disjoint x y case -}
 where
  jy :: ComparativePredicateOf2 (i0 a) (i1 a)
jy = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
  jx :: ComparativePredicateOf2 (i0 a) (i1 a)
jx = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
{-# INLINABLE clip #-}

-- | 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 all of the input intervals
-- are disjoint from the focal interval or if the input is empty, then 'Nothing'
-- is returned. When there are no gaps among the concurring intervals, then
-- @Just mempty@ (e.g. @Just []@) is returned.
--
-- >>> gapsWithin (bi 9 1) [bi 5 0, bi 2 7, bi 3 12]
-- Just [(5, 7),(9, 10)]
--
gapsWithin
  :: ( Applicative f
     , Witherable f
     , Monoid (f (Interval a))
     , Monoid (f (Maybe (Interval a)))
     , IntervalSizeable a b
     , Intervallic i0
     , IntervalCombinable i1 a
     )
  => i0 a  -- ^ i
  -> f (i1 a) -- ^ x
  -> Maybe (f (Interval a))
gapsWithin :: forall (f :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Applicative f, Witherable f, Monoid (f (Interval a)),
 Monoid (f (Maybe (Interval a))), IntervalSizeable a b,
 Intervallic i0, IntervalCombinable i1 a) =>
i0 a -> f (i1 a) -> Maybe (f (Interval a))
gapsWithin i0 a
i f (i1 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)
res
 where
  s :: f (Interval a)
s   = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> i0 a -> Interval a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
endervalFromBegin b
0 i0 a
i)
  e :: f (Interval a)
e   = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> i0 a -> Interval a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
beginervalFromEnd b
0 i0 a
i)
  ivs :: f (Interval a)
ivs = (i1 a -> Maybe (Interval a)) -> f (i1 a) -> f (Interval a)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (i0 a -> i1 a -> Maybe (Interval a)
forall (i0 :: * -> *) (i1 :: * -> *) a b.
(Intervallic i0, Intervallic i1, IntervalSizeable a b) =>
i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
i) (i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint i0 a
i f (i1 a)
x)
  res :: f (Interval a)
res = f (Maybe (Interval a)) -> f (Interval a)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (f (Maybe (Interval a)) -> f (Interval a))
-> f (Maybe (Interval a)) -> f (Interval a)
forall a b. (a -> b) -> a -> b
$ f (Interval a) -> f (Maybe (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
 Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> f (Maybe (Interval a))
gapsM (f (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
<> f (Interval a)
e)
{-# INLINABLE gapsWithin #-}

{- | Returns a container of intervals where any intervals that meet or share
support are combined into one interval. This functions sorts the input intervals
first. See @combineIntervalsL@ for a version that works only on lists. If you
know the input intervals are sorted, use @combineIntervalsFromSorted@ instead.

>>> x1 = bi 10 0
>>> x2 = bi 5 2
>>> x3 = bi 2 10
>>> x4 = bi 2 13
>>> ivs = [x1, x2, x3, x4]
>>> ivs
[(0, 10),(2, 7),(10, 12),(13, 15)]
>>> xComb = combineIntervals ivs
>>> xComb
[(0, 12),(13, 15)]
>>> :{
pretty $
  standardExampleDiagram
    (zip ivs ["x1", "x2", "x3", "x4"])
    [(xComb, "xComb")]
:}
----------      <- [x1]
  -----         <- [x2]
          --    <- [x3]
             -- <- [x4]
------------ -- <- [xComb]
===============
-}
combineIntervals
  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
  => f (i a)
  -> f (Interval a)
combineIntervals :: forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
 Foldable f) =>
f (i a) -> f (Interval a)
combineIntervals = ([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
 Foldable f) =>
([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
forall (i :: * -> *) a.
(Intervallic i, Ord a) =>
[i a] -> [Interval a]
combineIntervalsL

{- | Returns a container of intervals where any intervals that meet or share
support are combined into one interval. The condition is applied cumulatively,
from left to right, so
__to work properly, the input list should be sorted in increasing order__. See
@combineIntervalsLFromSorted@ for a version that works only on lists.

>>> combineIntervalsFromSorted [bi 10 0, bi 5 2, bi 2 10, bi 2 13]
[(0, 12),(13, 15)]
-}
combineIntervalsFromSorted
  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
  => f (i a)
  -> f (Interval a)
combineIntervalsFromSorted :: forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
 Foldable f) =>
f (i a) -> f (Interval a)
combineIntervalsFromSorted = ([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
 Foldable f) =>
([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> [Interval a]
combineIntervalsFromSortedL

-- | Unexported helper
combineIntervalsWith
  :: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
  => ([i a] -> [Interval a])
  -> f (i a)
  -> f (Interval a)
combineIntervalsWith :: forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
 Foldable f) =>
([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
f f (i a)
x = (f (Interval a) -> Interval a -> f (Interval a))
-> f (Interval a) -> [Interval a] -> f (Interval a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\f (Interval a)
x Interval a
y -> f (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) f (Interval a)
forall a. Monoid a => a
mempty ([i a] -> [Interval a]
f ([i a] -> [Interval a]) -> [i a] -> [Interval a]
forall a b. (a -> b) -> a -> b
$ f (i a) -> [i a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (i a)
x)

{- | Returns a list of intervals where any intervals that meet or share support
are combined into one interval. This function sorts the input. If you know the
input intervals are sorted, use @combineIntervalsLFromSorted@.

>>> x1 = bi 10 0
>>> x2 = bi 5 2
>>> x3 = bi 2 10
>>> x4 = bi 2 13
>>> ivs = [x1, x2, x3, x4]
>>> ivs
[(0, 10),(2, 7),(10, 12),(13, 15)]
>>> xComb = combineIntervalsL ivs
>>> xComb
[(0, 12),(13, 15)]
>>> :{
pretty $
  standardExampleDiagram
    (zip ivs ["x1", "x2", "x3", "x4"])
    [(xComb, "xComb")]
:}
----------      <- [x1]
  -----         <- [x2]
          --    <- [x3]
             -- <- [x4]
------------ -- <- [xComb]
===============
-}
combineIntervalsL :: (Intervallic i, Ord a) => [i a] -> [Interval a]
combineIntervalsL :: forall (i :: * -> *) a.
(Intervallic i, Ord a) =>
[i a] -> [Interval a]
combineIntervalsL = [i a] -> [Interval a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> [Interval a]
combineIntervalsFromSortedL ([i a] -> [Interval a])
-> ([i a] -> [i a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> Interval a) -> [i a] -> [i a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval

{- | Returns a list of intervals where any intervals that meet or share support
are combined into one interval. The operation is applied cumulatively, from left
to right, so
__to work properly, the input list should be sorted in increasing order__.

>>> combineIntervalsFromSortedL [bi 10 0, bi 5 2, bi 2 10, bi 2 13]
[(0, 12),(13, 15)]

>>> combineIntervalsFromSortedL [bi 10 0, bi 5 2, bi 0 8]
[(0, 10)]
-}
combineIntervalsFromSortedL
  :: forall a i . (Ord a, Intervallic i) => [i a] -> [Interval a]
combineIntervalsFromSortedL :: forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> [Interval a]
combineIntervalsFromSortedL = [Interval a] -> [Interval a]
forall a. [a] -> [a]
reverse ([Interval a] -> [Interval a])
-> ([i a] -> [Interval a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Interval a] -> i a -> [Interval a])
-> [Interval a] -> [i a] -> [Interval a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Interval a] -> i a -> [Interval a]
forall {i1 :: * -> *} {a}.
(Ord a, Intervallic i1) =>
[Interval a] -> i1 a -> [Interval a]
op []
 where
  op :: [Interval a] -> i1 a -> [Interval a]
op []       i1 a
y = [i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y]
  op (Interval a
x : [Interval a]
xs) i1 a
y = if Interval a
x ComparativePredicateOf2 (Interval a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` i1 a
y
    -- Since x <= y, not (x `before` y) iff they meet or share support
    then Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: Interval a
x Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
    else Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval Interval a
x Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
    where yiv :: Interval a
yiv = i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y

{- | @Maybe@ form an @Interval a@ from @Control.Foldl t => t (Interval a)@
spanning the range of all intervals in the list, i.e. whose @begin@ is the
minimum of @begin@ across intervals in the list and whose @end@ is the maximum
of @end@.

>>> rangeInterval ([] :: [Interval Int])
Nothing

>>> x1 = bi 2 2
>>> x2 = bi 3 6
>>> x3 = bi 4 7
>>> ivs = [x1, x2, x3] :: [Interval Int]
>>> ivs
[(2, 4),(6, 9),(7, 11)]
>>> spanIv = rangeInterval ivs
>>> spanIv
Just (2, 11)
>>> :{
case spanIv of
  Nothing -> pretty ""
  (Just x) -> pretty $ standardExampleDiagram
    (zip (ivs ++ [x]) ["x1", "x2", "x3", "spanIv"])
    []
:}
  --        <- [x1]
      ---   <- [x2]
       ---- <- [x3]
  --------- <- [spanIv]
===========

>>> rangeInterval Nothing
Nothing
>>> rangeInterval (Just (bi 1 0))
Just (0, 1)
-}
rangeInterval :: (Ord a, L.Foldable t) => t (Interval a) -> Maybe (Interval a)
rangeInterval :: forall a (t :: * -> *).
(Ord a, Foldable t) =>
t (Interval a) -> Maybe (Interval a)
rangeInterval = Fold (Interval a) (Maybe (Interval a))
-> t (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((Interval a -> Interval a -> Interval a)
-> Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval (Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.minimum Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.maximum)

-- | 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)
  => ((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 :: forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f) =>
((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 (bi 2 3)) [bi 1 3, bi 1 5]
-- Nothing
--
-- In the following, (3, 5) 'starts' (3, 6), so 'Just' the input is returned.
--
-- >>> nothingIfNone (starts (bi 2 3)) [bi 3 3, bi 1 5]
-- Just [(3, 6),(5, 6)]
--
nothingIfNone
  :: (Monoid (f (i a)), Foldable f, Filterable f)
  => (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfNone :: forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Foldable f, Filterable f) =>
(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) =>
((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 (startedBy (bi 2 3)) [bi 3 3, bi 1 5]
-- Just [(3, 6),(5, 6)]
--
-- >>> nothingIfAny (starts (bi 2 3)) [bi 3 3, bi 1 5]
-- Nothing
--
nothingIfAny
  :: (Monoid (f (i a)), Foldable f, Filterable f)
  => (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAny :: forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Foldable f, Filterable f) =>
(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) =>
((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 (starts (bi 2 3)) [bi 3 3, bi 4 3]
-- Nothing
--
nothingIfAll
  :: (Monoid (f (i a)), Foldable f, Filterable f)
  => (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAll :: forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Foldable f, Filterable f) =>
(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) =>
((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

-- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s
--   by comparing the @Interval a@s that of an @i0 a@.
makeFilter
  :: (Filterable f, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
  -> i0 a
  -> (f (i1 a) -> f (i1 a))
makeFilter :: forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 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 (ComparativePredicateOf2 (i0 a) (i1 a)
f i0 a
p)

{- |
Filter 'Witherable.Filterable' containers of one @'Intervallic'@ type based by comparing to
a (potentially different) 'Intervallic' type using the corresponding interval
predicate function.
-}
filterOverlaps, filterOverlappedBy, filterBefore, filterAfter, filterStarts, filterStartedBy, filterFinishes, filterFinishedBy, filterMeets, filterMetBy, filterDuring, filterContains, filterEquals, filterDisjoint, filterNotDisjoint, filterConcur, filterWithin, filterEncloses, filterEnclosedBy
  :: (Filterable f, Ord a, Intervallic i0, Intervallic i1)
  => i0 a
  -> f (i1 a)
  -> f (i1 a)
filterOverlaps :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterOverlaps = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
filterOverlappedBy :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterOverlappedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
filterBefore :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterBefore = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
filterAfter :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterAfter = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after
filterStarts :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterStarts = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
filterStartedBy :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterStartedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
filterFinishes :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterFinishes = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
filterFinishedBy :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterFinishedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
filterMeets :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterMeets = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
filterMetBy :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterMetBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
filterDuring :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterDuring = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
filterContains :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterContains = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
filterEquals :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterEquals = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
filterDisjoint :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterDisjoint = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint
filterNotDisjoint :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint
filterConcur :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterConcur = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur
filterWithin :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterWithin = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within
filterEncloses :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterEncloses = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
encloses
filterEnclosedBy :: forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterEnclosedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 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
  :: (Eq b, Ord a, Show a)
  => [PairedInterval b a] -- ^ Be sure this only contains intervals
                                  --   that sequentially 'meets'.
  -> [PairedInterval b a]
foldMeetingSafe :: forall b a.
(Eq b, Ord a, Show a) =>
[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.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting) ([PairedInterval b a] -> Maybe (Meeting [PairedInterval b a])
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[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
  :: (Eq b, Ord a, Show a)
  => Meeting [PairedInterval b a]
  -> Meeting [PairedInterval b a]
foldMeeting :: forall b a.
(Eq b, Ord a, Show a) =>
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 { forall a. 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 :: forall a. [a] -> [Meeting [a]]
packMeeting = (a -> Meeting [a]) -> [a] -> [Meeting [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\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 :: (Ord a, Intervallic i) => [i a] -> Maybe (Meeting [i a])
parseMeeting :: forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> Maybe (Meeting [i a])
parseMeeting [i a]
x | (IntervalRelation -> Bool) -> [IntervalRelation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Meets) ([i a] -> [IntervalRelation]
forall (f :: * -> *) a (i :: * -> *).
(Foldable f, Ord a, Intervallic i) =>
f (i a) -> [IntervalRelation]
relationsL [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 :: forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
joinMeetingPairedInterval = ComparativePredicateOf1 (PairedInterval b a)
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf1 (PairedInterval b a)
forall b a. Eq b => ComparativePredicateOf1 (PairedInterval b a)
equalPairData

-- A general function for combining any two @Meeting [i a]@ by 'listCombiner'.
joinMeeting
  :: (Ord a, Intervallic i)
  => ComparativePredicateOf1 (i a)
  -> Meeting [i a]
  -> Meeting [i a]
  -> Meeting [i a]
joinMeeting :: forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf1 (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 (ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf1 (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
  :: (Ord a, Intervallic i)
  => ComparativePredicateOf1 (i a)
  -> Maybe (i a)
  -> Maybe (i a)
  -> [i a]
join2MeetingWhen :: forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf1 (i a)
p Maybe (i a)
Nothing  Maybe (i a)
Nothing  = []
join2MeetingWhen ComparativePredicateOf1 (i a)
p Maybe (i a)
Nothing  (Just i a
y) = [i a
y]
join2MeetingWhen ComparativePredicateOf1 (i a)
p (Just i a
x) Maybe (i a)
Nothing  = [i a
x]
join2MeetingWhen ComparativePredicateOf1 (i a)
p (Just i a
x) (Just i a
y) | ComparativePredicateOf1 (i a)
p i a
x i a
y = [i a -> Interval a -> i a
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
y (i a -> i a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
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, Show a, IntervalSizeable a c)
  => (PairedInterval b) a
  -> (PairedInterval b) a
  -> Meeting [(PairedInterval b) a]
disjoinPaired :: forall b a c.
(Eq b, Monoid b, Show a, IntervalSizeable a c) =>
PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
disjoinPaired PairedInterval b a
o PairedInterval b a
e = case PairedInterval b a -> PairedInterval b a -> IntervalRelation
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate PairedInterval b a
x PairedInterval b a
y of
  IntervalRelation
Before     -> [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [PairedInterval b a
x, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
e1 a
b2 b
forall a. Monoid a => a
mempty, PairedInterval b a
y]
  IntervalRelation
Meets      -> 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]
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]
  IntervalRelation
Overlaps   -> 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]
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 {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
b2 a
e1 b
sc, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
e1 a
e2 b
s2]
  IntervalRelation
FinishedBy -> 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]
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 {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
b1 a
b2 b
s1, Interval a -> b -> PairedInterval b a
forall {a} {a}. Interval a -> a -> PairedInterval a a
ev Interval a
i2 b
sc]
  IntervalRelation
Contains   -> 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]
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 {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
b2 a
e2 b
sc, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
e2 a
e1 b
s1]
  IntervalRelation
Starts     -> 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]
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} {a}. Interval a -> a -> PairedInterval a a
ev Interval a
i1 b
sc, a -> a -> b -> PairedInterval b a
forall {a} {b} {a}.
IntervalSizeable a b =>
a -> a -> a -> PairedInterval a a
evp a
e1 a
e2 b
s2]
  IntervalRelation
_          -> [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [Interval a -> b -> PairedInterval b a
forall {a} {a}. Interval a -> a -> PairedInterval a a
ev Interval a
i1 b
sc] {- Equals case -}
 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 => i a -> Interval a
getInterval PairedInterval b a
x
  i2 :: Interval a
i2 = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i => 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 => i a -> a
begin PairedInterval b a
x
  b2 :: a
b2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin PairedInterval b a
y
  e1 :: a
e1 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end PairedInterval b a
x
  e2 :: a
e2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end PairedInterval b a
y
  ev :: Interval a -> a -> PairedInterval a a
ev = (a -> Interval a -> PairedInterval a a)
-> Interval a -> a -> PairedInterval a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Interval a -> PairedInterval a a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval
  evp :: a -> a -> a -> PairedInterval a a
evp a
b a
e = Interval a -> a -> PairedInterval a a
forall {a} {a}. Interval a -> a -> PairedInterval a a
ev (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)
{-# INLINABLE disjoinPaired #-}

{- |
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.
-}
recurseDisjoin
  :: (Monoid b, Eq b, IntervalSizeable a c, Show a)
  => ([(PairedInterval b) a], [(PairedInterval b) a])
  -> [(PairedInterval b) a]
  -> [(PairedInterval b) a]
recurseDisjoin :: forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([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. Semigroup a => a -> a -> a
<> (PairedInterval b a
o PairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
: [PairedInterval b a]
os)           -- the "final" pattern
recurseDisjoin ([PairedInterval b a]
acc, []    ) []       = [PairedInterval b a]
acc                 -- another "final" pattern
recurseDisjoin ([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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, [PairedInterval b a
e]) [PairedInterval b a]
es -- the "initialize" pattern
recurseDisjoin ([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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, PairedInterval b a
o PairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
: [PairedInterval b a]
os) [PairedInterval b a]
es
  |

     {- If o is either before or meets 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 a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before (PairedInterval b a -> PairedInterval b a -> Bool)
-> (PairedInterval b a -> PairedInterval b a -> Bool)
-> PairedInterval b a
-> PairedInterval b a
-> Bool
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> PairedInterval b a -> PairedInterval b a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin
    ([PairedInterval b a]
acc [PairedInterval b a]
-> [PairedInterval b a] -> [PairedInterval b a]
forall a. Semigroup 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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], [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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([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, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], [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, Show 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
{-# INLINABLE recurseDisjoin #-}

{- |
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, Show a, Monoid b, IntervalSizeable a c)
  => [PairedInterval b a]
  -> [PairedInterval b a]
formMeetingSequence :: forall b a c.
(Eq b, Show a, Monoid b, IntervalSizeable a c) =>
[PairedInterval b a] -> [PairedInterval b a]
formMeetingSequence [PairedInterval b a]
x
  | [PairedInterval b a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PairedInterval b a]
x = []
  | [PairedInterval b a] -> Bool
forall a b. Ord a => [PairedInterval b a] -> Bool
allMeet [PairedInterval b a]
x Bool -> Bool -> Bool
&& Bool -> Bool
not ([PairedInterval b a] -> Bool
forall b a. Eq b => [PairedInterval b a] -> Bool
hasEqData [PairedInterval b a]
x) = [PairedInterval b a]
x
  | Bool
otherwise = [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Eq b, Show a, Monoid b, IntervalSizeable a c) =>
[PairedInterval b a] -> [PairedInterval b a]
formMeetingSequence (([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], []) [PairedInterval b a]
x)
  -- recurseDisjoin ([], []) (recurseDisjoin ([], []) (recurseDisjoin ([], []) x))

   -- the multiple passes of recurseDisjoin is to handle the situation where the
   -- initial passes almost 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 recursive passes merges any sequential
   -- intervals that have the same data.
   --
   -- There is probably a more efficient way to do this
{-# INLINABLE formMeetingSequence #-}

allMeet :: (Ord a) => [PairedInterval b a] -> Bool
allMeet :: forall a b. Ord a => [PairedInterval b a] -> Bool
allMeet [PairedInterval b a]
x = (IntervalRelation -> Bool) -> [IntervalRelation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Meets) ([PairedInterval b a] -> [IntervalRelation]
forall (f :: * -> *) a (i :: * -> *).
(Foldable f, Ord a, Intervallic i) =>
f (i a) -> [IntervalRelation]
relationsL [PairedInterval b a]
x)

hasEqData :: (Eq b) => [PairedInterval b a] -> Bool
hasEqData :: forall b a. Eq b => [PairedInterval b a] -> Bool
hasEqData [PairedInterval b a]
x = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Fold b [Bool] -> [b] -> [Bool]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((b -> b -> Bool) -> Fold b [Bool]
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((PairedInterval b a -> b) -> [PairedInterval b a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData [PairedInterval b a]
x) :: [Bool])