{-|
Module      : Feature Building Criteria
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 #-}

module FeatureCompose.Criteria(
      Criterion(..)
    , Criteria(..)
    , Status(..)
    , getBools
    , include
    , exclude
    , collectBools
    , evalBools
    , runCriteria
) where

import safe GHC.Int                    ( Int )
import safe GHC.Num                    ( Num((+)) )
import safe GHC.Show                   ( Show(show) )
import safe Control.Monad              ( Functor(..) )
import safe Data.Bool                  ( Bool(..), otherwise, not, (&&) )
import safe Data.Either                ( Either(..), partitionEithers )
import safe Data.Eq                    ( Eq(..) )
import safe Data.Function              ( ($), (.) )
import safe Data.List                  ( all, transpose, null, elemIndex )
import safe Data.Maybe                 ( Maybe(..), maybe )
import safe Data.Tuple                 ( fst, snd )
import safe Data.Text                  ( Text )
import safe FeatureCompose

data Criterion b =
      Inclusion (Feature b Bool)
    | Exclusion (Feature b Bool)
    deriving (Int -> Criterion b -> ShowS
[Criterion b] -> ShowS
Criterion b -> String
(Int -> Criterion b -> ShowS)
-> (Criterion b -> String)
-> ([Criterion b] -> ShowS)
-> Show (Criterion b)
forall b. Show b => Int -> Criterion b -> ShowS
forall b. Show b => [Criterion b] -> ShowS
forall b. Show b => Criterion b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Criterion b] -> ShowS
$cshowList :: forall b. Show b => [Criterion b] -> ShowS
show :: Criterion b -> String
$cshow :: forall b. Show b => Criterion b -> String
showsPrec :: Int -> Criterion b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Criterion b -> ShowS
Show, Criterion b -> Criterion b -> Bool
(Criterion b -> Criterion b -> Bool)
-> (Criterion b -> Criterion b -> Bool) -> Eq (Criterion b)
forall b. (Show b, Eq b) => Criterion b -> Criterion b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Criterion b -> Criterion b -> Bool
$c/= :: forall b. (Show b, Eq b) => Criterion b -> Criterion b -> Bool
== :: Criterion b -> Criterion b -> Bool
$c== :: forall b. (Show b, Eq b) => Criterion b -> Criterion b -> Bool
Eq)

newtype Criteria b = MkCriteria [Criterion b] deriving (Int -> Criteria b -> ShowS
[Criteria b] -> ShowS
Criteria b -> String
(Int -> Criteria b -> ShowS)
-> (Criteria b -> String)
-> ([Criteria b] -> ShowS)
-> Show (Criteria b)
forall b. Show b => Int -> Criteria b -> ShowS
forall b. Show b => [Criteria b] -> ShowS
forall b. Show b => Criteria b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Criteria b] -> ShowS
$cshowList :: forall b. Show b => [Criteria b] -> ShowS
show :: Criteria b -> String
$cshow :: forall b. Show b => Criteria b -> String
showsPrec :: Int -> Criteria b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Criteria b -> ShowS
Show)

data Status = Included | ExcludedBy Int deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq)

statusMay :: Maybe Int -> Status
statusMay :: Maybe Int -> Status
statusMay (Just Int
i) = Int -> Status
ExcludedBy Int
i
statusMay Maybe Int
Nothing  = Status
Included

getBools :: (Show b) => Criterion b -> FeatureData Bool
getBools :: Criterion b -> FeatureData Bool
getBools (Inclusion Feature b Bool
x) = Feature b Bool -> FeatureData Bool
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b Bool
x
getBools (Exclusion Feature b Bool
x) = (Bool -> Bool) -> FeatureData Bool -> FeatureData Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Feature b Bool -> FeatureData Bool
forall b d. Show b => Feature b d -> FeatureData d
getData Feature b Bool
x)

include :: (Show b) => Feature b Bool -> Criterion b
include :: Feature b Bool -> Criterion b
include = Feature b Bool -> Criterion b
forall b. Feature b Bool -> Criterion b
Inclusion

exclude :: (Show b) => Feature b Bool -> Criterion b
exclude :: Feature b Bool -> Criterion b
exclude = Feature b Bool -> Criterion b
forall b. Feature b Bool -> Criterion b
Exclusion

collectBools :: (Show b) => Criteria b -> [FeatureData Bool]
collectBools :: Criteria b -> [FeatureData Bool]
collectBools (MkCriteria [Criterion b]
x) = (Criterion b -> FeatureData Bool)
-> [Criterion b] -> [FeatureData Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Criterion b -> FeatureData Bool
forall b. Show b => Criterion b -> FeatureData Bool
getBools [Criterion b]
x

runBools :: [[Bool]] -> [Status]
runBools :: [[Bool]] -> [Status]
runBools [[Bool]]
l = ([Bool] -> Status) -> [[Bool]] -> [Status]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Status
statusMay (Maybe Int -> Status) -> ([Bool] -> Maybe Int) -> [Bool] -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Maybe Int -> Maybe Int)
-> ([Bool] -> Maybe Int) -> [Bool] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Bool
False) ([[Bool]] -> [[Bool]]
forall a. [[a]] -> [[a]]
transpose [[Bool]]
l)

-- | TODO: what happens if the feature data lists are not the same length or empty(?)
--         this should get handled in a safer way.
evalBools :: [FeatureData Bool] -> FeatureData Status
evalBools :: [FeatureData Bool] -> FeatureData Status
evalBools [FeatureData Bool]
fs
    | [MissingReason] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([MissingReason], [[Bool]]) -> [MissingReason]
forall a b. (a, b) -> a
fst ([MissingReason], [[Bool]])
bools) = [Status] -> FeatureData Status
forall d. [d] -> FeatureData d
featureDataR ([Status] -> FeatureData Status) -> [Status] -> FeatureData Status
forall a b. (a -> b) -> a -> b
$ [[Bool]] -> [Status]
runBools (([MissingReason], [[Bool]]) -> [[Bool]]
forall a b. (a, b) -> b
snd ([MissingReason], [[Bool]])
bools)
    | Bool
otherwise        = MissingReason -> FeatureData Status
forall d. MissingReason -> FeatureData d
featureDataL MissingReason
Excluded
    where bools :: ([MissingReason], [[Bool]])
bools = [Either MissingReason [Bool]] -> ([MissingReason], [[Bool]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either MissingReason [Bool]] -> ([MissingReason], [[Bool]]))
-> [Either MissingReason [Bool]] -> ([MissingReason], [[Bool]])
forall a b. (a -> b) -> a -> b
$ (FeatureData Bool -> Either MissingReason [Bool])
-> [FeatureData Bool] -> [Either MissingReason [Bool]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FeatureData Bool -> Either MissingReason [Bool]
forall d. FeatureData d -> Either MissingReason [d]
getFeatureData [FeatureData Bool]
fs

runCriteria :: (Show b) => Criteria b -> FeatureData Status
runCriteria :: Criteria b -> FeatureData Status
runCriteria  = [FeatureData Bool] -> FeatureData Status
evalBools ([FeatureData Bool] -> FeatureData Status)
-> (Criteria b -> [FeatureData Bool])
-> Criteria b
-> FeatureData Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Criteria b -> [FeatureData Bool]
forall b. Show b => Criteria b -> [FeatureData Bool]
collectBools