{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
module Hasklepias.AssessmentIntervals
(
BaselineInterval
, Baseline(..)
, FollowupInterval
, Followup(..)
, AssessmentInterval
, makeBaselineMeetsIndex
, makeBaselineBeforeIndex
, makeBaselineFinishedByIndex
, makeFollowupStartedByIndex
, makeFollowupMetByIndex
, makeFollowupAfterIndex
) where
import EventDataTheory
import GHC.Generics (Generic)
import Witch
newtype BaselineInterval a = MkBaselineInterval (Interval a)
deriving (BaselineInterval a -> BaselineInterval a -> Bool
forall a. Eq a => BaselineInterval a -> BaselineInterval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaselineInterval a -> BaselineInterval a -> Bool
$c/= :: forall a. Eq a => BaselineInterval a -> BaselineInterval a -> Bool
== :: BaselineInterval a -> BaselineInterval a -> Bool
$c== :: forall a. Eq a => BaselineInterval a -> BaselineInterval a -> Bool
Eq, Int -> BaselineInterval a -> ShowS
forall a. (Show a, Ord a) => Int -> BaselineInterval a -> ShowS
forall a. (Show a, Ord a) => [BaselineInterval a] -> ShowS
forall a. (Show a, Ord a) => BaselineInterval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaselineInterval a] -> ShowS
$cshowList :: forall a. (Show a, Ord a) => [BaselineInterval a] -> ShowS
show :: BaselineInterval a -> String
$cshow :: forall a. (Show a, Ord a) => BaselineInterval a -> String
showsPrec :: Int -> BaselineInterval a -> ShowS
$cshowsPrec :: forall a. (Show a, Ord a) => Int -> BaselineInterval a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BaselineInterval a) x -> BaselineInterval a
forall a x. BaselineInterval a -> Rep (BaselineInterval a) x
$cto :: forall a x. Rep (BaselineInterval a) x -> BaselineInterval a
$cfrom :: forall a x. BaselineInterval a -> Rep (BaselineInterval a) x
Generic)
instance Intervallic BaselineInterval where
getInterval :: forall a. BaselineInterval a -> Interval a
getInterval (MkBaselineInterval Interval a
x) = forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval Interval a
x
setInterval :: forall a b. BaselineInterval a -> Interval b -> BaselineInterval b
setInterval (MkBaselineInterval Interval a
x) Interval b
y = forall a. Interval a -> BaselineInterval a
MkBaselineInterval (forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval Interval a
x Interval b
y)
class Intervallic i => Baseline i where
baselineMeets ::
(SizedIv (Interval a)) =>
Moment (Interval a)
-> i a
-> BaselineInterval a
baselineMeets Moment (Interval a)
dur i a
index = forall a. Interval a -> BaselineInterval a
MkBaselineInterval (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
dur (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
index))
baselineBefore ::
(SizedIv (Interval a)) =>
Moment (Interval a)
-> Moment (Interval a)
-> i a
-> BaselineInterval a
baselineBefore Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index =
forall a. Interval a -> BaselineInterval a
MkBaselineInterval forall a b. (a -> b) -> a -> b
$ forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
dur (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
shiftBy (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
index)))
baselineFinishedBy ::
(SizedIv (Interval a), Ord a) =>
Moment (Interval a)
-> i a
-> BaselineInterval a
baselineFinishedBy Moment (Interval a)
dur i a
index =
forall a. Interval a -> BaselineInterval a
MkBaselineInterval (forall a (i :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
dur (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
index)) (forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
index))
instance Baseline Interval
newtype FollowupInterval a = MkFollowupInterval (Interval a)
deriving (FollowupInterval a -> FollowupInterval a -> Bool
forall a. Eq a => FollowupInterval a -> FollowupInterval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FollowupInterval a -> FollowupInterval a -> Bool
$c/= :: forall a. Eq a => FollowupInterval a -> FollowupInterval a -> Bool
== :: FollowupInterval a -> FollowupInterval a -> Bool
$c== :: forall a. Eq a => FollowupInterval a -> FollowupInterval a -> Bool
Eq, Int -> FollowupInterval a -> ShowS
forall a. (Show a, Ord a) => Int -> FollowupInterval a -> ShowS
forall a. (Show a, Ord a) => [FollowupInterval a] -> ShowS
forall a. (Show a, Ord a) => FollowupInterval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FollowupInterval a] -> ShowS
$cshowList :: forall a. (Show a, Ord a) => [FollowupInterval a] -> ShowS
show :: FollowupInterval a -> String
$cshow :: forall a. (Show a, Ord a) => FollowupInterval a -> String
showsPrec :: Int -> FollowupInterval a -> ShowS
$cshowsPrec :: forall a. (Show a, Ord a) => Int -> FollowupInterval a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FollowupInterval a) x -> FollowupInterval a
forall a x. FollowupInterval a -> Rep (FollowupInterval a) x
$cto :: forall a x. Rep (FollowupInterval a) x -> FollowupInterval a
$cfrom :: forall a x. FollowupInterval a -> Rep (FollowupInterval a) x
Generic)
instance Intervallic FollowupInterval where
getInterval :: forall a. FollowupInterval a -> Interval a
getInterval (MkFollowupInterval Interval a
x) = forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval Interval a
x
setInterval :: forall a b. FollowupInterval a -> Interval b -> FollowupInterval b
setInterval (MkFollowupInterval Interval a
x) Interval b
y = forall a. Interval a -> FollowupInterval a
MkFollowupInterval (forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval Interval a
x Interval b
y)
class (Intervallic i) => Followup i a where
followup :: (SizedIv (Interval a)
, Ord (Moment (Interval a)), Num (Moment (Interval a))
, Intervallic i) =>
Moment (Interval a)
-> i a
-> FollowupInterval a
followup Moment (Interval a)
dur i a
index = forall a. Interval a -> FollowupInterval a
MkFollowupInterval (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
d2 (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
index))
where d2 :: Moment (Interval a)
d2 = if Moment (Interval a)
dur forall a. Ord a => a -> a -> Bool
<= Moment (Interval a)
dindex
then Moment (Interval a)
dindex forall a. Num a => a -> a -> a
+ forall iv. SizedIv iv => Moment iv
moment @(Interval a)
else Moment (Interval a)
dur
dindex :: Moment (Interval a)
dindex = forall iv. SizedIv iv => iv -> Moment iv
duration forall a b. (a -> b) -> a -> b
$ forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
index
followupMetBy ::
(SizedIv (Interval a)
, Intervallic i) =>
Moment (Interval a)
-> i a
-> FollowupInterval a
followupMetBy Moment (Interval a)
dur i a
index = forall a. Interval a -> FollowupInterval a
MkFollowupInterval (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
dur (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
index))
followupAfter ::
(SizedIv (Interval a)
, Intervallic i) =>
Moment (Interval a)
-> Moment (Interval a)
-> i a
-> FollowupInterval a
followupAfter Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index =
forall a. Interval a -> FollowupInterval a
MkFollowupInterval forall a b. (a -> b) -> a -> b
$ forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
dur (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end (forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
shiftBy (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
index)))
instance Followup Interval a
data AssessmentInterval a =
Bl (BaselineInterval a)
| Fl (FollowupInterval a)
deriving (AssessmentInterval a -> AssessmentInterval a -> Bool
forall a.
Eq a =>
AssessmentInterval a -> AssessmentInterval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssessmentInterval a -> AssessmentInterval a -> Bool
$c/= :: forall a.
Eq a =>
AssessmentInterval a -> AssessmentInterval a -> Bool
== :: AssessmentInterval a -> AssessmentInterval a -> Bool
$c== :: forall a.
Eq a =>
AssessmentInterval a -> AssessmentInterval a -> Bool
Eq, Int -> AssessmentInterval a -> ShowS
forall a. (Show a, Ord a) => Int -> AssessmentInterval a -> ShowS
forall a. (Show a, Ord a) => [AssessmentInterval a] -> ShowS
forall a. (Show a, Ord a) => AssessmentInterval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssessmentInterval a] -> ShowS
$cshowList :: forall a. (Show a, Ord a) => [AssessmentInterval a] -> ShowS
show :: AssessmentInterval a -> String
$cshow :: forall a. (Show a, Ord a) => AssessmentInterval a -> String
showsPrec :: Int -> AssessmentInterval a -> ShowS
$cshowsPrec :: forall a. (Show a, Ord a) => Int -> AssessmentInterval a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AssessmentInterval a) x -> AssessmentInterval a
forall a x. AssessmentInterval a -> Rep (AssessmentInterval a) x
$cto :: forall a x. Rep (AssessmentInterval a) x -> AssessmentInterval a
$cfrom :: forall a x. AssessmentInterval a -> Rep (AssessmentInterval a) x
Generic)
instance Intervallic AssessmentInterval where
getInterval :: forall a. AssessmentInterval a -> Interval a
getInterval (Bl BaselineInterval a
x) = forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval BaselineInterval a
x
getInterval (Fl FollowupInterval a
x) = forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval FollowupInterval a
x
setInterval :: forall a b.
AssessmentInterval a -> Interval b -> AssessmentInterval b
setInterval (Bl BaselineInterval a
x) Interval b
y = forall a. BaselineInterval a -> AssessmentInterval a
Bl (forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval BaselineInterval a
x Interval b
y)
setInterval (Fl FollowupInterval a
x) Interval b
y = forall a. FollowupInterval a -> AssessmentInterval a
Fl (forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval FollowupInterval a
x Interval b
y)
makeBaselineMeetsIndex
:: (Baseline i, SizedIv (Interval a)) => Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineMeetsIndex :: forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a)) =>
Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineMeetsIndex Moment (Interval a)
dur i a
index = forall a. BaselineInterval a -> AssessmentInterval a
Bl (forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a)) =>
Moment (Interval a) -> i a -> BaselineInterval a
baselineMeets Moment (Interval a)
dur i a
index)
makeBaselineBeforeIndex
:: (Baseline i, SizedIv (Interval a)) => Moment (Interval a) -> Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineBeforeIndex :: forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a)) =>
Moment (Interval a)
-> Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineBeforeIndex Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index =
forall a. BaselineInterval a -> AssessmentInterval a
Bl (forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a)) =>
Moment (Interval a)
-> Moment (Interval a) -> i a -> BaselineInterval a
baselineBefore Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index)
makeBaselineFinishedByIndex
:: (Baseline i, SizedIv (Interval a), Ord a) => Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineFinishedByIndex :: forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a), Ord a) =>
Moment (Interval a) -> i a -> AssessmentInterval a
makeBaselineFinishedByIndex Moment (Interval a)
dur i a
index = forall a. BaselineInterval a -> AssessmentInterval a
Bl (forall (i :: * -> *) a.
(Baseline i, SizedIv (Interval a), Ord a) =>
Moment (Interval a) -> i a -> BaselineInterval a
baselineFinishedBy Moment (Interval a)
dur i a
index)
makeFollowupStartedByIndex
:: (Followup i a, SizedIv (Interval a), Ord (Moment (Interval a)), Num (Moment (Interval a))) => Moment (Interval a) -> i a -> AssessmentInterval a
makeFollowupStartedByIndex :: forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a), Ord (Moment (Interval a)),
Num (Moment (Interval a))) =>
Moment (Interval a) -> i a -> AssessmentInterval a
makeFollowupStartedByIndex Moment (Interval a)
dur i a
index = forall a. FollowupInterval a -> AssessmentInterval a
Fl (forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a), Ord (Moment (Interval a)),
Num (Moment (Interval a)), Intervallic i) =>
Moment (Interval a) -> i a -> FollowupInterval a
followup Moment (Interval a)
dur i a
index)
makeFollowupMetByIndex
:: (Followup i a, SizedIv (Interval a)) => Moment (Interval a) -> i a -> AssessmentInterval a
makeFollowupMetByIndex :: forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a)) =>
Moment (Interval a) -> i a -> AssessmentInterval a
makeFollowupMetByIndex Moment (Interval a)
dur i a
index = forall a. FollowupInterval a -> AssessmentInterval a
Fl (forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a), Intervallic i) =>
Moment (Interval a) -> i a -> FollowupInterval a
followupMetBy Moment (Interval a)
dur i a
index)
makeFollowupAfterIndex
:: (Followup i a, SizedIv (Interval a))
=> Moment (Interval a)
-> Moment (Interval a)
-> i a
-> AssessmentInterval a
makeFollowupAfterIndex :: forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a)) =>
Moment (Interval a)
-> Moment (Interval a) -> i a -> AssessmentInterval a
makeFollowupAfterIndex Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index = forall a. FollowupInterval a -> AssessmentInterval a
Fl (forall (i :: * -> *) a.
(Followup i a, SizedIv (Interval a), Intervallic i) =>
Moment (Interval a)
-> Moment (Interval a) -> i a -> FollowupInterval a
followupAfter Moment (Interval a)
shiftBy Moment (Interval a)
dur i a
index)