{-|
Module      : Hasklepias Feature Type
Description : Defines the Feature type and its component types, constructors, 
              and class instances
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE Safe #-}

module Hasklepias.Types.Feature(
    -- * Types
      Feature(..)
    , MissingReason(..)
    , FeatureDefinition(..)
    , defineEF
    , defineFEF
    , defineFEF2
    , defineFFF
    , applyEF
    , applyFEF
    , applyFFF
    , featureR
    , featureL

) where

import GHC.Read                   ( Read )
import GHC.Show                   ( Show )
import GHC.Generics               ( Generic )
import Data.Either                ( Either(..) )
import Data.Eq                    ( Eq )
import Data.Functor               ( Functor(fmap) )
import Data.Function              ( ($), (.) )
import Data.Maybe                 ( Maybe(..) )
import Data.String                ( String )
import Hasklepias.Types.Event     ( Events )
import IntervalAlgebra            ( Interval, Intervallic )

{- | A 'Feature' is a @'Either' 'MissingReason' d@, where @d@ can be any type 
     of data derivable from 'Hasklepias.Event.Events'.
-}
newtype Feature d = Feature { Feature d -> Either MissingReason d
getFeature :: Either MissingReason d }
  deriving ((forall x. Feature d -> Rep (Feature d) x)
-> (forall x. Rep (Feature d) x -> Feature d)
-> Generic (Feature d)
forall x. Rep (Feature d) x -> Feature d
forall x. Feature d -> Rep (Feature d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Feature d) x -> Feature d
forall d x. Feature d -> Rep (Feature d) x
$cto :: forall d x. Rep (Feature d) x -> Feature d
$cfrom :: forall d x. Feature d -> Rep (Feature d) x
Generic, Int -> Feature d -> ShowS
[Feature d] -> ShowS
Feature d -> String
(Int -> Feature d -> ShowS)
-> (Feature d -> String)
-> ([Feature d] -> ShowS)
-> Show (Feature d)
forall d. Show d => Int -> Feature d -> ShowS
forall d. Show d => [Feature d] -> ShowS
forall d. Show d => Feature d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature d] -> ShowS
$cshowList :: forall d. Show d => [Feature d] -> ShowS
show :: Feature d -> String
$cshow :: forall d. Show d => Feature d -> String
showsPrec :: Int -> Feature d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Feature d -> ShowS
Show, Feature d -> Feature d -> Bool
(Feature d -> Feature d -> Bool)
-> (Feature d -> Feature d -> Bool) -> Eq (Feature d)
forall d. Eq d => Feature d -> Feature d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature d -> Feature d -> Bool
$c/= :: forall d. Eq d => Feature d -> Feature d -> Bool
== :: Feature d -> Feature d -> Bool
$c== :: forall d. Eq d => Feature d -> Feature d -> Bool
Eq)

instance Functor Feature where
  fmap :: (a -> b) -> Feature a -> Feature b
fmap a -> b
f (Feature Either MissingReason a
x) = Either MissingReason b -> Feature b
forall d. Either MissingReason d -> Feature d
Feature ((a -> b) -> Either MissingReason a -> Either MissingReason b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either MissingReason a
x)

-- | Create the 'Right' side of a 'Feature'.
featureR :: d -> Feature d
featureR :: d -> Feature d
featureR = Either MissingReason d -> Feature d
forall d. Either MissingReason d -> Feature d
Feature (Either MissingReason d -> Feature d)
-> (d -> Either MissingReason d) -> d -> Feature d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Either MissingReason d
forall a b. b -> Either a b
Right

-- | Create the 'Left' side of a 'Feature'.
featureL :: MissingReason -> Feature d
featureL :: MissingReason -> Feature d
featureL = Either MissingReason d -> Feature d
forall d. Either MissingReason d -> Feature d
Feature (Either MissingReason d -> Feature d)
-> (MissingReason -> Either MissingReason d)
-> MissingReason
-> Feature d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MissingReason -> Either MissingReason d
forall a b. a -> Either a b
Left

