{-|
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
      FeatureSpec(..)
    , Feature(..)
    , FeatureData(..)
    , MissingReason(..)
    , FeatureDefinition(..)
    , defineEF
    , defineFEF
    , defineFEF2
    , defineFFF
    , applyEF
    , applyFEF
    , applyFFF
    , featureR
    , featureL
    , evalEFFeature
    , evalFEFFeature
    , evalFFFFeature
) where

import GHC.Read                   ( Read )
import GHC.Show                   ( Show )
import GHC.Generics               ( Generic, D )
import Data.Either                ( Either(..) )
import Data.Eq                    ( Eq )
import Data.Functor               ( Functor(fmap) )
import Data.Function              ( ($), (.) )
import Data.Maybe                 ( Maybe(..) )
import Data.Text                  ( Text )
import Hasklepias.Types.Event     ( Events )
import IntervalAlgebra            ( Interval, Intervallic )
-- import safe Test.QuickCheck       ( Property )

{- | A 'FeatureSpec' contains all the information needed to derive a 'Feature':
      * its name
      * its attributes
      * the function needed to derive a feature (i.e. the 'FeatureDefinition')
-}
data (Show b) => FeatureSpec b f e a d = FeatureSpec {
        FeatureSpec b f e a d -> Text
getSpecName :: Text
      , FeatureSpec b f e a d -> b
getSpecAttr :: b
      , FeatureSpec b f e a d -> FeatureDefinition f e a d
getDefn :: FeatureDefinition f e a d
      -- To add in future: an optional list of properties to check
      -- , getProp :: Maybe [Feature d -> Events a -> Property] 
    }

{- | A 'Feature' contains the following:
      * a name
      * its attributes
      * 'FeatureData'
-}
data (Show b) => Feature b d = Feature {
        Feature b d -> Text
getName :: Text
      , Feature b d -> b
getAttr :: b
      , Feature b d -> FeatureData d
getData :: FeatureData d 
      }

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

instance Functor FeatureData where
  fmap :: (a -> b) -> FeatureData a -> FeatureData b
