{-|
Module      : Cohort IndexSet
Copyright   : (c) TargetRWE 2023
License     : BSD3
Maintainer  : bbrown@targetrwe.com
              ljackman@targetrwe.com
              dpritchard@targetrwe.com
-}

{-# LANGUAGE TypeFamilies #-}
module Cohort.IndexSet
  ( IndexSet
    , Cohort.IndexSet.null
    , Cohort.IndexSet.foldl'
  , fromList
  , toList
  ) where

import qualified Data.Set        as Set (Set, foldl', null)
import           EventDataTheory (Interval)
import           GHC.Exts        (IsList (..))

{-|
A type containing a @Data.Set.'Set'@ of type @Interval b@, values of which
serve as index times when defining cohorts.  In cohort terminology, indices are
the points in time at which an observational unit
can be assessed whether it meets the criteria for inclusion in the cohort.  For
example, when @i@ is @Interval Day@, then index events are days.

A reason for using a set as the underlying type is that indices must be unique
within a subject. A subject cannot have multiple observational units for a
given index.

Construct an @IndexSet@ using @toList@.
-}
newtype IndexSet b
  = MkIndexSet (Set.Set (Interval b))
  deriving (IndexSet b -> IndexSet b -> Bool
forall b. Eq b => IndexSet b -> IndexSet b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexSet b -> IndexSet b -> Bool
$c/= :: forall b. Eq b => IndexSet b -> IndexSet b -> Bool
== :: IndexSet b -> IndexSet b -> Bool
$c== :: forall b. Eq b => IndexSet b -> IndexSet b -> Bool
Eq, Int -> IndexSet b -> ShowS
forall b. (Show b, Ord b) => Int -> IndexSet b -> ShowS
forall b. (Show b, Ord b) => [IndexSet b] -> ShowS
forall b. (Show b, Ord b) => IndexSet b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexSet b] -> ShowS
$cshowList :: forall b. (Show b, Ord b) => [IndexSet b] -> ShowS
show :: IndexSet b -> String
$cshow :: forall b. (Show b, Ord b) => IndexSet b -> String
showsPrec :: Int -> IndexSet b -> ShowS
$cshowsPrec :: forall b. (Show b, Ord b) => Int -> IndexSet b -> ShowS
Show)

instance (Ord b) => IsList (IndexSet b) where
  type Item (IndexSet b) = (Interval b)
  toList :: IndexSet b -> [Item (IndexSet b)]
toList (MkIndexSet Set (Interval b)
s) = forall l. IsList l => l -> [Item l]
toList Set (Interval b)
s
  fromList :: [Item (IndexSet b)] -> IndexSet b
fromList [Item (IndexSet b)]
idxs = forall b. Set (Interval b) -> IndexSet b
MkIndexSet forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [Item (IndexSet b)]
idxs

-- | Specialized @Set.'null'@.
null :: IndexSet b -> Bool
null :: forall b. IndexSet b -> Bool
null (MkIndexSet Set (Interval b)
idxs) = forall a. Set a -> Bool
Set.null Set (Interval b)
idxs

-- | Specialized @Set.'foldl''@.
foldl' :: (a -> Interval b -> a) -> a -> IndexSet b -> a
foldl' :: forall a b. (a -> Interval b -> a) -> a -> IndexSet b -> a
foldl' a -> Interval b -> a
f a
x0 (MkIndexSet Set (Interval b)
s) = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' a -> Interval b -> a
f a
x0 Set (Interval b)
s