{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Cohort.AssessmentIntervals(
BaselineInterval
, Baseline(..)
, FollowupInterval
, Followup(..)
, AssessmentInterval
, makeBaselineFromIndex
, makeBaselineBeforeIndex
, makeFollowupFromIndex
, makeFollowupMeetingIndex
, makeFollowupAfterIndex
) where
import GHC.Generics ( Generic )
import GHC.Num ( Num((+)) )
import GHC.Show ( Show )
import Data.Eq ( Eq )
import Data.Functor ( Functor(fmap) )
import Data.Function ( ($) )
import Data.Ord ( Ord, (<=) )
import IntervalAlgebra ( Interval
, Intervallic(..)
, IntervalSizeable(..)
, enderval
, begin
, end
, beginerval
, duration )
import Cohort.Index ( Index )
newtype BaselineInterval a = MkBaselineInterval (Interval a)
deriving (BaselineInterval a -> BaselineInterval a -> Bool
(BaselineInterval a -> BaselineInterval a -> Bool)
-> (BaselineInterval a -> BaselineInterval a -> Bool)
-> Eq (BaselineInterval a)
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
[BaselineInterval a] -> ShowS
BaselineInterval a -> String
(Int -> BaselineInterval a -> ShowS)
-> (BaselineInterval a -> String)
-> ([BaselineInterval a] -> ShowS)
-> Show (BaselineInterval a)
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 x. BaselineInterval a -> Rep (BaselineInterval a) x)
-> (forall x. Rep (BaselineInterval a) x -> BaselineInterval a)
-> Generic (BaselineInterval a)
forall x. Rep (BaselineInterval a) x -> BaselineInterval a
forall x. BaselineInterval a -> Rep (BaselineInterval a) x
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 Functor BaselineInterval where
fmap :: (a -> b) -> BaselineInterval a -> BaselineInterval b
fmap a -> b
f (MkBaselineInterval Interval a
x) = Interval b -> BaselineInterval b
forall a. Interval a -> BaselineInterval a
MkBaselineInterval ((a -> b) -> Interval a -> Interval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Interval a
x)
instance (Ord a) => Intervallic BaselineInterval a where
getInterval :: BaselineInterval a -> Interval a
getInterval (MkBaselineInterval Interval a
x) = Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Interval a
x
setInterval :: BaselineInterval a -> Interval a -> BaselineInterval a
setInterval (MkBaselineInterval Interval a
x) Interval a
y = Interval a -> BaselineInterval a
forall a. Interval a -> BaselineInterval a
MkBaselineInterval (Interval a -> Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval Interval a
x Interval a
y)
class Intervallic i a => Baseline i a where
baseline ::
( IntervalSizeable a b) =>
b
-> Index i a
-> BaselineInterval a
baseline b
dur Index i a
index = Interval a -> BaselineInterval a
forall a. Interval a -> BaselineInterval a
MkBaselineInterval (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
dur (Index i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Index i a
index))
baselineBefore ::
( IntervalSizeable a b) =>
b
-> b
-> Index i a
-> BaselineInterval a
baselineBefore b
shiftBy b
dur Index i a
index =
Interval a -> BaselineInterval a
forall a. Interval a -> BaselineInterval a
MkBaselineInterval (Interval a -> BaselineInterval a)
-> Interval a -> BaselineInterval a
forall a b. (a -> b) -> a -> b
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
dur (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
shiftBy (Index i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Index i a
index)))
instance (Ord a) => Baseline Interval a
newtype FollowupInterval a = MkFollowupInterval (Interval a)
deriving (FollowupInterval a -> FollowupInterval a -> Bool
(FollowupInterval a -> FollowupInterval a -> Bool)
-> (FollowupInterval a -> FollowupInterval a -> Bool)
-> Eq (FollowupInterval a)
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
[FollowupInterval a] -> ShowS
FollowupInterval a -> String
(Int -> FollowupInterval a -> ShowS)
-> (FollowupInterval a -> String)
-> ([FollowupInterval a] -> ShowS)
-> Show (FollowupInterval a)
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 x. FollowupInterval a -> Rep (FollowupInterval a) x)
-> (forall x. Rep (FollowupInterval a) x -> FollowupInterval a)
-> Generic (FollowupInterval a)
forall x. Rep (FollowupInterval a) x -> FollowupInterval a
forall x. FollowupInterval a -> Rep (FollowupInterval a) x
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 Functor FollowupInterval where
fmap :: (a -> b) -> FollowupInterval a -> FollowupInterval b
fmap a -> b
f (MkFollowupInterval Interval a
x) = Interval b -> FollowupInterval b
forall a. Interval a -> FollowupInterval a
MkFollowupInterval ((a -> b) -> Interval a -> Interval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Interval a
x)
instance (Ord a) => Intervallic FollowupInterval a where
getInterval :: FollowupInterval a -> Interval a
getInterval (MkFollowupInterval Interval a
x) = Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Interval a
x
setInterval :: FollowupInterval a -> Interval a -> FollowupInterval a
setInterval (MkFollowupInterval Interval a
x) Interval a
y = Interval a -> FollowupInterval a
forall a. Interval a -> FollowupInterval a
MkFollowupInterval (Interval a -> Interval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval Interval a
x Interval a
y)
class Intervallic i a => Followup i a where
followup ::
( IntervalSizeable a b
, Intervallic i a) =>
b
-> Index i a
-> FollowupInterval a
followup b
dur Index i a
index = Interval a -> FollowupInterval a
forall a. Interval a -> FollowupInterval a
MkFollowupInterval (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
d2 (Index i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Index i a
index))
where d2 :: b
d2 = if b
dur b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= Index i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
duration Index i a
index
then Index i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
duration Index i a
index b -> b -> b
forall a. Num a => a -> a -> a
+ Index i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> b
moment' Index i a
index
else b
dur
followupMetBy ::
( IntervalSizeable a b
, Intervallic i a) =>
b
-> Index i a
-> FollowupInterval a
followupMetBy b
dur Index i a
index = Interval a -> FollowupInterval a
forall a. Interval a -> FollowupInterval a
MkFollowupInterval (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
dur (Index i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Index i a
index))
followupAfter ::
( IntervalSizeable a b
, Intervallic i a) =>
b
-> b
-> Index i a
-> FollowupInterval a
followupAfter b
shiftBy b
dur Index i a
index =
Interval a -> FollowupInterval a
forall a. Interval a -> FollowupInterval a
MkFollowupInterval (Interval a -> FollowupInterval a)
-> Interval a -> FollowupInterval a
forall a b. (a -> b) -> a -> b
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
dur (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
shiftBy (Index i a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Index i a
index)))
instance (Ord a) => Followup Interval a
data AssessmentInterval a =
Bl (BaselineInterval a)
| Fl (FollowupInterval a)
deriving (AssessmentInterval a -> AssessmentInterval a -> Bool
(AssessmentInterval a -> AssessmentInterval a -> Bool)
-> (AssessmentInterval a -> AssessmentInterval a -> Bool)
-> Eq (AssessmentInterval a)
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
[AssessmentInterval a] -> ShowS
AssessmentInterval a -> String
(Int -> AssessmentInterval a -> ShowS)
-> (AssessmentInterval a -> String)
-> ([AssessmentInterval a] -> ShowS)
-> Show (AssessmentInterval a)
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 x. AssessmentInterval a -> Rep (AssessmentInterval a) x)
-> (forall x. Rep (AssessmentInterval a) x -> AssessmentInterval a)
-> Generic (AssessmentInterval a)
forall x. Rep (AssessmentInterval a) x -> AssessmentInterval a
forall x. AssessmentInterval a -> Rep (AssessmentInterval a) x
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 (Ord a) => Intervallic AssessmentInterval a where
getInterval :: AssessmentInterval a -> Interval a
getInterval (Bl BaselineInterval a
x) = BaselineInterval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval BaselineInterval a
x
getInterval (Fl FollowupInterval a
x) = FollowupInterval a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval FollowupInterval a
x
setInterval :: AssessmentInterval a -> Interval a -> AssessmentInterval a
setInterval (Bl BaselineInterval a
x) Interval a
y = BaselineInterval a -> AssessmentInterval a
forall a. BaselineInterval a -> AssessmentInterval a
Bl (BaselineInterval a -> Interval a -> BaselineInterval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval BaselineInterval a
x Interval a
y)
setInterval (Fl FollowupInterval a
x) Interval a
y = FollowupInterval a -> AssessmentInterval a
forall a. FollowupInterval a -> AssessmentInterval a
Fl (FollowupInterval a -> Interval a -> FollowupInterval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a -> i a
setInterval FollowupInterval a
x Interval a
y)
instance Functor AssessmentInterval where
fmap :: (a -> b) -> AssessmentInterval a -> AssessmentInterval b
fmap a -> b
f (Bl BaselineInterval a
x) = BaselineInterval b -> AssessmentInterval b
forall a. BaselineInterval a -> AssessmentInterval a
Bl ((a -> b) -> BaselineInterval a -> BaselineInterval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BaselineInterval a
x)
fmap a -> b
f (Fl FollowupInterval a
x) = FollowupInterval b -> AssessmentInterval b
forall a. FollowupInterval a -> AssessmentInterval a
Fl ((a -> b) -> FollowupInterval a -> FollowupInterval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f FollowupInterval a
x)
makeBaselineFromIndex ::
(Baseline i a, IntervalSizeable a b) =>
b
-> Index i a
-> AssessmentInterval a
makeBaselineFromIndex :: b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex b
dur Index i a
index = BaselineInterval a -> AssessmentInterval a
forall a. BaselineInterval a -> AssessmentInterval a
Bl ( b -> Index i a -> BaselineInterval a
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> BaselineInterval a
baseline b
dur Index i a
index )
makeBaselineBeforeIndex ::
(Baseline i a, IntervalSizeable a b) =>
b
-> b
-> Index i a
-> AssessmentInterval a
makeBaselineBeforeIndex :: b -> b -> Index i a -> AssessmentInterval a
makeBaselineBeforeIndex b
shiftBy b
dur Index i a
index =
BaselineInterval a -> AssessmentInterval a
forall a. BaselineInterval a -> AssessmentInterval a
Bl ( b -> b -> Index i a -> BaselineInterval a
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> b -> Index i a -> BaselineInterval a
baselineBefore b
shiftBy b
dur Index i a
index )
makeFollowupFromIndex ::
(Followup i a, IntervalSizeable a b) =>
b
-> Index i a
-> AssessmentInterval a
makeFollowupFromIndex :: b -> Index i a -> AssessmentInterval a
makeFollowupFromIndex b
dur Index i a
index = FollowupInterval a -> AssessmentInterval a
forall a. FollowupInterval a -> AssessmentInterval a
Fl ( b -> Index i a -> FollowupInterval a
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b, Intervallic i a) =>
b -> Index i a -> FollowupInterval a
followup b
dur Index i a
index )
makeFollowupMeetingIndex ::
(Followup i a, IntervalSizeable a b) =>
b
-> Index i a
-> AssessmentInterval a
makeFollowupMeetingIndex :: b -> Index i a -> AssessmentInterval a
makeFollowupMeetingIndex b
dur Index i a
index = FollowupInterval a -> AssessmentInterval a
forall a. FollowupInterval a -> AssessmentInterval a
Fl ( b -> Index i a -> FollowupInterval a
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b, Intervallic i a) =>
b -> Index i a -> FollowupInterval a
followupMetBy b
dur Index i a
index )
makeFollowupAfterIndex ::
(Followup i a, IntervalSizeable a b) =>
b
-> b
-> Index i a
-> AssessmentInterval a
makeFollowupAfterIndex :: b -> b -> Index i a -> AssessmentInterval a
makeFollowupAfterIndex b
shiftBy b
dur Index i a
index = FollowupInterval a -> AssessmentInterval a
forall a. FollowupInterval a -> AssessmentInterval a
Fl ( b -> b -> Index i a -> FollowupInterval a
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b, Intervallic i a) =>
b -> b -> Index i a -> FollowupInterval a
followupAfter b
shiftBy b
dur Index i a
index )