-- | A 'Feature' may be missing for any number of reasons. 
data MissingReason =
    InsufficientData
  | Excluded
  | Other String
  | Unknown
  deriving (MissingReason -> MissingReason -> Bool
(MissingReason -> MissingReason -> Bool)
-> (MissingReason -> MissingReason -> Bool) -> Eq MissingReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MissingReason -> MissingReason -> Bool
$c/= :: MissingReason -> MissingReason -> Bool
== :: MissingReason -> MissingReason -> Bool
$c== :: MissingReason -> MissingReason -> Bool
Eq, ReadPrec [MissingReason]
ReadPrec MissingReason
Int -> ReadS MissingReason
ReadS [MissingReason]
(Int -> ReadS MissingReason)
-> ReadS [MissingReason]
-> ReadPrec MissingReason
-> ReadPrec [MissingReason]
-> Read MissingReason
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MissingReason]
$creadListPrec :: ReadPrec [MissingReason]
readPrec :: ReadPrec MissingReason
$creadPrec :: ReadPrec MissingReason
readList :: ReadS [MissingReason]
$creadList :: ReadS [MissingReason]
readsPrec :: Int -> ReadS MissingReason
$creadsPrec :: Int -> ReadS MissingReason
Read, Int -> MissingReason -> ShowS
[MissingReason] -> ShowS
MissingReason -> String
(Int -> MissingReason -> ShowS)
-> (MissingReason -> String)
-> ([MissingReason] -> ShowS)
-> Show MissingReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MissingReason] -> ShowS
$cshowList :: [MissingReason] -> ShowS
show :: MissingReason -> String
$cshow :: MissingReason -> String
showsPrec :: Int -> MissingReason -> ShowS
$cshowsPrec :: Int -> MissingReason -> ShowS
Show, (forall x. MissingReason -> Rep MissingReason x)
-> (forall x. Rep MissingReason x -> MissingReason)
-> Generic MissingReason
forall x. Rep MissingReason x -> MissingReason
forall x. MissingReason -> Rep MissingReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MissingReason x -> MissingReason
$cfrom :: forall x. MissingReason -> Rep MissingReason x
Generic)

-- | A type to hold common feature definitions; i.e. functions that return 
--  features.
data FeatureDefinition f e a d =
    EF  (Events a -> Feature d)
  | FEF (Feature e -> Events a -> Feature d)
  | FFF (Feature f -> Feature e -> Feature d)

-- | Define an 'EF' FeatureDefinition
defineEF :: (Intervallic Interval a) =>
             MissingReason 
          -- ^ The reason if @f@ returns 'Nothing' 
          -> (Events a -> Maybe c) 
          -- ^ A function that maps events to an some intermediary Maybe type. 
          --   In the case that this function returns 'Nothing', you get a 
          --   @Left@ feature with the provided @MissingReason@. Otherwise, 
          --   the 'Just' result is passed to the next function for final
          --   transformation to the desired @Feature@ type.
          -> (c -> d)              
          -- ^ A function that transforms the intermediary data to the desired 
          --   type.
          -> FeatureDefinition * e a d
defineEF :: MissingReason
-> (Events a -> Maybe c) -> (c -> d) -> FeatureDefinition * e a d
defineEF MissingReason
r Events a -> Maybe c
f c -> d
g = (Events a -> Feature d) -> FeatureDefinition * e a d
forall f e a d.
(Events a -> Feature d) -> FeatureDefinition f e a d
EF (\Events a
es ->
  case Events a -> Maybe c
f Events a
es of
    Maybe c
Nothing -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r
    Just c
x  -> d -> Feature d
forall d. d -> Feature d
featureR (c -> d
g c
x)
  )

-- | Extract an 'EF' FeatureDefinition.
applyEF :: FeatureDefinition * * a d -> Events a -> Feature d
applyEF :: FeatureDefinition * * a d -> Events a -> Feature d
applyEF (EF Events a -> Feature d
f) = Events a -> Feature d
f

