{-|
Module      : Paired interval 
Description : Extends the Interval Algebra to an interval paired with some data.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
Stability   : experimental
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}

module IntervalAlgebra.PairedInterval (
      PairedInterval
    , mkPairedInterval
    , pairData
    , intervals
    , makePairPredicate
) where

import IntervalAlgebra
    ( Interval
    , Intervallic(..)
    , IntervalAlgebraic(..)
    , ComparativePredicateOf )
import IntervalAlgebra.IntervalUtilities(compareIntervals, filterOverlaps)
import Witherable ( Filterable(filter) )

-- | An @Interval a@ paired with some other data of type @b@.
newtype PairedInterval b a = PairedInterval (Interval a, b)
    deriving (PairedInterval b a -> PairedInterval b a -> Bool
(PairedInterval b a -> PairedInterval b a -> Bool)
-> (PairedInterval b a -> PairedInterval b a -> Bool)
-> Eq (PairedInterval b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a.
(Eq a, Eq b) =>
PairedInterval b a -> PairedInterval b a -> Bool
/= :: PairedInterval b a -> PairedInterval b a -> Bool
$c/= :: forall b a.
(Eq a, Eq b) =>
PairedInterval b a -> PairedInterval b a -> Bool
== :: PairedInterval b a -> PairedInterval b a -> Bool
$c== :: forall b a.
(Eq a, Eq b) =>
PairedInterval b a -> PairedInterval b a -> Bool
Eq)

instance (Ord a, Show a) => Intervallic (PairedInterval b) a where
    getInterval :: PairedInterval b a -> Interval a
getInterval (PairedInterval (Interval a, b)
x)        = (Interval a, b) -> Interval a
forall a b. (a, b) -> a
fst (Interval a, b)
x
    setInterval :: PairedInterval b a -> Interval a -> PairedInterval b a
setInterval (PairedInterval (Interval a
x, b
y)) Interval a
i = (Interval a, b) -> PairedInterval b a
forall b a. (Interval a, b) -> PairedInterval b a
PairedInterval (Interval a
i, b
y)

-- | Defines A total ordering on 'PairedInterval b a' based on the 'Interval a'
--   part.
instance (Eq a, Eq b, Ord a, Show a) => Ord (PairedInterval b a) where
  <= :: PairedInterval b a -> PairedInterval b a -> Bool
(<=) PairedInterval b a
x PairedInterval b a
y = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
x Interval a -> Interval a -> Bool
forall a. Ord a => a -> a -> Bool
<= PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
y
  < :: PairedInterval b a -> PairedInterval b a -> Bool
(<) PairedInterval b a
x PairedInterval b a
y  = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
x Interval a -> Interval a -> Bool
forall a. Ord a => a -> a -> Bool
<  PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval PairedInterval b a
y

instance (Eq b) => IntervalAlgebraic (PairedInterval b) Int 

-- | Make a paired interval. 
mkPairedInterval :: b -> Interval a -> PairedInterval b a
mkPairedInterval :: b -> Interval a -> PairedInterval b a
mkPairedInterval b
d Interval a
i = (Interval a, b) -> PairedInterval b a
forall b a. (Interval a, b) -> PairedInterval b a
PairedInterval (Interval a
i, b
d)

-- | Gets the data (i.e. non-interval) part of a @PairedInterval@.
pairData :: PairedInterval b a -> b
pairData :: PairedInterval b a -> b
pairData (PairedInterval (Interval a
_, b
y)) = b
y

-- | Gets the intervals from a list of paired intervals.
intervals :: (Ord a, Show a) => [PairedInterval b a] -> [Interval a]
intervals :: [PairedInterval b a] -> [Interval a]
intervals = (PairedInterval b a -> Interval a)
-> [PairedInterval b a] -> [Interval a]
forall a b. (a -> b) -> [a] -> [b]
map PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval

-- | Takes a predicate of intervals and a predicate on the data part of a 
--   paired interval to create a single predicate such that both input
--   predicates should hold.
makePairPredicate :: (IntervalAlgebraic (PairedInterval b) a) =>
       ComparativePredicateOf (Interval a)
    -> ComparativePredicateOf b
    -> ComparativePredicateOf (PairedInterval b a)
makePairPredicate :: ComparativePredicateOf (Interval a)
-> ComparativePredicateOf b
-> ComparativePredicateOf (PairedInterval b a)
makePairPredicate ComparativePredicateOf (Interval a)
intervalPredicate ComparativePredicateOf b
dataPredicate PairedInterval b a
x PairedInterval b a
y =
         ComparativePredicateOf (Interval a)
-> ComparativePredicateOf (PairedInterval b a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
ComparativePredicateOf (Interval a) -> i0 a -> i1 a -> Bool
compareIntervals ComparativePredicateOf (Interval a)
intervalPredicate PairedInterval b a
x PairedInterval b a
y Bool -> Bool -> Bool
&&
         ComparativePredicateOf b
dataPredicate (PairedInterval b a -> b
forall b a. PairedInterval b a -> b
pairData PairedInterval b a
x) (PairedInterval b a -> b
forall b a. PairedInterval b a -> b
pairData PairedInterval b a
y)