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

-}
{-# OPTIONS_HADDOCK hide #-}

{-# LANGUAGE Safe #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}

module Features.Compose
  (
  -- *** Features and FeatureData
    FeatureData
  , MissingReason(..)
  , Feature
  , FeatureN
  , featureDataL
  , featureDataR
  , missingBecause
  , makeFeature
  , getFeatureData
  , getFData
  , getData
  , getDataN
  , getNameN
  , nameFeature

  -- *** Feature Definitions
  , Definition(..)
  , Define(..)
  , DefineA(..)

  --- *** Evalution of Definitions
  , Eval(..)

  ) where

import safe      Control.Applicative            ( (<$>)
                                                , Applicative(..)
                                                , liftA3
                                                )
import safe      Control.Monad                  ( (=<<)
                                                , Functor(..)
                                                , Monad(..)
                                                , join
                                                , liftM
                                                , liftM2
                                                , liftM3
                                                , liftM4
                                                )
import safe      Data.Either                    ( Either(..) )
import safe      Data.Eq                        ( Eq(..) )
import safe      Data.Foldable                  ( Foldable(foldr)
                                                , fold
                                                )
import safe      Data.Function                  ( ($)
                                                , (.)
                                                , id
                                                )
import safe      Data.List                      ( (++)
                                                , concat
                                                , transpose
                                                )
import safe      Data.Proxy                     ( Proxy(..) )
import safe      Data.Text                      ( Text
                                                , pack
                                                )
import safe      Data.Traversable               ( Traversable(..) )
import safe      GHC.Generics                   ( Generic )
import safe      GHC.Show                       ( Show(show) )
import safe      GHC.TypeLits                   ( KnownSymbol
                                                , Symbol
                                                , symbolVal
                                                )

{- | 
Defines the reasons that a @'FeatureData'@ value may be missing. Can be used to
indicate the reason that a @'Feature'@'s data was unable to be derived or does
not need to be derived. 
-}
{- tag::missingReason[] -}
data MissingReason =
    InsufficientData -- ^ Insufficient information available to derive data.
  | Other Text -- ^ User provided reason for missingness
{- end::missingReason[] -}
  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, 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)

{- | 
The @FeatureData@ type is a container for an (almost) arbitrary type @d@ that can
have a "failed" or "missing" state. The failure is represented by the @'Left'@ of 
an @'Either'@, while the data @d@ is contained in the @'Either'@'s @'Right'@.

To construct a successful value, use @'featureDataR'@. A missing value can be 
constructed with @'featureDataL'@ or its synonym @'missingBecause'@.

-}
{- tag::featureData[] -}
newtype FeatureData d = MkFeatureData {
    FeatureData d -> Either MissingReason d
getFeatureData :: Either MissingReason d  -- ^ Unwrap FeatureData.
  }
{- end::featureData[] -}
  deriving (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, 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, (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)

-- | Creates a non-missing 'FeatureData'. Since @'FeatureData'@ is an instance of
-- @'Applicative'@, @'pure'@ is also a synonym of for @'featureDataR'@.
-- 
-- >>> featureDataR "aString"
-- MkFeatureData (Right "aString")
-- >>> featureDataR (1 :: P.Int)
-- MkFeatureData (Right 1)
-- 
-- >>> featureDataR ("aString", (1 :: P.Int))
-- MkFeatureData (Right ("aString",1))
--
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

-- | Creates a missing 'FeatureData'.
-- 
-- >>> featureDataL (Other "no good reason") :: FeatureData P.Int
-- MkFeatureData (Left (Other "no good reason"))
--
-- >>> featureDataL (Other "no good reason") :: FeatureData Text
-- MkFeatureData (Left (Other "no good reason"))
--
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

-- | A synonym for 'featureDataL'.
missingBecause :: MissingReason -> FeatureData d
missingBecause :: MissingReason -> FeatureData d
missingBecause = MissingReason -> FeatureData d
forall d. MissingReason -> FeatureData d
featureDataL

{- FeatureData instances -}

-- | Transform ('fmap') @'FeatureData'@ of one type to another.
--
-- >>> x = featureDataR (1 :: P.Int)
-- >>> :type x
-- >>> :type ( fmap show x )
-- x :: FeatureData Int
-- ( fmap show x ) :: FeatureData String
-- 
-- Note that 'Left' values are carried along while the type changes:
--
-- >>> x = ( featureDataL InsufficientData ) :: FeatureData P.Int
-- >>> :type x
-- >>> x
-- >>> :type ( fmap show x )
-- >>> fmap show x 
-- x :: FeatureData Int
-- MkFeatureData {getFeatureData = Left InsufficientData}
-- ( fmap show x ) :: FeatureData String
-- MkFeatureData {getFeatureData = Left InsufficientData}
--
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 -> Either MissingReason b -> FeatureData b
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (Either MissingReason b -> FeatureData b)
-> Either MissingReason b -> FeatureData b
forall a b. (a -> b) -> a -> b
$ MissingReason -> Either MissingReason b
forall a b. a -> Either a b
Left MissingReason
l
    Right FeatureData b
v -> FeatureData b
v

instance Foldable FeatureData where
  foldr :: (a -> b -> b) -> b -> FeatureData a -> b
foldr a -> b -> b
f b
x (MkFeatureData Either MissingReason a
z) = (a -> b -> b) -> b -> Either MissingReason a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
x Either MissingReason a
z

instance Traversable FeatureData where
  traverse :: (a -> f b) -> FeatureData a -> f (FeatureData b)
traverse a -> f b
f (MkFeatureData Either MissingReason a
z) = Either MissingReason b -> FeatureData b
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (Either MissingReason b -> FeatureData b)
-> f (Either MissingReason b) -> f (FeatureData b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Either MissingReason a -> f (Either MissingReason b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Either MissingReason a
z

{- | 
The @'Feature'@ is an abstraction for @name@d @d@ata, where the @name@ is a
*type*. Essentially, it is a container for @'FeatureData'@ that assigns a @name@
to the data.

Except when using @'pure'@ to lift data into a @Feature@, @Feature@s can only be
derived from other @Feature@ via a @'Definition'@.
-}
{- tag::feature[] -}
newtype (KnownSymbol name) => Feature name d =
  MkFeature  ( FeatureData d )
{- end::feature[] -}
  deriving (Feature name d -> Feature name d -> Bool
(Feature name d -> Feature name d -> Bool)
-> (Feature name d -> Feature name d -> Bool)
-> Eq (Feature name d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (name :: Symbol) d.
Eq d =>
Feature name d -> Feature name d -> Bool
/= :: Feature name d -> Feature name d -> Bool
$c/= :: forall (name :: Symbol) d.
Eq d =>
Feature name d -> Feature name d -> Bool
== :: Feature name d -> Feature name d -> Bool
$c== :: forall (name :: Symbol) d.
Eq d =>
Feature name d -> Feature name d -> Bool
Eq)

-- | Gets the 'FeatureData' from a 'Feature'.
getFData :: Feature name d -> FeatureData d
getFData :: Feature name d -> FeatureData d
getFData (MkFeature FeatureData d
d) = FeatureData d
d

-- | A utility for constructing a @'Feature'@ from @'FeatureData'@.
-- Since @name@ is a type, you may need to annotate the type when using this
-- function.
--
-- >>> makeFeature (pure "test") :: Feature "dummy" Text
-- "dummy": MkFeatureData {getFeatureData = Right "test"}
--
makeFeature :: (KnownSymbol name) => FeatureData d -> Feature name d
makeFeature :: FeatureData d -> Feature name d
makeFeature = FeatureData d -> Feature name d
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature

-- | A utility for getting the (inner) @'FeatureData'@ content of a @'Feature'@.
getData :: Feature n d -> Either MissingReason d
getData :: Feature n d -> Either MissingReason d
getData (MkFeature FeatureData d
x) = FeatureData d -> Either MissingReason d
forall d. FeatureData d -> Either MissingReason d
getFeatureData FeatureData d
x

{- Feature instances -}
instance (KnownSymbol name, Show a) => Show (Feature name a) where
  show :: Feature name a -> String
show (MkFeature FeatureData a
x) = ShowS
forall a. Show a => a -> String
show (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FeatureData a -> String
forall a. Show a => a -> String
show FeatureData a
x

instance Functor (Feature name) where
  fmap :: (a -> b) -> Feature name a -> Feature name b
fmap a -> b
f (MkFeature FeatureData a
x) = FeatureData b -> Feature name b
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature ((a -> b) -> FeatureData a -> FeatureData b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f FeatureData a
x)

instance Applicative (Feature name) where
  pure :: a -> Feature name a
pure a
x = FeatureData a -> Feature name a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (a -> FeatureData a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  liftA2 :: (a -> b -> c) -> Feature name a -> Feature name b -> Feature name c
liftA2 a -> b -> c
f (MkFeature FeatureData a
x) (MkFeature FeatureData b
y) = FeatureData c -> Feature name c
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature ((a -> b -> c) -> FeatureData a -> FeatureData b -> FeatureData c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f FeatureData a
x FeatureData b
y)

instance Foldable (Feature name) where
  foldr :: (a -> b -> b) -> b -> Feature name a -> b
foldr a -> b -> b
f b
x (MkFeature FeatureData a
t) = (a -> b -> b) -> b -> FeatureData a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
x FeatureData a
t

instance Traversable (Feature name) where
  traverse :: (a -> f b) -> Feature name a -> f (Feature name b)
traverse a -> f b
f (MkFeature FeatureData a
x) = FeatureData b -> Feature name b
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData b -> Feature name b)
-> f (FeatureData b) -> f (Feature name b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> FeatureData a -> f (FeatureData b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f FeatureData a
x

instance Monad (Feature name) where
  (MkFeature FeatureData a
x) >>= :: Feature name a -> (a -> Feature name b) -> Feature name b
>>= a -> Feature name b
f = case (a -> Feature name b)
-> FeatureData a -> FeatureData (Feature name b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Feature name b
f FeatureData a
x of
    MkFeatureData (Left  MissingReason
l) -> FeatureData b -> Feature name b
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData b -> Feature name b)
-> FeatureData b -> Feature name b
forall a b. (a -> b) -> a -> b
$ Either MissingReason b -> FeatureData b
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (MissingReason -> Either MissingReason b
forall a b. a -> Either a b
Left MissingReason
l)
    MkFeatureData (Right Feature name b
r) -> Feature name b
r

{- |
The @'FeatureN'@ type is similar to @'Feature'@ where the @name@ is included
as a @Text@ field. This type is mainly for internal purposes in order to collect
@Feature@s of the same type @d@ into a homogeneous container like a @'Data.List'@.
-}
data FeatureN d = MkFeatureN
  { FeatureN d -> Text
getNameN :: Text  -- ^ Get the name of a @FeatureN@.
  , FeatureN d -> FeatureData d
getDataN :: FeatureData d -- ^ Get the data of a @FeatureN@
  }
  deriving (FeatureN d -> FeatureN d -> Bool
(FeatureN d -> FeatureN d -> Bool)
-> (FeatureN d -> FeatureN d -> Bool) -> Eq (FeatureN d)
forall d. Eq d => FeatureN d -> FeatureN d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeatureN d -> FeatureN d -> Bool
$c/= :: forall d. Eq d => FeatureN d -> FeatureN d -> Bool
== :: FeatureN d -> FeatureN d -> Bool
$c== :: forall d. Eq d => FeatureN d -> FeatureN d -> Bool
Eq, Int -> FeatureN d -> ShowS
[FeatureN d] -> ShowS
FeatureN d -> String
(Int -> FeatureN d -> ShowS)
-> (FeatureN d -> String)
-> ([FeatureN d] -> ShowS)
-> Show (FeatureN d)
forall d. Show d => Int -> FeatureN d -> ShowS
forall d. Show d => [FeatureN d] -> ShowS
forall d. Show d => FeatureN d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeatureN d] -> ShowS
$cshowList :: forall d. Show d => [FeatureN d] -> ShowS
show :: FeatureN d -> String
$cshow :: forall d. Show d => FeatureN d -> String
showsPrec :: Int -> FeatureN d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> FeatureN d -> ShowS
Show)

-- | A utility for converting a @'Feature'@ to @'FeatureN'@.
nameFeature
  :: forall name d . (KnownSymbol name) => Feature name d -> FeatureN d
nameFeature :: Feature name d -> FeatureN d
nameFeature (MkFeature FeatureData d
d) = Text -> FeatureData d -> FeatureN d
forall d. Text -> FeatureData d -> FeatureN d
MkFeatureN (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) FeatureData d
d

{- | A @Definition@ can be thought of as a lifted function. Specifically, the
@'define'@ function takes an arbitrary function (currently up to three arguments)
and returns a @Defintion@ where the arguments have been lifted to a new domain.

For example, here we take @f@ and lift to to a function of @Feature@s.

@
f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature "A" Int -> Feature "B" String -> Feature "C" Bool )
myFeature = define f
@

See @'eval'@ for evaluating @Defintions@. 

-}
data Definition d where
  D1  ::(b -> a) -> Definition (f1 b -> f0 a)
  D1A ::(b -> f0 a) -> Definition (f1 b -> f0 a)
  D2  ::(c -> b -> a) -> Definition (f2 c -> f1 b -> f0 a)
  D2A ::(c -> b -> f0 a) -> Definition (f2 c -> f1 b -> f0 a)
  D3  ::(d -> c -> b -> a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)
  D3A ::(d -> c -> b -> f0 a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)
  D4  ::(e -> d -> c -> b -> a) -> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a)
  D4A ::(e -> d -> c -> b -> f0 a) -> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a)

{- | Define (and @'DefineA@) provide a means to create new @'Definition'@s via 
@'define'@ (@'defineA'@). The @'define'@ function takes a single function input 
and returns a lifted function. For example,

@
f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature "A" Int -> Feature "B" String -> Feature "C" Bool )
myFeature = define f
@

The @'defineA'@ function is similar, except that the return type of the input
function is already lifted. In the example below, an input of @Nothing@ is 
considered a missing state: 

@
f :: Int -> Maybe String -> Feature "C" Bool
f i s 
  | 1 (Just "yes")   = pure True
  | _ (Just _ )      = pure False -- False for any Int and any (Just String)
  | otherwise        = pure $ missingBecause InsufficientData -- missing if no string

myFeature :: Definition (Feature "A" Int -> Feature "B" String -> Feature "C" Bool )
myFeature = defineA f
@

-}
class Define inputs def | def -> inputs where
  define :: inputs -> Definition def

-- | See @'Define'@.
class DefineA inputs def | def -> inputs where
  defineA :: inputs -> Definition def

instance Define (b -> a) (FeatureData b -> FeatureData a) where
  define :: (b -> a) -> Definition (FeatureData b -> FeatureData a)
define = (b -> a) -> Definition (FeatureData b -> FeatureData a)
forall b a (b :: * -> *) (f0 :: * -> *).
(b -> a) -> Definition (b b -> f0 a)
D1
instance Define (c -> b -> a) (FeatureData c -> FeatureData b -> FeatureData a) where
  define :: (c -> b -> a)
-> Definition (FeatureData c -> FeatureData b -> FeatureData a)
define = (c -> b -> a)
-> Definition (FeatureData c -> FeatureData b -> FeatureData a)
forall a f1 a (c :: * -> *) (b :: * -> *) (f0 :: * -> *).
(a -> f1 -> a) -> Definition (c a -> b f1 -> f0 a)
D2
instance Define (d -> c -> b -> a) (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where
  define :: (d -> c -> b -> a)
-> Definition
     (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
define = (d -> c -> b -> a)
-> Definition
     (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
forall a f2 f1 a (d :: * -> *) (c :: * -> *) (b :: * -> *)
       (f0 :: * -> *).
(a -> f2 -> f1 -> a) -> Definition (d a -> c f2 -> b f1 -> f0 a)
D3
instance Define (e -> d -> c -> b -> a) (FeatureData e -> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where
  define :: (e -> d -> c -> b -> a)
-> Definition
     (FeatureData e
      -> FeatureData d
      -> FeatureData c
      -> FeatureData b
      -> FeatureData a)
define = (e -> d -> c -> b -> a)
-> Definition
     (FeatureData e
      -> FeatureData d
      -> FeatureData c
      -> FeatureData b
      -> FeatureData a)
forall a f3 f2 f1 a (e :: * -> *) (d :: * -> *) (c :: * -> *)
       (b :: * -> *) (f0 :: * -> *).
(a -> f3 -> f2 -> f1 -> a)
-> Definition (e a -> d f3 -> c f2 -> b f1 -> f0 a)
D4

instance DefineA (b -> FeatureData a) (FeatureData b -> FeatureData a) where
  defineA :: (b -> FeatureData a) -> Definition (FeatureData b -> FeatureData a)
defineA = (b -> FeatureData a) -> Definition (FeatureData b -> FeatureData a)
forall b (f0 :: * -> *) a (f1 :: * -> *).
(b -> f0 a) -> Definition (f1 b -> f0 a)
D1A
instance DefineA (c -> b -> FeatureData a) (FeatureData c -> FeatureData b -> FeatureData a) where
  defineA :: (c -> b -> FeatureData a)
-> Definition (FeatureData c -> FeatureData b -> FeatureData a)
defineA = (c -> b -> FeatureData a)
-> Definition (FeatureData c -> FeatureData b -> FeatureData a)
forall c b (f0 :: * -> *) a (f2 :: * -> *) (f1 :: * -> *).
(c -> b -> f0 a) -> Definition (f2 c -> f1 b -> f0 a)
D2A
instance DefineA (d -> c -> b -> FeatureData a) (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where
  defineA :: (d -> c -> b -> FeatureData a)
-> Definition
     (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
defineA = (d -> c -> b -> FeatureData a)
-> Definition
     (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
forall d c b (f0 :: * -> *) a (f3 :: * -> *) (f2 :: * -> *)
       (f1 :: * -> *).
(d -> c -> b -> f0 a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)
D3A
instance DefineA (e -> d -> c -> b -> FeatureData a) (FeatureData e -> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where
  defineA :: (e -> d -> c -> b -> FeatureData a)
-> Definition
     (FeatureData e
      -> FeatureData d
      -> FeatureData c
      -> FeatureData b
      -> FeatureData a)
defineA = (e -> d -> c -> b -> FeatureData a)
-> Definition
     (FeatureData e
      -> FeatureData d
      -> FeatureData c
      -> FeatureData b
      -> FeatureData a)
forall e d c b (f0 :: * -> *) a (f4 :: * -> *) (f3 :: * -> *)
       (f2 :: * -> *) (f1 :: * -> *).
(e -> d -> c -> b -> f0 a)
-> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a)
D4A

instance Define (b -> a) (Feature n1 b -> Feature n0 a) where
  define :: (b -> a) -> Definition (Feature n1 b -> Feature n0 a)
define = (b -> a) -> Definition (Feature n1 b -> Feature n0 a)
forall b a (b :: * -> *) (f0 :: * -> *).
(b -> a) -> Definition (b b -> f0 a)
D1
instance Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) where
  define :: (c -> b -> a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a)
define = (c -> b -> a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a)
forall a f1 a (c :: * -> *) (b :: * -> *) (f0 :: * -> *).
(a -> f1 -> a) -> Definition (c a -> b f1 -> f0 a)
D2
instance Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  define :: (d -> c -> b -> a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
define = (d -> c -> b -> a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
forall a f2 f1 a (d :: * -> *) (c :: * -> *) (b :: * -> *)
       (f0 :: * -> *).
(a -> f2 -> f1 -> a) -> Definition (d a -> c f2 -> b f1 -> f0 a)
D3
instance Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  define :: (e -> d -> c -> b -> a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
define = (e -> d -> c -> b -> a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
forall a f3 f2 f1 a (e :: * -> *) (d :: * -> *) (c :: * -> *)
       (b :: * -> *) (f0 :: * -> *).
(a -> f3 -> f2 -> f1 -> a)
-> Definition (e a -> d f3 -> c f2 -> b f1 -> f0 a)
D4

instance DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) where
  defineA :: (b -> Feature n0 a) -> Definition (Feature n1 b -> Feature n0 a)
defineA = (b -> Feature n0 a) -> Definition (Feature n1 b -> Feature n0 a)
forall b (f0 :: * -> *) a (f1 :: * -> *).
(b -> f0 a) -> Definition (f1 b -> f0 a)
D1A
instance DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) where
  defineA :: (c -> b -> Feature n0 a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a)
defineA = (c -> b -> Feature n0 a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a)
forall c b (f0 :: * -> *) a (f2 :: * -> *) (f1 :: * -> *).
(c -> b -> f0 a) -> Definition (f2 c -> f1 b -> f0 a)
D2A
instance DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  defineA :: (d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
defineA = (d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
forall d c b (f0 :: * -> *) a (f3 :: * -> *) (f2 :: * -> *)
       (f1 :: * -> *).
(d -> c -> b -> f0 a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)
D3A
instance DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  defineA :: (e -> d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
defineA = (e -> d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
forall e d c b (f0 :: * -> *) a (f4 :: * -> *) (f3 :: * -> *)
       (f2 :: * -> *) (f1 :: * -> *).
(e -> d -> c -> b -> f0 a)
-> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a)
D4A


{- | Evaluate a @Definition@. Note that (currently), the second argument of 'eval'
is a *tuple* of inputs. For example,

@
f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature "A" Int -> Feature "B" String -> Feature "C" Bool )
myFeature = define f

a :: Feature "A" Int
a = pure 1

b :: Feature "B" String
b = pure "yes"

c = eval myFeature (a, b)
@

-}
class Eval def args return | def -> args return where
  eval :: Definition def -- ^ a @'Definition'@
                     -> args -- ^ a tuple of arguments to the @'Definition'@
                     -> return

instance Eval (FeatureData b -> FeatureData a)
              (FeatureData b)  (FeatureData a) where
  eval :: Definition (FeatureData b -> FeatureData a)
-> FeatureData b -> FeatureData a
eval (D1  b -> a
f) FeatureData b
x = (b -> a) -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f FeatureData b
FeatureData b
x
  eval (D1A b -> f0 a
f) FeatureData b
x = FeatureData b
x FeatureData b -> (b -> FeatureData a) -> FeatureData a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> FeatureData a
b -> f0 a
f

instance Eval (Feature n1 b -> Feature n0 a)
              (Feature n1 b)  (Feature n0 a) where
  eval :: Definition (Feature n1 b -> Feature n0 a)
-> Feature n1 b -> Feature n0 a
eval (D1  b -> a
f) (MkFeature FeatureData b
x) = FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ (b -> a) -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f FeatureData b
FeatureData b
x
  eval (D1A b -> f0 a
f) (MkFeature FeatureData b
x) = case (b -> f0 a) -> FeatureData b -> FeatureData (f0 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> f0 a
f FeatureData b
FeatureData b
x of
    MkFeatureData (Left  MissingReason
l) -> FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ Either MissingReason a -> FeatureData a
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (MissingReason -> Either MissingReason a
forall a b. a -> Either a b
Left MissingReason
l)
    MkFeatureData (Right f0 a
r) -> f0 a
Feature n0 a
r


instance Eval (FeatureData c -> FeatureData b -> FeatureData a)
              (FeatureData c,   FeatureData b) (FeatureData a) where
  eval :: Definition (FeatureData c -> FeatureData b -> FeatureData a)
-> (FeatureData c, FeatureData b) -> FeatureData a
eval (D2  c -> b -> a
f) (FeatureData c
x, FeatureData b
y) = (c -> b -> a) -> FeatureData c -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> a
f FeatureData c
FeatureData c
x FeatureData b
FeatureData b
y
  eval (D2A c -> b -> f0 a
f) (FeatureData c
x, FeatureData b
y) = FeatureData (FeatureData a) -> FeatureData a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((c -> b -> f0 a)
-> FeatureData c -> FeatureData b -> FeatureData (f0 a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> f0 a
f FeatureData c
FeatureData c
x FeatureData b
FeatureData b
y)

instance Eval (Feature n2 c -> Feature n1 b -> Feature n0 a)
              (Feature n2 c,   Feature n1 b)  (Feature n0 a)
  where
  eval :: Definition (Feature n2 c -> Feature n1 b -> Feature n0 a)
-> (Feature n2 c, Feature n1 b) -> Feature n0 a
eval (D2  c -> b -> a
f) (MkFeature FeatureData c
x, MkFeature FeatureData b
y) = FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ (c -> b -> a) -> FeatureData c -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> a
f FeatureData c
FeatureData c
x FeatureData b
FeatureData b
y
  eval (D2A c -> b -> f0 a
f) (MkFeature FeatureData c
x, MkFeature FeatureData b
y) = case (c -> b -> f0 a)
-> FeatureData c -> FeatureData b -> FeatureData (f0 a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> f0 a
f FeatureData c
FeatureData c
x FeatureData b
FeatureData b
y of
    MkFeatureData (Left  MissingReason
l) -> FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ Either MissingReason a -> FeatureData a
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (MissingReason -> Either MissingReason a
forall a b. a -> Either a b
Left MissingReason
l)
    MkFeatureData (Right f0 a
r) -> f0 a
Feature n0 a
r

instance Eval (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
              (FeatureData d,   FeatureData c,   FeatureData b)  (FeatureData a)
  where
  eval :: Definition
  (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a)
-> (FeatureData d, FeatureData c, FeatureData b) -> FeatureData a
eval (D3  d -> c -> b -> a
f) (FeatureData d
x, FeatureData c
y, FeatureData b
z) = (d -> c -> b -> a)
-> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 d -> c -> b -> a
f FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z
  eval (D3A d -> c -> b -> f0 a
f) (FeatureData d
x, FeatureData c
y, FeatureData b
z) = FeatureData (FeatureData a) -> FeatureData a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((d -> c -> b -> f0 a)
-> FeatureData d
-> FeatureData c
-> FeatureData b
-> FeatureData (f0 a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 d -> c -> b -> f0 a
f FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z)

instance Eval (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
              (Feature n3 d,   Feature n2 c,   Feature n1 b)  (Feature n0 a)
   where
  eval :: Definition
  (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
-> (Feature n3 d, Feature n2 c, Feature n1 b) -> Feature n0 a
eval (D3 d -> c -> b -> a
f) (MkFeature FeatureData d
x, MkFeature FeatureData c
y, MkFeature FeatureData b
z) =
    FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ (d -> c -> b -> a)
-> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 d -> c -> b -> a
f FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z
  eval (D3A d -> c -> b -> f0 a
f) (MkFeature FeatureData d
x, MkFeature FeatureData c
y, MkFeature FeatureData b
z) = case (d -> c -> b -> f0 a)
-> FeatureData d
-> FeatureData c
-> FeatureData b
-> FeatureData (f0 a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 d -> c -> b -> f0 a
f FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z of
    MkFeatureData (Left  MissingReason
l) -> FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ Either MissingReason a -> FeatureData a
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (MissingReason -> Either MissingReason a
forall a b. a -> Either a b
Left MissingReason
l)
    MkFeatureData (Right f0 a
r) -> f0 a
Feature n0 a
r

instance Eval (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
              (Feature n4 e,   Feature n3 d,   Feature n2 c,   Feature n1 b)  (Feature n0 a)
   where
  eval :: Definition
  (Feature n4 e
   -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
-> (Feature n4 e, Feature n3 d, Feature n2 c, Feature n1 b)
-> Feature n0 a
eval (D4 e -> d -> c -> b -> a
f) (MkFeature FeatureData e
v, MkFeature FeatureData d
x, MkFeature FeatureData c
y, MkFeature FeatureData b
z) =
    FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ (e -> d -> c -> b -> a)
-> FeatureData e
-> FeatureData d
-> FeatureData c
-> FeatureData b
-> FeatureData a
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 e -> d -> c -> b -> a
f FeatureData e
FeatureData e
v FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z
  eval (D4A e -> d -> c -> b -> f0 a
f) (MkFeature FeatureData e
v, MkFeature FeatureData d
x, MkFeature FeatureData c
y, MkFeature FeatureData b
z) =
    case (e -> d -> c -> b -> f0 a)
-> FeatureData e
-> FeatureData d
-> FeatureData c
-> FeatureData b
-> FeatureData (f0 a)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 e -> d -> c -> b -> f0 a
f FeatureData e
FeatureData e
v FeatureData d
FeatureData d
x FeatureData c
FeatureData c
y FeatureData b
FeatureData b
z of
      MkFeatureData (Left  MissingReason
l) -> FeatureData a -> Feature n0 a
forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (FeatureData a -> Feature n0 a) -> FeatureData a -> Feature n0 a
forall a b. (a -> b) -> a -> b
$ Either MissingReason a -> FeatureData a
forall d. Either MissingReason d -> FeatureData d
MkFeatureData (MissingReason -> Either MissingReason a
forall a b. a -> Either a b
Left MissingReason
l)
      MkFeatureData (Right f0 a
r) -> f0 a
Feature n0 a
r

{- | Initializes @Feature@ @Attributes@ to empty strings -}

-- class HasAttributes n a where
--   getAttributes :: Feature n a -> Attributes
--   getAttributes _ = MkAttributes "" "" ""

-- instance (KnownSymbol n) => HasAttributes n a where
  -- getAttributes :: Feature n a -> Attributes
  -- getAttributes _ = MkAttributes "" "" ""