-- | TODO
defineFEF :: (Intervallic Interval a) =>
             MissingReason
          -- ^ The reason if the input 'Feature' is a 'Left'.
          -> (e -> Events a -> d)
          -- ^ A function that tranforms the data of a 'Right' input 'Feature'
          --   and a collection of events into the desired type.
          -> FeatureDefinition * e a d
defineFEF :: MissingReason -> (e -> Events a -> d) -> FeatureDefinition * e a d
defineFEF MissingReason
r e -> Events a -> d
g = (Feature e -> Events a -> Feature d) -> FeatureDefinition * e a d
forall f e a d.
(Feature e -> Events a -> Feature d) -> FeatureDefinition f e a d
FEF (\(Feature Either MissingReason e
feat) Events a
es ->
  case Either MissingReason e
feat of
    (Left MissingReason
_)  -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r
    (Right e
x) -> d -> Feature d
forall d. d -> Feature d
featureR (e -> Events a -> d
g e
x Events a
es)
  )

-- | TODO
defineFEF2 :: (Intervallic Interval a) =>
             MissingReason
          -- ^ The reason if the input 'Feature' is a 'Left'.
          -> (e -> Events a -> Feature d)
          -- ^ A function that tranforms the data of a 'Right' input 'Feature'
          --   and a collection of events into the desired type.
          -> FeatureDefinition * e a d
defineFEF2 :: MissingReason
-> (e -> Events a -> Feature d) -> FeatureDefinition * e a d
defineFEF2 MissingReason
r e -> Events a -> Feature d
g = (Feature e -> Events a -> Feature d) -> FeatureDefinition * e a d
forall f e a d.
(Feature e -> Events a -> Feature d) -> FeatureDefinition f e a d
FEF (\(Feature Either MissingReason e
feat) Events a
es ->
  case Either MissingReason e
feat of
    (Left MissingReason
_)  -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r
    (Right e
x) -> e -> Events a -> Feature d
g e
x Events a
es
  )

-- | Extract a 'FEF' FeatureDefinition
applyFEF :: FeatureDefinition * e a d -> Feature e -> Events a -> Feature d
applyFEF :: FeatureDefinition * e a d -> Feature e -> Events a -> Feature d
applyFEF (FEF Feature e -> Events a -> Feature d
f) = Feature e -> Events a -> Feature d
f

-- | TODO
defineFFF :: 
        MissingReason
    ->  MissingReason      
    -> (f -> e -> d) 
    -> FeatureDefinition f e * d
defineFFF :: MissingReason
-> MissingReason -> (f -> e -> d) -> FeatureDefinition f e * d
defineFFF MissingReason
r1 MissingReason
r2 f -> e -> d
g = (Feature f -> Feature e -> Feature d) -> FeatureDefinition f e * d
forall f e a d.
(Feature f -> Feature e -> Feature d) -> FeatureDefinition f e a d
FFF (\(Feature Either MissingReason f
feat1) (Feature Either MissingReason e
feat2) ->
    case ( Either MissingReason f
feat1, Either MissingReason e
feat2 ) of 
      ( Left MissingReason
_ , Left MissingReason
_ ) -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r1
      ( Left MissingReason
_ , Either MissingReason e
_      ) -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r1
      ( Either MissingReason f
_      , Left MissingReason
_ ) -> MissingReason -> Feature d
forall d. MissingReason -> Feature d
featureL MissingReason
r2
      ( Right f
x, Right e
y) -> d -> Feature d
forall d. d -> Feature d
featureR (d -> Feature d) -> d -> Feature d
forall a b. (a -> b) -> a -> b
$ f -> e -> d
g f
x e
y
  )

-- | Extract a 'FFF' FeatureDefinition
applyFFF :: FeatureDefinition f e * d -> Feature f -> Feature e -> Feature d
applyFFF :: FeatureDefinition f e * d -> Feature f -> Feature e -> Feature d
applyFFF (FFF Feature f -> Feature e -> Feature d
f) = Feature f -> Feature e -> Feature d
f