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

module Hasklepias.Types.Event(
   Event
 , Events
 , ConceptEvent
 , event
 , ctxt
 , toConceptEvent
 , toConceptEventOf
 , mkConceptEvent
) where

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


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

-- instance (Ord a, Show a) => Show (Event a) where
--   show x = "{" ++ show (getInterval x) ++ ", " ++ show (ctxt x) ++ "}"

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

-- | Access 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 (Ord a, Show a) => Show (ConceptEvent a) where
--   show x = "{" ++ show (getInterval x) ++ ", " ++ show (getPairData x) ++ "}"

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
fromConcepts (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
getConcepts (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)

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
fromConcepts (Concepts -> Set Concept) -> Concepts -> Set Concept
forall a b. (a -> b) -> a -> b
$ Context -> Concepts
getConcepts (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)

-- |
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@
-- 
-- NOTE (20190911): I (B. Saul) am starting out the Events type as a 
-- list of the Event type. This may be not be the optimal approach,
-- especially with regards to lookup/filtering the list. Ideally,
-- we could do one pass through the ordered container (whatever it is)
-- to identify events by concept; rather than repeated evaluations of
-- the lookup predicates. This could be handled by, for example, 
-- representing Events has a Map with a list of concept indices. 
-- But this gets us off the ground.
type Events a = [Event a]