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

module Hasklepias.Types.Feature(
    -- * Types
      FeatureSpec(..)
    , Feature(..)
    , FeatureData(..)
    , MissingReason(..)
    , FeatureDefinition(..)
    , Defineable(..)
    , maybeFeature
    , featureDataR
    , featureDataL
) 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(..), maybe )
import Data.Ord                   ( Ord )
import Data.Text                  ( Text )
import Hasklepias.Types.Event     ( 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 k d = FeatureSpec {
        FeatureSpec b k d -> Text
getSpecName :: Text
      , FeatureSpec b k d -> b
getSpecAttr :: b
      , FeatureSpec b k d -> FeatureDefinition k d
getDefn :: FeatureDefinition k d
      -- To add in future: an optional list of properties to check
      -- , getProp :: Maybe [Feature d -> Events a -> Property] 
    }

-- | TODO
makeFeatureSpec :: Show b => Text -> b -> FeatureDefinition k d ->
  FeatureSpec b k d
makeFeatureSpec :: Text -> b -> FeatureDefinition k d -> FeatureSpec b k d
makeFeatureSpec = Text -> b -> FeatureDefinition k d -> FeatureSpec b k d
forall b k d.
Text -> b -> FeatureDefinition k d -> FeatureSpec b k d
FeatureSpec

{- | 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
      } deriving (Feature b d -> Feature b d -> Bool
(Feature b d -> Feature b d -> Bool)
-> (Feature b d -> Feature b d -> Bool) -> Eq (Feature b d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b d.
(Show b, Eq b, Eq d) =>
Feature b d -> Feature b d -> Bool
/= :: Feature b d -> Feature b d -> Bool
$c/= :: forall b d.
(Show b, Eq b, Eq d) =>
Feature b d -> Feature b d -> Bool
== :: Feature b d -> Feature b d -> Bool
$c== :: forall b d.
(Show b, Eq b, Eq d) =>
Feature b d -> Feature b d -> Bool
Eq)

{- | '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 'FeatureData'.
featureDataR :: d -> FeatureData d
featureDataR :: d -> FeatureData d
featureDataR = 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 'FeatureData'.
featureDataL :: MissingReason -> FeatureData d
featureDataL :: MissingReason -> FeatureData d
featureDataL = 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 FeatureData definitions; i.e. functions that return 
--  features.
newtype FeatureDefinition input d = MkFeatureDef (input -> FeatureData d)

class Defineable input where
  define :: (input -> FeatureData d) -> FeatureDefinition input d
  define = (input -> FeatureData d) -> FeatureDefinition input d
forall input d.
(input -> FeatureData d) -> FeatureDefinition input d
MkFeatureDef

  eval :: FeatureDefinition input d -> input -> FeatureData d
  eval (MkFeatureDef input -> FeatureData d
def) input
x = input -> FeatureData d
def input
x

instance Defineable (Events a) where
instance Defineable (FeatureData e, Events a) where
instance Defineable (FeatureData e, FeatureData f) where
instance Defineable (FeatureData e, FeatureData f, FeatureData g) where

maybeFeature :: MissingReason -> (a -> Maybe c) -> (c -> d) -> (a -> FeatureData d)
maybeFeature :: MissingReason -> (a -> Maybe c) -> (c -> d) -> a -> FeatureData d
maybeFeature MissingReason
r a -> Maybe c
f c -> d
g a
x = FeatureData d -> (c -> FeatureData d) -> Maybe c -> FeatureData d
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureDataL MissingReason
r) (d -> FeatureData d
forall d. d -> FeatureData d
featureDataR (d -> FeatureData d) -> (c -> d) -> c -> FeatureData d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) (a -> Maybe c
f a
x)