{-|
Module      : Hasklepias Event Type
Description : Defines the Event type and its component types, constructors, 
              and class instance
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- {-# LANGUAGE Safe #-}

module EventData.Predicates
  ( isEnrollmentEvent
  , isStateFactEvent
  , isGenderFactEvent
  , isBirthYearEvent
  , containsConcepts
  , Predicatable(..)
  ) where

import           Data.Bool                      ( (&&)
                                                , Bool(..)
                                                , (||)
                                                )
import           Data.Function                  ( (.) )
import           Data.Functor.Contravariant     ( Contravariant(contramap)
                                                , Predicate(..)
                                                )
import           Data.Maybe                     ( Maybe )
import           Data.Ord                       ( Ord )
import           Data.Text                      ( Text )
import           EventData.Context              ( Concepts
                                                , Context(..)
                                                , Source
                                                , hasConcepts
                                                )
import           EventData.Context.Domain       ( Domain(..) )
import           EventData.Context.Domain.Demographics
import           EventData.Core                 ( Event
                                                , ctxt
                                                )
import           IntervalAlgebra                ( Interval
                                                , Intervallic(getInterval)
                                                )

{- |
  Provides methods for composing predicate functions (i.e. @a -> Bool@) or 
  'Predicate's by conjunction or disjunction.
-}
class Predicatable a where
  (|||) :: a -> a -> a
  (&&&) :: a -> a -> a

instance Predicatable (a -> Bool) where
  ||| :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(|||) a -> Bool
f a -> Bool
g = \a
x -> a -> Bool
f a
x Bool -> Bool -> Bool
|| a -> Bool
g a
x
  &&& :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(&&&) a -> Bool
f a -> Bool
g = \a
x -> a -> Bool
f a
x Bool -> Bool -> Bool
&& a -> Bool
g a
x

instance Predicatable (Predicate a) where
  ||| :: Predicate a -> Predicate a -> Predicate a
(|||) Predicate a
p1 Predicate a
p2 = (a -> Bool) -> Predicate a
forall a. (a -> Bool) -> Predicate a
Predicate (Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
getPredicate Predicate a
p1 (a -> Bool) -> (a -> Bool) -> a -> Bool
forall a. Predicatable a => a -> a -> a
||| Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
getPredicate Predicate a
p2)
  &&& :: Predicate a -> Predicate a -> Predicate a
(&&&) Predicate a
p1 Predicate a
p2 = (a -> Bool) -> Predicate a
forall a. (a -> Bool) -> Predicate a
Predicate (Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
getPredicate Predicate a
p1 (a -> Bool) -> (a -> Bool) -> a -> Bool
forall a. Predicatable a => a -> a -> a
&&& Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
getPredicate Predicate a
p2)

{- |
  Provides a common interface to lift a 'Predicate' on a component of an 'Event'
  to a 'Predicate (Event a)'.
-}
class EventPredicate element a where
  liftToEventPredicate :: Predicate element -> Predicate (Event a)

instance EventPredicate Context a where
  liftToEventPredicate :: Predicate Context -> Predicate (Event a)
liftToEventPredicate = (Event a -> Context) -> Predicate Context -> Predicate (Event a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Event a -> Context
forall a. Event a -> Context
ctxt

instance EventPredicate Domain a where
  liftToEventPredicate :: Predicate Domain -> Predicate (Event a)
liftToEventPredicate = (Event a -> Domain) -> Predicate Domain -> Predicate (Event a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Context -> Domain
_facts (Context -> Domain) -> (Event a -> Context) -> Event a -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Context
forall a. Event a -> Context
ctxt)

instance EventPredicate Concepts a where
  liftToEventPredicate :: Predicate Concepts -> Predicate (Event a)
liftToEventPredicate = (Event a -> Concepts) -> Predicate Concepts -> Predicate (Event a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Context -> Concepts
_concepts (Context -> Concepts)
-> (Event a -> Context) -> Event a -> Concepts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Context
forall a. Event a -> Context
ctxt)

instance EventPredicate (Maybe Source) a where
  liftToEventPredicate :: Predicate (Maybe Source) -> Predicate (Event a)
liftToEventPredicate = (Event a -> Maybe Source)
-> Predicate (Maybe Source) -> Predicate (Event a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Context -> Maybe Source
_source (Context -> Maybe Source)
-> (Event a -> Context) -> Event a -> Maybe Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Context
forall a. Event a -> Context
ctxt)

instance (Ord a) => EventPredicate (Interval a) a where
  liftToEventPredicate :: Predicate (Interval a) -> Predicate (Event a)
liftToEventPredicate = (Event a -> Interval a)
-> Predicate (Interval a) -> Predicate (Event a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Event a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval

{----------- Predicates  -----------------}

-- | Predicate for State facts
isEnrollmentDomain :: Domain -> Bool
isEnrollmentDomain :: Domain -> Bool
isEnrollmentDomain (Enrollment EnrollmentFacts
_) = Bool
True
isEnrollmentDomain Domain
_              = Bool
False

-- | Predicate for enrollment events
isEnrollmentEvent :: Predicate (Event a)
isEnrollmentEvent :: Predicate (Event a)
isEnrollmentEvent = Predicate Domain -> Predicate (Event a)
forall element a.
EventPredicate element a =>
Predicate element -> Predicate (Event a)
liftToEventPredicate ((Domain -> Bool) -> Predicate Domain
forall a. (a -> Bool) -> Predicate a
Predicate Domain -> Bool
isEnrollmentDomain)

-- | Predicate for Birth Year facts
isBirthYear :: Domain -> Bool
isBirthYear :: Domain -> Bool
isBirthYear (Demographics (DemographicsFacts (DemographicsInfo DemographicsField
BirthYear Maybe Text
_))) =
  Bool
True
isBirthYear Domain
_ = Bool
False

-- | Predicate for events containing Birth Year facts
isBirthYearEvent :: Predicate (Event a)
isBirthYearEvent :: Predicate (Event a)
isBirthYearEvent = Predicate Domain -> Predicate (Event a)
forall element a.
EventPredicate element a =>
Predicate element -> Predicate (Event a)
liftToEventPredicate ((Domain -> Bool) -> Predicate Domain
forall a. (a -> Bool) -> Predicate a
Predicate Domain -> Bool
isBirthYear)

-- | Predicate for Gender facts
isGenderFact :: Domain -> Bool
isGenderFact :: Domain -> Bool
isGenderFact (Demographics (DemographicsFacts (DemographicsInfo DemographicsField
Gender Maybe Text
_))) =
  Bool
True
isGenderFact Domain
_ = Bool
False

-- | Predicate for events containing Gender facts
isGenderFactEvent :: Predicate (Event a)
isGenderFactEvent :: Predicate (Event a)
isGenderFactEvent = Predicate Domain -> Predicate (Event a)
forall element a.
EventPredicate element a =>
Predicate element -> Predicate (Event a)
liftToEventPredicate ((Domain -> Bool) -> Predicate Domain
forall a. (a -> Bool) -> Predicate a
Predicate Domain -> Bool
isGenderFact)

-- | Predicate for State facts
isStateFact :: Domain -> Bool
isStateFact :: Domain -> Bool
isStateFact (Demographics (DemographicsFacts (DemographicsInfo DemographicsField
State Maybe Text
_))) =
  Bool
True
isStateFact Domain
_ = Bool
False

-- | Predicate for events containing  State facts
isStateFactEvent :: Predicate (Event a)
isStateFactEvent :: Predicate (Event a)
isStateFactEvent = Predicate Domain -> Predicate (Event a)
forall element a.
EventPredicate element a =>
Predicate element -> Predicate (Event a)
liftToEventPredicate ((Domain -> Bool) -> Predicate Domain
forall a. (a -> Bool) -> Predicate a
Predicate Domain -> Bool
isStateFact)

-- | Creates a predicate to check that an 'Event' contains a set of 'EventData.Context.Concept's. 
containsConcepts :: [Text] -> Predicate (Event a)
containsConcepts :: [Text] -> Predicate (Event a)
containsConcepts [Text]
cpt = (Event a -> Bool) -> Predicate (Event a)
forall a. (a -> Bool) -> Predicate a
Predicate (Event a -> [Text] -> Bool
forall a. HasConcept a => a -> [Text] -> Bool
`hasConcepts` [Text]
cpt)