{-|
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 Safe #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}


module IntervalAlgebra.IntervalUtilities
  (

    -- * Fold over sequential intervals
    combineIntervals
  , combineIntervalsL
  , 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
  , filterEnclose
  , 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', null, toList)
                                                , all
                                                , any
                                                , or
                                                )
import safe      Data.Function                  ( ($)
                                                , (.)
                                                , flip
                                                )
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
                                                , concur
                                                , contains
                                                , disjoint
                                                , during
                                                , enclose
                                                , enclosedBy
                                                , 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
                                                )


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

-- 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 :: (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 a
     , IntervalCombinable i1 a
     )
  => ((b -> Bool) -> t b -> Bool)
  -> (b -> b -> Bool)
  -> (b -> i0 a -> t (i1 a) -> Bool)
makeGapsWithinPredicate :: ((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 a, 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 a, 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 a, IntervalSizeable a b, IntervalCombinable i a)
  => [i a]
  -> [Maybe b]
pairGaps :: [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 a) =>
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 t. [t] -> [(t, t)]
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 :: [t] -> [(t, t)]
pairs = [t] -> [(t, t)]
forall t. [t] -> [(t, t)]
go
   where
    go :: [t] -> [(t, t)]
go []       = []
    go (t
x : [t]
xs) = (t -> (t, t)) -> [t] -> [(t, t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
x, ) [t]
xs [(t, t)] -> [(t, t)] -> [(t, t)]
forall a. Semigroup a => a -> a -> a
<> [t] -> [(t, t)]
go [t]
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 a, IntervalSizeable a b)
  => b   -- ^ lookback duration
  -> i a
  -> Interval a
lookback :: 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 a => 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 a, IntervalSizeable a b)
  => b   -- ^ lookahead duration
  -> i a
  -> Interval a
