Core.hs

{-|
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 x y = ctxt x `hasConcept` y

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

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

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

instance HasConcept (ConceptEvent a) where
  hasConcept e concept =
    member (packConcept concept) (getConcepts $ getPairData 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 e = makePairedInterval (_concepts $ ctxt e) (getInterval 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 cpts e = makePairedInterval
  (toConcepts $ intersection (fromList cpts) (getConcepts $ _concepts $ ctxt e))
  (getInterval e)

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

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