fmap a -> b
f (FeatureData Either MissingReason a
x) = Either MissingReason b -> FeatureData b
forall d. Either MissingReason d -> FeatureData d
FeatureData ((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 -> FeatureData d
featureR :: d -> FeatureData d
featureR = Either MissingReason d -> FeatureData d
forall d. Either MissingReason d -> FeatureData d
FeatureData (Either MissingReason d -> FeatureData d)
-> (d -> Either MissingReason d) -> d -> FeatureData 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 -> FeatureData d
featureL :: MissingReason -> FeatureData d
featureL = Either MissingReason d -> FeatureData d
forall d. Either MissingReason d -> FeatureData d
FeatureData (Either MissingReason d -> FeatureData d)
-> (MissingReason -> Either MissingReason d)
-> MissingReason
-> FeatureData 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 Text
  | 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 FeatureData definitions; i.e. functions that return 
--  features.
data FeatureDefinition f e a d =
    EF  (Events a -> FeatureData d)
  | FEF (FeatureData e -> Events a -> FeatureData d)
  | FFF (FeatureData f -> FeatureData e -> FeatureData 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@ FeatureData 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 -> FeatureData d) -> FeatureDefinition * e a d
forall f e a d.
(Events a -> FeatureData d) -> FeatureDefinition f e a d
EF (\Events a
es ->
  case Events a -> Maybe c
f Events a
es of
    Maybe c
Nothing -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r
    Just c
x  -> d -> FeatureData d
forall d. d -> FeatureData d
featureR (c -> d
g c
x)
  )

-- | Extract an 'EF' FeatureDefinition.
applyEF :: FeatureDefinition * * a d -> Events a -> FeatureData d
applyEF :: FeatureDefinition * * a d -> Events a -> FeatureData d
applyEF (EF Events a -> FeatureData d
f) = Events a -> FeatureData 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 = (FeatureData e -> Events a -> FeatureData d)
-> FeatureDefinition * e a d
forall f e a d.
(FeatureData e -> Events a -> FeatureData d)
-> FeatureDefinition f e a d
FEF (\(FeatureData Either MissingReason e
feat) Events a
es ->
  case Either MissingReason e
feat of
    (Left MissingReason
_)  -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r
    (Right e
x) -> d -> FeatureData d
forall d. d -> FeatureData 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 -> FeatureData 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 -> FeatureData d) -> FeatureDefinition * e a d
defineFEF2 MissingReason
r e -> Events a -> FeatureData d
g = (FeatureData e -> Events a -> FeatureData d)
-> FeatureDefinition * e a d
forall f e a d.
(FeatureData e -> Events a -> FeatureData d)
-> FeatureDefinition f e a d
FEF (\(FeatureData Either MissingReason e
feat) Events a
es ->
  case Either MissingReason e
feat of
    (Left MissingReason
_)  -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r
    (Right e
x) -> e -> Events a -> FeatureData d
g e
x Events a
es
  )

-- | Extract a 'FEF' FeatureDefinition
applyFEF :: FeatureDefinition * e a d -> FeatureData e -> Events a -> FeatureData d
applyFEF :: FeatureDefinition * e a d
-> FeatureData e -> Events a -> FeatureData d
applyFEF (FEF FeatureData e -> Events a -> FeatureData d
f) = FeatureData e -> Events a -> FeatureData 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 = (FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e * d
forall f e a d.
(FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e a d
FFF (\(FeatureData Either MissingReason f
feat1) (FeatureData Either MissingReason e
feat2) ->
    case ( Either MissingReason f
feat1, Either MissingReason e
feat2 ) of 
      ( Left MissingReason
_ , Left MissingReason
_ ) -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r1
      ( Left MissingReason
_ , Either MissingReason e
_      ) -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r1
      ( Either MissingReason f
_      , Left MissingReason
_ ) -> MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureL MissingReason
r2
      ( Right f
x, Right e
y) -> d -> FeatureData d
forall d. d -> FeatureData d
featureR (d -> FeatureData d) -> d -> FeatureData 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 -> FeatureData f -> FeatureData e -> FeatureData d
applyFFF :: FeatureDefinition f e * d
-> FeatureData f -> FeatureData e -> FeatureData d
applyFFF (FFF FeatureData f -> FeatureData e -> FeatureData d
f) = FeatureData f -> FeatureData e -> FeatureData d
f

-- | TODO
makeFeatureSpec :: Show b => Text -> b -> FeatureDefinition f e a d ->  
  FeatureSpec b f e a d
makeFeatureSpec :: Text -> b -> FeatureDefinition f e a d -> FeatureSpec b f e a d
makeFeatureSpec = Text -> b -> FeatureDefinition f e a d -> FeatureSpec b f e a d
forall b f e a d.
Text -> b -> FeatureDefinition f e a d -> FeatureSpec b f e a d
FeatureSpec

-- | TODO
evalEFFeature :: Show b => FeatureSpec b * * a d -> Events a -> Feature b d 
evalEFFeature :: FeatureSpec b * * a d -> Events a -> Feature b d
evalEFFeature (FeatureSpec Text
n b
atr FeatureDefinition * * a d
def) Events a
es = 
    Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
Feature Text
n b
atr (FeatureDefinition * * a d -> Events a -> FeatureData d
forall a d. FeatureDefinition * * a d -> Events a -> FeatureData d
applyEF FeatureDefinition * * a d
def Events a
es)

-- | TODO 
evalFEFFeature :: Show b => FeatureSpec b * e a d -> Feature b e -> Events a -> Feature b d 
evalFEFFeature :: FeatureSpec b * e a d -> Feature b e -> Events a -> Feature b d
evalFEFFeature (FeatureSpec Text
n b
atr FeatureDefinition * e a d
def) Feature b e
feat Events a
es =
    Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
Feature Text
n b
atr (FeatureDefinition * e a d
-> FeatureData e -> Events a -> FeatureData d
forall e a d.
FeatureDefinition * e a d
-> FeatureData e -> Events a -> FeatureData d
applyFEF FeatureDefinition * e a d
def (Feature b e -> FeatureData e
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b e
feat) Events a
es)

-- | TODO
evalFFFFeature :: Show b => FeatureSpec b f e * d -> Feature b f -> Feature b e -> Feature b d 
evalFFFFeature :: FeatureSpec b f e * d -> Feature b f -> Feature b e -> Feature b d
evalFFFFeature (FeatureSpec Text
n b
atr FeatureDefinition f e * d
def) Feature b f
feat1 Feature b e
feat2 =
    Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
Feature Text
n b
atr (FeatureDefinition f e * d
-> FeatureData f -> FeatureData e -> FeatureData d
forall f e d.
FeatureDefinition f e * d
-> FeatureData f -> FeatureData e -> FeatureData d
applyFFF FeatureDefinition f e * d
def (Feature b f -> FeatureData f
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b f
feat1) (Feature b e -> FeatureData e
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b e
feat2))