lookahead :: 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 a => 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 a
     , 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 :: 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 a, 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 a
     , 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 :: 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 a, 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 :: (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 [iv 1 0, iv 1 1] 
-- [Meets]
--
relationsL :: (Foldable f, Intervallic i a) => f (i a) -> [IntervalRelation]
relationsL :: f (i a) -> [IntervalRelation]
relationsL = f (i a) -> [IntervalRelation]
forall (f :: * -> *) (m :: * -> *) (i :: * -> *) a.
(Foldable f, Applicative m, Intervallic i a,
 Monoid (m IntervalRelation)) =>
f (i a) -> m IntervalRelation
relations

-- | A generic form of 'relations' which can output any 'Applicative' and 
--   'Monoid' structure.
--
-- >>> (relations [iv 1 0,iv 1 1]) :: [IntervalRelation]
-- [Meets]
--
--
relations
  :: (Foldable f, Applicative m, Intervallic i a, Monoid (m IntervalRelation))
  => f (i a)
  -> m IntervalRelation
relations :: 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 (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 (iv 5 0) (iv 2 3)
-- Just (3, 5)
--
intersect
  :: (Intervallic i a, IntervalSizeable a b) => i a -> i a -> Maybe (Interval a)
intersect :: i a -> i a -> Maybe (Interval a)
intersect i a
x i a
y | ComparativePredicateOf2 (i a) (i a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 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)

-- 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 :: 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 a => 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 a => 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.
--
-- >>> gaps [iv 4 1, iv 4 8, iv 3 11]
-- Nothing
--
gaps
  :: ( IntervalCombinable i a
     , Traversable f
     , Monoid (f (Maybe (Interval a)))
     , Applicative f
     )
  => f (i a)
  -> Maybe (f (Interval a))
gaps :: 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@.
gapsL
  :: ( IntervalCombinable i a
     , Applicative f
     , Monoid (f (Maybe (Interval a)))
     , Traversable f
     )
  => f (i a)
  -> [Interval a]
gapsL :: 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 [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
  :: (Intervallic i0 a, Intervallic i1 a, IntervalSizeable a b)
  => i0 a
  -> i1 a
  -> Maybe (Interval a)
clip :: i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
x i1 a
y
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 a => i a -> a
end i0 a
x) (i1 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i1 a
y)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 a => i a -> a
end i1 a
y) (i0 a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin i0 a
x)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i a => 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 a => 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 a => 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 (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
  jx :: ComparativePredicateOf2 (i0 a) (i1 a)
jx = ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 (iv 9 1) [iv 5 0, iv 2 7, iv 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 a
     , IntervalCombinable i1 a
     )
  => i0 a  -- ^ i
  -> f (i1 a) -- ^ x
  -> Maybe (f (Interval a))
gapsWithin :: 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 a) =>
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 a) =>
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 :: * -> *) a (i1 :: * -> *) b.
(Intervallic i0 a, Intervallic i1 a, IntervalSizeable a b) =>
i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
i) (i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
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 #-}

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

packIntervalBoxes :: (Intervallic i a) => [i a] -> [Box (Interval a)]
packIntervalBoxes :: [i a] -> [Box (Interval a)]
packIntervalBoxes = (i a -> Box (Interval a)) -> [i a] -> [Box (Interval a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i a
z -> [Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box [i a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i a
z])

instance (Ord a) => Semigroup (Box (Interval a)) where
  Box [Interval a]
x <> :: Box (Interval a) -> Box (Interval a) -> Box (Interval a)
<> Box [Interval a]
y = [Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box ([Interval a] -> Box (Interval a))
-> [Interval a] -> Box (Interval a)
forall a b. (a -> b) -> a -> b
$ (Maybe (Interval a) -> Maybe (Interval a) -> [Interval a])
-> [Interval a] -> [Interval a] -> [Interval a]
forall a. (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner Maybe (Interval a) -> Maybe (Interval a) -> [Interval a]
forall (i :: * -> *) a.
IntervalCombinable i a =>
Maybe (i a) -> Maybe (i a) -> [Interval a]
(<->) [Interval a]
x [Interval 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 'combineIntervalsL' 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
  :: ( Applicative f
     , Ord a
     , Intervallic i a
     , Monoid (f (Interval a))
     , Foldable f
     )
  => f (i a)
  -> f (Interval a)
combineIntervals :: f (i a) -> f (Interval a)
combineIntervals 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]
forall (i :: * -> *) a. Intervallic i a => [i a] -> [Interval a]
combineIntervalsL ([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)
  -- TODO: surely combineIntervals and combineIntervalsL could be combined
{-# INLINABLE combineIntervals #-}

-- | 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*. 
--
-- >>> combineIntervalsL [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
-- [(0, 12),(13, 15)]
--
combineIntervalsL :: (Intervallic i a) => [i a] -> [Interval a]
combineIntervalsL :: [i a] -> [Interval a]
combineIntervalsL [i 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 []) ([i a] -> [Box (Interval a)]
forall (i :: * -> *) a.
Intervallic i a =>
[i a] -> [Box (Interval a)]
packIntervalBoxes [i a]
l)
{-# INLINABLE combineIntervalsL #-}

-- |
-- 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 [beginerval 0 0, beginerval 0 (-1)]
-- Just (-1, 1)
-- >>> rangeInterval ([] :: [Interval Int])
-- Nothing
-- >>> rangeInterval (Just (beginerval 0 0))
-- Just (0, 1)
rangeInterval :: (Ord a, L.Foldable t) => t (Interval a) -> Maybe (Interval a)
rangeInterval :: 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 (i :: * -> *) a. Intervallic i a => 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)

-- Internal function for combining maybe intervals in the 'combineIntervalsL' 
-- function
(<->) :: (IntervalCombinable i a) => Maybe (i a) -> Maybe (i a) -> [Interval a]
<-> :: Maybe (i a) -> Maybe (i a) -> [Interval a]
(<->) Maybe (i a)
Nothing  Maybe (i a)
Nothing  = []
(<->) Maybe (i a)
Nothing  (Just i a
y) = [i a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i a
y]
(<->) (Just i a
x) Maybe (i a)
Nothing  = [i a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i a
x]
(<->) (Just i a
x) (Just i a
y) = Interval a -> Interval a -> [Interval a]
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Semigroup (f (i a)), Applicative f) =>
i a -> i a -> f (i a)
(<+>) (i a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i a
x) (i a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval i a
y)
{-# INLINABLE (<->) #-}

-- | 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 :: ((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)
  => (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) =>
((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 (iv 2 3)) [iv 3 3, iv 1 5]
-- Just [(3, 6),(5, 6)]
--
-- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 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 :: (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 (iv 2 3)) [iv 3 3, iv 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 :: (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 a, Intervallic i1 a)
  => ComparativePredicateOf2 (i0 a) (i1 a)
  -> i0 a
  -> (f (i1 a) -> f (i1 a))
makeFilter :: 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, filterEnclose, filterEnclosedBy
  :: (Filterable f, Intervallic i0 a, Intervallic i1 a)
  => i0 a
  -> f (i1 a)
  -> f (i1 a)
filterOverlaps :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
filterOverlappedBy :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
filterBefore :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
filterAfter :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after
filterStarts :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
filterStartedBy :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
filterFinishes :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
filterFinishedBy :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
filterMeets :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
filterMetBy :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
filterDuring :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
filterContains :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
filterEquals :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
filterDisjoint :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint
filterNotDisjoint :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint
filterConcur :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur
filterWithin :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within
filterEnclose :: i0 a -> f (i1 a) -> f (i1 a)
filterEnclose = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
enclose
filterEnclosedBy :: 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 :: * -> *) a (i1 :: * -> *).
(Filterable f, Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 :: [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 (i :: * -> *) a.
Intervallic 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
  :: (Eq b, Ord a, Show a)
  => 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 (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 :: Intervallic i a => [i a] -> Maybe (Meeting [i a])
parseMeeting :: [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 :: * -> *) (i :: * -> *) a.
(Foldable f, Intervallic i a) =>
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 :: 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 (i :: * -> *) a.
Intervallic i a =>
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
  :: Intervallic i a
  => ComparativePredicateOf1 (i a)
  -> Meeting [i a]
  -> Meeting [i a]
  -> Meeting [i a]
joinMeeting :: 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 (i :: * -> *) a.
Intervallic i a =>
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
  :: Intervallic i a
  => ComparativePredicateOf1 (i a)
  -> Maybe (i a)
  -> Maybe (i a)
  -> [i a]
join2MeetingWhen :: 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. Intervallic i a => i a -> Interval a -> i a
setInterval i a
y (i a -> i a -> Interval a
forall (i :: * -> *) a. Intervallic 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, Show 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 = case PairedInterval b a -> PairedInterval b a -> IntervalRelation
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b 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 b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b2 a
e1 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b 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 b.
IntervalSizeable a 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]
  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 b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b2 a
e2 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b 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 b. Interval a -> b -> PairedInterval b a
ev Interval a
i1 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b 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 b. Interval a -> b -> PairedInterval b 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 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
makePairedInterval
  evp :: a -> a -> b -> PairedInterval b a
evp a
b a
e = Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b 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 :: ([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 (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> PairedInterval b a -> PairedInterval b a -> Bool
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
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 :: [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 :: [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 :: * -> *) (i :: * -> *) a.
(Foldable f, Intervallic i a) =>
f (i a) -> [IntervalRelation]
relationsL [PairedInterval b a]
x)

hasEqData :: (Eq b) => [PairedInterval b a] -> Bool
hasEqData :: [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])