{-|
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 Safe #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Hasklepias.Types.Feature(
    -- * Types
      FeatureSpec(..)
    , Feature(..)
    , FeatureData(..)
    , MissingReason(..)
    , FeatureDefinition(..)
    , makeFeatureSpec
    , featureDataR
    , featureDataL
    , define0
    , define1
    , define1d
    , define2
    , define2d
    , eval0
    , eval1
    , eval2
    , evalSpec0
    , evalSpec1
    , evalSpec2
) where

import safe GHC.Read                   ( Read )
import safe GHC.Show                   ( Show(show) )
import safe GHC.Generics               ( Generic, D )
import safe Control.Applicative        ( Applicative(..) )
import safe Control.Monad              ( Functor(..), Monad(..), join, liftM, liftM2)
import safe Data.Either                ( Either(..) )
import safe Data.Eq                    ( Eq )
import safe Data.Function              ( ($), (.) )
import safe Data.List             ( (++) )
import safe Data.Maybe                 ( Maybe(..), maybe )
import safe Data.Ord                   ( Ord )
import safe Data.Text                  ( Text )
-- 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 d = MkFeatureSpec {
        FeatureSpec b f e d -> Text
getSpecName :: Text
      , FeatureSpec b f e d -> b
getSpecAttr :: b
      , FeatureSpec b f e d -> FeatureDefinition f e d
getDefn :: FeatureDefinition f e 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 f e d
  -> FeatureSpec b f e d
makeFeatureSpec :: Text -> b -> FeatureDefinition f e d -> FeatureSpec b f e d
makeFeatureSpec = Text -> b -> FeatureDefinition f e d -> FeatureSpec b f e d
forall b f e d.
Text -> b -> FeatureDefinition f e d -> FeatureSpec b f e d
MkFeatureSpec

{- | A 'Feature' contains the following:
      * a name
      * its attributes
      * 'FeatureData'
-}
data (Show b) => Feature b d = MkFeature {
        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)

instance (Show b, Show d) => Show (Feature b d) where
    show :: Feature b d -> String
show Feature b d
x = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Feature b d -> Text
forall b d. Show b => Feature b d -> Text
getName Feature b d
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show (Feature b d -> b
forall b d. Show b => Feature b d -> b
getAttr Feature b d
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ FeatureData d -> String
forall a. Show a => a -> String
show (Feature b d -> FeatureData d
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b d
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" )\n"

instance (Show b) => Functor (Feature b) where
  fmap :: (a -> b) -> Feature b a -> Feature b b
fmap a -> b
f (MkFeature Text
n b
a FeatureData a
d) = Text -> b -> FeatureData b -> Feature b b
forall b d. Text -> b -> FeatureData d -> Feature b d
MkFeature Text
n b
a ((a -> b) -> FeatureData a -> FeatureData b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f FeatureData a
d)

{- | 'FeatureData' is @'Either' 'MissingReason' d@, where @d@ can be any type 
     of data derivable from 'Hasklepias.Event.Events'.
-}
newtype FeatureData d = MkFeatureData { 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 (MkFeatureData Either MissingReason a
x) = Either MissingReason b -> FeatureData b
forall d. Either MissingReason d -> FeatureData d
MkFeatureData ((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)

instance Applicative FeatureData where
  pure :: a -> FeatureData a
pure = a -> FeatureData a
forall a. a -> FeatureData a
featureDataR
  liftA2 :: (a -> b -> c) -> FeatureData a -> FeatureData b -> FeatureData c
liftA2 a -> b -> c
f (MkFeatureData Either MissingReason a
x) (MkFeatureData Either MissingReason b
y) = Either MissingReason c -> FeatureData c
forall d. Either MissingReason d -> FeatureData d
MkFeatureData ( (a -> b -> c)
-> Either MissingReason a
-> Either MissingReason b
-> Either MissingReason c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Either MissingReason a
x Either MissingReason b
y )

instance Monad FeatureData where
  (MkFeatureData Either MissingReason a
x) >>= :: FeatureData a -> (a -> FeatureData b) -> FeatureData b
>>= a -> FeatureData b
f = 
    case (a -> FeatureData b)
-> Either MissingReason a -> Either MissingReason (FeatureData b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FeatureData b
f Either MissingReason a
x of
         Left MissingReason
l  -> MissingReason -> FeatureData b
forall d. MissingReason -> FeatureData d
featureDataL MissingReason
l
         Right FeatureData b
v -> FeatureData b
v

-- | 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
MkFeatureData (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
MkFeatureData (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

-- | 'FeatureData' 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)

-- TODO: the code below should be generalized so that there is a single define/eval
--       interface.
-- | A type to hold FeatureData definitions; i.e. functions that return 
--  features. 
data FeatureDefinition f e d =
    FD0 (e -> FeatureData d)
  | FD1 (FeatureData e -> FeatureData d)
  | FD2 (FeatureData f -> FeatureData e -> FeatureData d)

-- | TODO
define0 :: (e -> FeatureData d) -> FeatureDefinition * e d
define0 :: (e -> FeatureData d) -> FeatureDefinition * e d
define0 = (e -> FeatureData d) -> FeatureDefinition * e d
forall f e d. (e -> FeatureData d) -> FeatureDefinition f e d
FD0

-- | TODO
eval0 :: FeatureDefinition * e d -> e -> FeatureData d
eval0 :: FeatureDefinition * e d -> e -> FeatureData d
eval0 (FD0 e -> FeatureData d
f) = e -> FeatureData d
f

-- | TODO
evalSpec0 :: (Show b) => FeatureSpec b * e d -> e -> Feature b d
evalSpec0 :: FeatureSpec b * e d -> e -> Feature b d
evalSpec0 (MkFeatureSpec Text
nm b
attr FeatureDefinition * e d
def) e
y = Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
MkFeature Text
nm b
attr (FeatureDefinition * e d -> e -> FeatureData d
forall e d. FeatureDefinition * e d -> e -> FeatureData d
eval0 FeatureDefinition * e d
def e
y)

-- | TODO
define1 :: (e -> d) -> FeatureDefinition * e d
define1 :: (e -> d) -> FeatureDefinition * e d
define1 e -> d
f = (FeatureData e -> FeatureData d) -> FeatureDefinition * e d
forall f e d.
(FeatureData e -> FeatureData d) -> FeatureDefinition f e d
FD1 ((FeatureData e -> FeatureData d) -> FeatureDefinition * e d)
-> (FeatureData e -> FeatureData d) -> FeatureDefinition * e d
forall a b. (a -> b) -> a -> b
$ (e -> d) -> FeatureData e -> FeatureData d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> d
f

-- | TODO
define1d :: (e -> FeatureData d) -> FeatureDefinition * e d
define1d :: (e -> FeatureData d) -> FeatureDefinition * e d
define1d e -> FeatureData d
f = (FeatureData e -> FeatureData d) -> FeatureDefinition * e d
forall f e d.
(FeatureData e -> FeatureData d) -> FeatureDefinition f e d
FD1 (FeatureData e -> (e -> FeatureData d) -> FeatureData d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= e -> FeatureData d
f)

-- | TODO
eval1 :: FeatureDefinition * e d -> FeatureData e -> FeatureData d
eval1 :: FeatureDefinition * e d -> FeatureData e -> FeatureData d
eval1 (FD1 FeatureData e -> FeatureData d
f) = FeatureData e -> FeatureData d
f

-- | TODO
evalSpec1 :: (Show b) => FeatureSpec b * e d -> Feature b e -> Feature b d
evalSpec1 :: FeatureSpec b * e d -> Feature b e -> Feature b d
evalSpec1 (MkFeatureSpec Text
nm b
attr FeatureDefinition * e d
def) Feature b e
y = Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
MkFeature Text
nm b
attr (FeatureDefinition * e d -> FeatureData e -> FeatureData d
forall e d.
FeatureDefinition * e d -> FeatureData e -> FeatureData d
eval1 FeatureDefinition * e d
def (Feature b e -> FeatureData e
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b e
y))

-- | TODO
define2 :: (f -> e -> d) -> FeatureDefinition f e d
define2 :: (f -> e -> d) -> FeatureDefinition f e d
define2 f -> e -> d
f =  (FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e d
forall f e d.
(FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e d
FD2 ((FeatureData f -> FeatureData e -> FeatureData d)
 -> FeatureDefinition f e d)
-> (FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e d
forall a b. (a -> b) -> a -> b
$ (f -> e -> d) -> FeatureData f -> FeatureData e -> FeatureData d
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f -> e -> d
f

-- | TODO
define2d :: (f -> e -> FeatureData d) -> FeatureDefinition f e d
define2d :: (f -> e -> FeatureData d) -> FeatureDefinition f e d
define2d f -> e -> FeatureData d
f = (FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e d
forall f e d.
(FeatureData f -> FeatureData e -> FeatureData d)
-> FeatureDefinition f e d
FD2 (\FeatureData f
x FeatureData e
y -> FeatureData (FeatureData d) -> FeatureData d
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((f -> e -> FeatureData d)
-> FeatureData f -> FeatureData e -> FeatureData (FeatureData d)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 f -> e -> FeatureData d
f FeatureData f
x FeatureData e
y))

-- | TODO
eval2 :: FeatureDefinition f e d -> FeatureData f -> FeatureData e -> FeatureData d
eval2 :: FeatureDefinition f e d
-> FeatureData f -> FeatureData e -> FeatureData d
eval2 (FD2 FeatureData f -> FeatureData e -> FeatureData d
f) = FeatureData f -> FeatureData e -> FeatureData d
f

-- | TODO
evalSpec2 :: (Show b) => FeatureSpec b f e d -> Feature b f -> Feature b e -> Feature b d
evalSpec2 :: FeatureSpec b f e d -> Feature b f -> Feature b e -> Feature b d
evalSpec2 (MkFeatureSpec Text
nm b
attr FeatureDefinition f e d
def) Feature b f
y Feature b e
z = Text -> b -> FeatureData d -> Feature b d
forall b d. Text -> b -> FeatureData d -> Feature b d
MkFeature Text
nm b
attr (FeatureDefinition f e d
-> FeatureData f -> FeatureData e -> FeatureData d
forall f e d.
FeatureDefinition f e d
-> FeatureData f -> FeatureData e -> FeatureData d
eval2 FeatureDefinition f e d
def (Feature b f -> FeatureData f
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b f
y) (Feature b e -> FeatureData e
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b e
z))