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

module IntervalAlgebra.IntervalUtilities (
      combineIntervals
    , gaps
    , durations
) where

import GHC.Base
    ( (++), map, foldr, otherwise, ($), (.), (<*>)
    , Semigroup((<>)), Functor(fmap))
import Prelude (uncurry, zip, Num)
import IntervalAlgebra( Interval, IntervalCombinable(..), IntervalSizeable(..) )
import Data.Maybe (mapMaybe)
import Data.List ( (++), null, any, head, init, last, tail )

-- | Box to avoid overlapping instances
newtype Box a = Box { Box a -> [a]
unBox :: [a] }
instance (IntervalCombinable 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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Interval a]
x         = [Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box [Interval a]
y
       | [Interval a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Interval a]
y         = [Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box [Interval a]
x
       | Bool
otherwise      = [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
$ [Interval a] -> [Interval a]
forall a. [a] -> [a]
init [Interval a]
x [Interval a] -> [Interval a] -> [Interval a]
forall a. [a] -> [a] -> [a]
++ (Interval a
lx Interval a -> Interval a -> [Interval a]
forall a (f :: * -> *).
(IntervalCombinable a, Semigroup (f (Interval a)),
 Applicative f) =>
Interval a -> Interval a -> f (Interval a)
<+> Interval a
fy) [Interval a] -> [Interval a] -> [Interval a]
forall a. [a] -> [a] -> [a]
++ [Interval a] -> [Interval a]
forall a. [a] -> [a]
tail [Interval a]
y
       where lx :: Interval a
lx = [Interval a] -> Interval a
forall a. [a] -> a
last [Interval a]
x
             fy :: Interval a
fy = [Interval a] -> Interval a
forall a. [a] -> a
head [Interval a]
y

-- | Returns a list of intervals where any intervals that meet or share support
--   are combined into one interval. *To work properly, the input list should 
--   be sorted*. 
combineIntervals :: (IntervalCombinable a) => [Interval a] -> [Interval a]
combineIntervals :: [Interval a] -> [Interval a]
combineIntervals [Interval a]
l = Box (Interval a) -> [Interval a]
forall a. Box a -> [a]
unBox (Box (Interval a) -> [Interval a])
-> Box (Interval a) -> [Interval a]
forall a b. (a -> b) -> a -> b
$ (Interval a -> Box (Interval a) -> Box (Interval a))
-> Box (Interval a) -> [Interval a] -> Box (Interval a)
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (Box (Interval a) -> Box (Interval a) -> Box (Interval a)
forall a. Semigroup a => a -> a -> a
(<>) (Box (Interval a) -> Box (Interval a) -> Box (Interval a))
-> (Interval a -> Box (Interval a))
-> Interval a
-> Box (Interval a)
-> Box (Interval a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Interval a
z -> [Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box [Interval a
z])) ([Interval a] -> Box (Interval a)
forall a. [a] -> Box a
Box []) [Interval a]
l

-- | Returns a (possibly empty) list of intervals consisting of the gaps between
--   intervals in the input list. *To work properly, the input list should be sorted*.
gaps :: (IntervalCombinable a) => [Interval a] -> [Interval a]
gaps :: [Interval a] -> [Interval a]
gaps [Interval a]
l = ((Interval a, Interval a) -> Maybe (Interval a))
-> [(Interval a, Interval a)] -> [Interval a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Interval a -> Interval a -> Maybe (Interval a))
-> (Interval a, Interval a) -> Maybe (Interval a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Interval a -> Interval a -> Maybe (Interval a)
forall a.
IntervalCombinable a =>
Interval a -> Interval a -> Maybe (Interval a)
(><)) (([Interval a] -> [Interval a] -> [(Interval a, Interval a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Interval a] -> [Interval a] -> [(Interval a, Interval a)])
-> ([Interval a] -> [Interval a])
-> [Interval a]
-> [(Interval a, Interval a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Interval a] -> [Interval a]
forall a. [a] -> [a]
tail) [Interval a]
l)

-- | Returns the 'duration' of each 'Interval' in the 'Functor' @f@.
durations :: (Functor f, IntervalSizeable a b) => f (Interval a) -> f b
durations :: f (Interval a) -> f b
durations = (Interval a -> b) -> f (Interval a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interval a -> b
forall a b. IntervalSizeable a b => Interval a -> b
duration