{-|
Module      : Paired interval
Description : Extends the Interval Algebra to an interval paired with some data.
Copyright   : (c) NoviSci, Inc 2020-2022
                  TargetRWE, 2023
License     : BSD3
Maintainer  : bsaul@novisci.com 2020-2022, bbrown@targetrwe.com 2023
Stability   : experimental
-}
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module IntervalAlgebra.PairedInterval
  ( PairedInterval
  , Empty(..)
  , makePairedInterval
  , getPairData
  , intervals
  , equalPairData
  , toTrivialPair
  , trivialize
  ) where

import           Control.Applicative  (liftA2)
import           Control.DeepSeq      (NFData)
import           Data.Binary          (Binary)
import           GHC.Generics         (Generic)
import           IntervalAlgebra.Core (ComparativePredicateOf1, Interval,
                                       Intervallic (..), SizedIv (..), before,
                                       extenterval)
import           Test.QuickCheck      (Arbitrary (..))

-- | 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, (forall x. PairedInterval b a -> Rep (PairedInterval b a) x)
-> (forall x. Rep (PairedInterval b a) x -> PairedInterval b a)
-> Generic (PairedInterval b a)
forall x. Rep (PairedInterval b a) x -> PairedInterval b a
forall x. PairedInterval b a -> Rep (PairedInterval b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b a x. Rep (PairedInterval b a) x -> PairedInterval b a
forall b a x. PairedInterval b a -> Rep (PairedInterval b a) x
$cto :: forall b a x. Rep (PairedInterval b a) x -> PairedInterval b a
$cfrom :: forall b a x. PairedInterval b a -> Rep (PairedInterval b a) x
Generic)

instance Intervallic (PairedInterval b) 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 b -> PairedInterval b b
setInterval (PairedInterval (Interval a
x, b
y)) Interval b
i = (Interval b, b) -> PairedInterval b b
forall b a. (Interval a, b) -> PairedInterval b a
PairedInterval (Interval b
i, b
y)

instance (NFData a, NFData b) => NFData (PairedInterval b a)
instance (Binary a, Binary b) => Binary (PairedInterval b a)

-- | Defines A total ordering on 'PairedInterval b a' based on the 'Interval a'
--   part.
instance (Eq a, Eq b, Ord 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 => 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 => 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 => 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 => i a -> Interval a
getInterval PairedInterval b a
y

instance (Show b, Show a, Ord a) => Show (PairedInterval b a) where
  show :: PairedInterval b a -> String
show PairedInterval b a
x = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Interval a -> String
forall a. Show a => a -> String
show (PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval PairedInterval b a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show (PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- | Make a paired interval.
makePairedInterval :: b -> Interval a -> PairedInterval b a
makePairedInterval :: b -> Interval a -> PairedInterval b a
makePairedInterval 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@.
getPairData :: PairedInterval b a -> b
getPairData :: PairedInterval b a -> b
getPairData (PairedInterval (Interval a
_, b
y)) = b
y

-- | Tests for equality of the data in a @PairedInterval@.
equalPairData :: (Eq b) => ComparativePredicateOf1 (PairedInterval b a)
equalPairData :: ComparativePredicateOf1 (PairedInterval b a)
equalPairData PairedInterval b a
x PairedInterval b a
y = PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
y

-- | Gets the intervals from a list of paired intervals.
intervals :: (Ord a, Functor f) => f (PairedInterval b a) -> f (Interval a)
intervals :: f (PairedInterval b a) -> f (Interval a)
intervals = (PairedInterval b a -> Interval a)
-> f (PairedInterval b a) -> f (Interval a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval

-- | Empty is used to trivially lift an @Interval a@ into a @PairedInterval@.
data Empty = Empty deriving (Empty -> Empty -> Bool
(Empty -> Empty -> Bool) -> (Empty -> Empty -> Bool) -> Eq Empty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq, Eq Empty
Eq Empty
-> (Empty -> Empty -> Ordering)
-> (Empty -> Empty -> Bool)
-> (Empty -> Empty -> Bool)
-> (Empty -> Empty -> Bool)
-> (Empty -> Empty -> Bool)
-> (Empty -> Empty -> Empty)
-> (Empty -> Empty -> Empty)
-> Ord Empty
Empty -> Empty -> Bool
Empty -> Empty -> Ordering
Empty -> Empty -> Empty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Empty -> Empty -> Empty
$cmin :: Empty -> Empty -> Empty
max :: Empty -> Empty -> Empty
$cmax :: Empty -> Empty -> Empty
>= :: Empty -> Empty -> Bool
$c>= :: Empty -> Empty -> Bool
> :: Empty -> Empty -> Bool
$c> :: Empty -> Empty -> Bool
<= :: Empty -> Empty -> Bool
$c<= :: Empty -> Empty -> Bool
< :: Empty -> Empty -> Bool
$c< :: Empty -> Empty -> Bool
compare :: Empty -> Empty -> Ordering
$ccompare :: Empty -> Empty -> Ordering
$cp1Ord :: Eq Empty
Ord, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
(Int -> Empty -> ShowS)
-> (Empty -> String) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> Empty -> ShowS
Show)
instance Semigroup Empty where
  Empty
x <> :: Empty -> Empty -> Empty
<> Empty
y = Empty
Empty
instance Monoid Empty where
  mempty :: Empty
mempty = Empty
Empty

-- | Lifts an @Interval a@ into a @PairedInterval Empty a@, where @Empty@ is a
--   trivial type that contains no data.
toTrivialPair :: Interval a -> PairedInterval Empty a
toTrivialPair :: Interval a -> PairedInterval Empty a
toTrivialPair = Empty -> Interval a -> PairedInterval Empty a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval Empty
Empty

-- | Lifts a @Functor@ containing @Interval a@(s) into a @Functor@ containing
--   @PairedInterval Empty a@(s).
trivialize :: Functor f => f (Interval a) -> f (PairedInterval Empty a)
trivialize :: f (Interval a) -> f (PairedInterval Empty a)
trivialize = (Interval a -> PairedInterval Empty a)
-> f (Interval a) -> f (PairedInterval Empty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interval a -> PairedInterval Empty a
forall a. Interval a -> PairedInterval Empty a
toTrivialPair


-- TODO REFACTOR need to revisit this
-- Arbitrary instance
--instance (Arbitrary b, Arbitrary (Interval a)) => Arbitrary (PairedInterval b a) where
--  arbitrary = liftA2 makePairedInterval arbitrary arbitrary