{-|
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 DeriveGeneric          #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE Trustworthy                   #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}

module Features.Core
  (
  -- *** Features and FeatureData
    FeatureData
  , FeatureProblemFlag(..)
  , Feature
  , F
  , featureDataL
  , featureDataR
  , missingBecause
  , makeFeature
  , getFeatureData
  , getFData
  , getData

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

  --- *** Evalution of Definitions
  , eval
  ) where

import safe           Control.Applicative (Applicative (..), liftA3, (<$>))
import safe           Control.Monad       (Functor (..), Monad (..), join,
                                           liftM, liftM2, liftM3, liftM4,
                                           liftM5, (=<<))
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)

-- | Type synonym for 'Feature'.
type F n a = Feature n a

-- | Type synonym for 'Definition'.
type Def d = Definition d

{- |
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::featureProblemFlag[] -}
data FeatureProblemFlag =
    InsufficientData -- ^ indicates there is insufficient data to define feature
  | InconsistentData Text -- ^ indicates an inconsistency in the data that should be flagged
  | CustomFlag Text -- ^ a means to indicate a custom problem in defining a feature
  deriving (FeatureProblemFlag -> FeatureProblemFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeatureProblemFlag -> FeatureProblemFlag -> Bool
$c/= :: FeatureProblemFlag -> FeatureProblemFlag -> Bool
== :: FeatureProblemFlag -> FeatureProblemFlag -> Bool
$c== :: FeatureProblemFlag -> FeatureProblemFlag -> Bool
Eq, Int -> FeatureProblemFlag -> ShowS
[FeatureProblemFlag] -> ShowS
FeatureProblemFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeatureProblemFlag] -> ShowS
$cshowList :: [FeatureProblemFlag] -> ShowS
show :: FeatureProblemFlag -> String
$cshow :: FeatureProblemFlag -> String
showsPrec :: Int -> FeatureProblemFlag -> ShowS
$cshowsPrec :: Int -> FeatureProblemFlag -> ShowS
Show, forall x. Rep FeatureProblemFlag x -> FeatureProblemFlag
forall x. FeatureProblemFlag -> Rep FeatureProblemFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeatureProblemFlag x -> FeatureProblemFlag
$cfrom :: forall x. FeatureProblemFlag -> Rep FeatureProblemFlag x
Generic)
{- end::featureProblemFlag[] -}


