{-|
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 TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
-- {-# LANGUAGE Safe #-}

module EventData.Core
  ( Event
  , Events
  , ConceptEvent
  , event
  , ctxt
  , toConceptEvent
  , toConceptEventOf
  , mkConceptEvent
  ) where

import           Data.Function                  ( ($) )
import           Data.Ord                       ( Ord )
import           Data.Set                       ( fromList
                                                , intersection
                                                , member
                                                )
import           EventData.Context              ( Concept
                                                , Concepts
                                                , Context(..)
                                                , HasConcept(..)
                                                , getConcepts
                                                , packConcept
                                                , toConcepts
                                                )
import           GHC.Show                       ( Show(show) )
import           IntervalAlgebra                ( Interval
                                                , Intervallic(getInterval)
                                                )
import           IntervalAlgebra.PairedInterval ( PairedInterval
                                                , getPairData
                                                , makePairedInterval
                                                )


-- | An Event @a@ is simply a pair @(Interval a, Context)@.
type Event a = PairedInterval Context a

instance HasConcept (Event a) where
  hasConcept :: Event a -> Text -> Bool
hasConcept Event a
x Text
y = Event a -> Context
forall a. Event a -> Context
ctxt Event a
x Context -> Text -> Bool
forall a. HasConcept a => a -> Text -> Bool
`hasConcept` Text
y

-- | A smart constructor for 'Event a's.
event :: Interval a -> Context -> Event a
event :: Interval a -> Context -> Event a
event Interval a
i Context
c = Context -> Interval a -> Event a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval Context
c Interval a
i

-- | Get the 'Context' of an 'Event a'.
ctxt :: Event a -> Context
ctxt :: Event a -> Context
ctxt = Event a -> Context
forall b a. PairedInterval b a -> b
getPairData

-- | An event containing only concepts and an interval
type ConceptEvent a = PairedInterval Concepts a

instance HasConcept (ConceptEvent a) where
  hasConcept :: ConceptEvent a -> Text -> Bool
hasConcept ConceptEvent a
e Text
concept =
    Concept -> Set Concept -> Bool
forall a. Ord a => a -> Set a -> Bool
member (Text -> Concept
packConcept Text
concept) (Concepts -> Set Concept
getConcepts (Concepts -> Set Concept) -> Concepts -> Set Concept
forall a b. (a -> b) -> a -> b
$ ConceptEvent a -> Concepts
forall b a. PairedInterval b a -> b
getPairData ConceptEvent a
e)

-- | Drops an @Event@ to a @ConceptEvent@ by moving the concepts in the data
--   position in the paired interval and throwing out the facts and source.
toConceptEvent :: (Show a, Ord a) => Event a -> ConceptEvent a
toConceptEvent :: Event a -> ConceptEvent a
toConceptEvent Event a
e = Concepts -> Interval a -> ConceptEvent a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval (Context -> Concepts
_concepts (Context -> Concepts) -> Context -> Concepts
forall a b. (a -> b) -> a -> b
$ Event a -> Context
forall a. Event a -> Context
ctxt Event a
e) (Event a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Event a
e)

-- | Creates a new @'ConceptEvent'@ from an @'Event'@ by taking the intersection
-- of the list of Concepts in the first argument and any Concepts in the @'Event'@.
-- This is a way to keep only the concepts you want in an event.
toConceptEventOf :: (Show a, Ord a) => [Concept] -> Event a -> ConceptEvent a
toConceptEventOf :: [Concept] -> Event a -> ConceptEvent a
toConceptEventOf [Concept]
cpts Event a
e = Concepts -> Interval a -> ConceptEvent a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval
  (Set Concept -> Concepts
toConcepts (Set Concept -> Concepts) -> Set Concept -> Concepts
forall a b. (a -> b) -> a -> b
$ Set Concept -> Set Concept -> Set Concept
forall a. Ord a => Set a -> Set a -> Set a
intersection ([Concept] -> Set Concept
forall a. Ord a => [a] -> Set a
fromList [Concept]
cpts) (Concepts -> Set Concept
getConcepts (Concepts -> Set Concept) -> Concepts -> Set Concept
forall a b. (a -> b) -> a -> b
$ Context -> Concepts
_concepts (Context -> Concepts) -> Context -> Concepts
forall a b. (a -> b) -> a -> b
$ Event a -> Context
forall a. Event a -> Context
ctxt Event a
e))
  (Event a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval Event a
e)

-- | Create a new @'ConceptEvent'@.
mkConceptEvent :: (Show a, Ord a) => Interval a -> Concepts -> ConceptEvent a
mkConceptEvent :: Interval a -> Concepts -> ConceptEvent a
mkConceptEvent Interval a
i Concepts
c = Concepts -> Interval a -> ConceptEvent a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval Concepts
c Interval a
i

-- | A @List@ of @Event a@
type Events a = [Event a]