{- |
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 {
    forall d. FeatureData d -> Either FeatureProblemFlag d
getFeatureData :: Either FeatureProblemFlag d  -- ^ Unwrap FeatureData.
  }
{- end::featureData[] -}
  deriving (FeatureData d -> FeatureData d -> Bool
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
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 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 :: forall d. d -> FeatureData d
featureDataR = forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

-- | Creates a missing 'FeatureData'.
--
-- >>> featureDataL (CustomFlag "no good reason") :: FeatureData P.Int
-- MkFeatureData (Left (CustomFlag "no good reason"))
--
-- >>> featureDataL (CustomFlag "no good reason") :: FeatureData Text
-- MkFeatureData (Left (CustomFlag "no good reason"))
--
featureDataL :: FeatureProblemFlag -> FeatureData d
featureDataL :: forall d. FeatureProblemFlag -> FeatureData d
featureDataL = forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

-- | A synonym for 'featureDataL'.
missingBecause :: FeatureProblemFlag -> FeatureData d
missingBecause :: forall d. FeatureProblemFlag -> FeatureData d
missingBecause = forall d. FeatureProblemFlag -> 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 :: forall a b. (a -> b) -> FeatureData a -> FeatureData b
fmap a -> b
f (MkFeatureData Either FeatureProblemFlag a
x) = forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either FeatureProblemFlag a
x)

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

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

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

instance Traversable FeatureData where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FeatureData a -> f (FeatureData b)
traverse a -> f b
f (MkFeatureData Either FeatureProblemFlag a
z) = forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Either FeatureProblemFlag 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
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 :: forall (name :: Symbol) d. 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
  :: forall name d . (KnownSymbol name) => FeatureData d -> Feature name d
makeFeature :: forall (name :: Symbol) d.
KnownSymbol name =>
FeatureData d -> Feature name d
makeFeature = 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 FeatureProblemFlag d
getData :: forall (n :: Symbol) d. Feature n d -> Either FeatureProblemFlag d
getData (MkFeature FeatureData d
x) = forall d. FeatureData d -> Either FeatureProblemFlag 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) = forall a. Show a => a -> String
show (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FeatureData a
x

instance Functor (Feature name) where
  fmap :: forall a b. (a -> b) -> Feature name a -> Feature name b
fmap a -> b
f (MkFeature FeatureData a
x) = forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (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 :: forall a. a -> Feature name a
pure a
x = forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  liftA2 :: forall a b c.
(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) = forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature (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 :: forall a b. (a -> b -> b) -> b -> Feature name a -> b
foldr a -> b -> b
f b
x (MkFeature FeatureData a
t) = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Feature name a -> f (Feature name b)
traverse a -> f b
f (MkFeature FeatureData a
x) = forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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) >>= :: forall a b.
Feature name a -> (a -> Feature name b) -> Feature name b
>>= a -> Feature name b
f = case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Feature name b
f FeatureData a
x of
    MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
    MkFeatureData (Right Feature name b
r) -> Feature name b
r


{- | 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
  Pure ::a -> Definition (F n0 a )
  D1  ::(b -> a) -> Definition (F n1 b -> F n0 a)
  D1A ::(b -> F n0 a) -> Definition (F n1 b -> F n0 a)
  D1C  ::(a2 -> a1 -> a)
          -> Definition (F n1 b -> F n02 a2)
          -> Definition (F n1 b -> F n01 a1)
          -> Definition (F n1 b -> F n0 a )
  D2  ::(c -> b -> a) -> Definition (F n2 c -> F n1 b -> F n0 a)
  D2A ::(c -> b -> F n0 a) -> Definition (F n2 c -> F n1 b -> F n0 a)
  D2C  ::(a2 -> a1 -> a)
          -> Definition (F n2 c -> F n1 b -> F n02 a2)
          -> Definition (F n2 c -> F n1 b -> F n01 a1)
          -> Definition (F n2 c -> F n1 b -> F n0 a )
  D3  ::(d -> c -> b -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D3A ::(d -> c -> b -> F n0 a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D3C  ::(a2 -> a1 -> a)
          -> Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2)
          -> Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1)
          -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a )
  D4  ::(e -> d -> c -> b -> a)
         -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D4A ::(e -> d -> c -> b -> F n0 a)
           -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D4C  ::(a2 -> a1 -> a)
          -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
          -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
          -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a )
  D5  ::(f -> e -> d -> c -> b -> a)
         -> Definition (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D5A ::(f -> e -> d -> c -> b -> F n0 a)
           -> Definition (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
  D5C  ::(a2 -> a1 -> a)
          -> Definition (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
          -> Definition (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
          -> Definition (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 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

instance Define a (Feature n0 a) where
  define :: a -> Definition (Feature n0 a)
define = forall a (n0 :: Symbol). a -> Definition (Feature n0 a)
Pure
instance Define (b -> a) (Feature n1 b -> Feature n0 a) where
  define :: (b -> a) -> Definition (Feature n1 b -> Feature n0 a)
define = forall b a (n1 :: Symbol) (n0 :: Symbol).
(b -> a) -> Definition (Feature n1 b -> Feature n0 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 = forall c b a (n2 :: Symbol) (n1 :: Symbol) (n0 :: Symbol).
(c -> b -> a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 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 = forall d c b a (n3 :: Symbol) (n2 :: Symbol) (n1 :: Symbol)
       (n0 :: Symbol).
(d -> c -> b -> a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 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 = forall e d c b a (n4 :: Symbol) (n3 :: Symbol) (n2 :: Symbol)
       (n1 :: Symbol) (n0 :: Symbol).
(e -> d -> c -> b -> a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
D4
instance Define (f -> e -> d -> c -> b -> a) (Feature n5 f -> Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  define :: (f -> e -> d -> c -> b -> a)
-> Definition
     (Feature n5 f
      -> Feature n4 e
      -> Feature n3 d
      -> Feature n2 c
      -> Feature n1 b
      -> Feature n0 a)
define = forall f e d c b a (n5 :: Symbol) (n4 :: Symbol) (n3 :: Symbol)
       (n2 :: Symbol) (n1 :: Symbol) (n0 :: Symbol).
(f -> e -> d -> c -> b -> a)
-> Definition
     (Feature n5 f
      -> Feature n4 e
      -> Feature n3 d
      -> Feature n2 c
      -> Feature n1 b
      -> Feature n0 a)
D5

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

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 = forall b (n0 :: Symbol) a (n1 :: Symbol).
(b -> Feature n0 a) -> Definition (Feature n1 b -> Feature n0 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 = forall c b (n0 :: Symbol) a (n2 :: Symbol) (n1 :: Symbol).
(c -> b -> Feature n0 a)
-> Definition (Feature n2 c -> Feature n1 b -> Feature n0 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 = forall d c b (n0 :: Symbol) a (n3 :: Symbol) (n2 :: Symbol)
       (n1 :: Symbol).
(d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 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 = forall e d c b (n0 :: Symbol) a (n4 :: Symbol) (n3 :: Symbol)
       (n2 :: Symbol) (n1 :: Symbol).
(e -> d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n4 e
      -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)
D4A
instance DefineA (f -> e -> d -> c -> b -> Feature n0 a) (Feature n5 f -> Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where
  defineA :: (f -> e -> d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n5 f
      -> Feature n4 e
      -> Feature n3 d
      -> Feature n2 c
      -> Feature n1 b
      -> Feature n0 a)
defineA = forall f e d c b (n0 :: Symbol) a (n5 :: Symbol) (n4 :: Symbol)
       (n3 :: Symbol) (n2 :: Symbol) (n1 :: Symbol).
(f -> e -> d -> c -> b -> Feature n0 a)
-> Definition
     (Feature n5 f
      -> Feature n4 e
      -> Feature n3 d
      -> Feature n2 c
      -> Feature n1 b
      -> Feature n0 a)
D5A

{- | 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
@

-}

eval :: Definition d -> d
eval :: forall d. Definition d -> d
eval Definition d
d = case Definition d
d of
  Pure a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  D1   b -> a
f -> \(MkFeature FeatureData b
x) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f FeatureData b
x
  D1A  b -> F n0 a
f -> \(MkFeature FeatureData b
x) -> case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> F n0 a
f FeatureData b
x of
    MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
    MkFeatureData (Right F n0 a
r) -> F n0 a
r
  D1C a2 -> a1 -> a
f Definition (F n1 b -> F n02 a2)
d1 Definition (F n1 b -> F n01 a1)
d2 ->
    \F n1 b
x -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a2 -> a1 -> a
f (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData (forall d. Definition d -> d
eval Definition (F n1 b -> F n02 a2)
d1 F n1 b
x)) (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData (forall d. Definition d -> d
eval Definition (F n1 b -> F n01 a1)
d2 F n1 b
x))
  D2  c -> b -> a
f -> \(MkFeature FeatureData c
x) (MkFeature FeatureData b
y) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> a
f FeatureData c
x FeatureData b
y
  D2A c -> b -> F n0 a
f -> \(MkFeature FeatureData c
x) (MkFeature FeatureData b
y) -> case forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> b -> F n0 a
f FeatureData c
x FeatureData b
y of
    MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
    MkFeatureData (Right F n0 a
r) -> F n0 a
r
  D2C a2 -> a1 -> a
f Definition (F n2 c -> F n1 b -> F n02 a2)
d1 Definition (F n2 c -> F n1 b -> F n01 a1)
d2 -> \F n2 c
x F n1 b
y ->
    forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a2 -> a1 -> a
f (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData (forall d. Definition d -> d
eval Definition (F n2 c -> F n1 b -> F n02 a2)
d1 F n2 c
x F n1 b
y)) (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData (forall d. Definition d -> d
eval Definition (F n2 c -> F n1 b -> F n01 a1)
d2 F n2 c
x F n1 b
y))
  D3 d -> c -> b -> a
f ->
    \(MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ 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
x FeatureData c
y FeatureData b
z
  D3A d -> c -> b -> F n0 a
f -> \(MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) -> case forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 d -> c -> b -> F n0 a
f FeatureData d
x FeatureData c
y FeatureData b
z of
    MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
    MkFeatureData (Right F n0 a
r) -> F n0 a
r
  D3C a2 -> a1 -> a
f Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 -> \F n3 d
x F n2 c
y F n1 b
z ->
    forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a2 -> a1 -> a
f (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 F n3 d
x F n2 c
y F n1 b
z) (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 F n3 d
x F n2 c
y F n1 b
z)
  D4 e -> d -> c -> b -> a
f -> \(MkFeature FeatureData e
v) (MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) ->
    forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ 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
v FeatureData d
x FeatureData c
y FeatureData b
z
  D4A e -> d -> c -> b -> F n0 a
f -> \(MkFeature FeatureData e
v) (MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) ->
    case 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 -> F n0 a
f FeatureData e
v FeatureData d
x FeatureData c
y FeatureData b
z of
      MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
      MkFeatureData (Right F n0 a
r) -> F n0 a
r
  D4C a2 -> a1 -> a
f Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 -> \F n4 e
v F n3 d
x F n2 c
y F n1 b
z -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature
    forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a2 -> a1 -> a
f (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 F n4 e
v F n3 d
x F n2 c
y F n1 b
z) (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 F n4 e
v F n3 d
x F n2 c
y F n1 b
z)
  D5 f -> e -> d -> c -> b -> a
f ->
    \(MkFeature FeatureData f
u) (MkFeature FeatureData e
v) (MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) ->
      forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 f -> e -> d -> c -> b -> a
f FeatureData f
u FeatureData e
v FeatureData d
x FeatureData c
y FeatureData b
z
  D5A f -> e -> d -> c -> b -> F n0 a
f ->
    \(MkFeature FeatureData f
u) (MkFeature FeatureData e
v) (MkFeature FeatureData d
x) (MkFeature FeatureData c
y) (MkFeature FeatureData b
z) ->
      case forall (m :: * -> *) a1 a2 a3 a4 a5 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> a5 -> r)
-> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
liftM5 f -> e -> d -> c -> b -> F n0 a
f FeatureData f
u FeatureData e
v FeatureData d
x FeatureData c
y FeatureData b
z of
        MkFeatureData (Left  FeatureProblemFlag
l) -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature forall a b. (a -> b) -> a -> b
$ forall d. Either FeatureProblemFlag d -> FeatureData d
MkFeatureData (forall a b. a -> Either a b
Left FeatureProblemFlag
l)
        MkFeatureData (Right F n0 a
r) -> F n0 a
r
  D5C a2 -> a1 -> a
f Definition
  (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 Definition
  (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 -> \F n5 f
u F n4 e
v F n3 d
x F n2 c
y F n1 b
z -> forall (name :: Symbol) d. FeatureData d -> Feature name d
MkFeature
    forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a2 -> a1 -> a
f (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition
  (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2)
d1 F n5 f
u F n4 e
v F n3 d
x F n2 c
y F n1 b
z) (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData forall a b. (a -> b) -> a -> b
$ forall d. Definition d -> d
eval Definition
  (F n5 f -> F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1)
d2 F n5 f
u F n4 e
v F n3 d
x F n2 c
y F n1 b
z)