{-|
Module      : Featureset
Description : Defines a collection of Featureables.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Features.Featureset (
    Featureset
  , FeaturesetList(..)
  , featureset
  , getFeatureset
  , getFeaturesetAttrs
  , getFeaturesetList
  , tpose
) where

import Features.Featureable           ( Featureable
                                      , getFeatureableAttrs
                                      )
import Features.Attributes            ( Attributes )
import Data.Aeson                     ( ToJSON(toJSON), object, (.=) )
import Data.List.NonEmpty as NE       ( NonEmpty(..), transpose, head )
import Data.Functor                   ( Functor(fmap) )
import Data.Function                  ( (.) )
import GHC.Generics                   ( Generic )
import GHC.Show                       ( Show )

-- | A Featureset is a (non-empty) list of @Featureable@.
newtype Featureset = MkFeatureset (NE.NonEmpty Featureable)
  deriving (Int -> Featureset -> ShowS
[Featureset] -> ShowS
Featureset -> String
(Int -> Featureset -> ShowS)
-> (Featureset -> String)
-> ([Featureset] -> ShowS)
-> Show Featureset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Featureset] -> ShowS
$cshowList :: [Featureset] -> ShowS
show :: Featureset -> String
$cshow :: Featureset -> String
showsPrec :: Int -> Featureset -> ShowS
$cshowsPrec :: Int -> Featureset -> ShowS
Show)

-- | Constructor of a @Featureset@.
featureset :: NE.NonEmpty Featureable -> Featureset
featureset :: NonEmpty Featureable -> Featureset
featureset = NonEmpty Featureable -> Featureset
MkFeatureset

-- | Constructor of a @Featureset@.
getFeatureset :: Featureset -> NE.NonEmpty Featureable
getFeatureset :: Featureset -> NonEmpty Featureable
getFeatureset (MkFeatureset NonEmpty Featureable
x) = NonEmpty Featureable
x

-- | Gets a list of @Attributes@ from a @Featureset@, one @Attributes@ per @Featureable@.
getFeaturesetAttrs :: Featureset -> NE.NonEmpty Attributes
getFeaturesetAttrs :: Featureset -> NonEmpty Attributes
getFeaturesetAttrs (MkFeatureset NonEmpty Featureable
l) = (Featureable -> Attributes)
-> NonEmpty Featureable -> NonEmpty Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Featureable -> Attributes
getFeatureableAttrs NonEmpty Featureable
l

instance ToJSON Featureset where
  toJSON :: Featureset -> Value
toJSON (MkFeatureset NonEmpty Featureable
x) = NonEmpty Featureable -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty Featureable
x

-- | A newtype wrapper for a 'NE.NonEmpty' 'Featureset'.
newtype FeaturesetList = MkFeaturesetList (NE.NonEmpty Featureset) 
  deriving (Int -> FeaturesetList -> ShowS
[FeaturesetList] -> ShowS
FeaturesetList -> String
(Int -> FeaturesetList -> ShowS)
-> (FeaturesetList -> String)
-> ([FeaturesetList] -> ShowS)
-> Show FeaturesetList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeaturesetList] -> ShowS
$cshowList :: [FeaturesetList] -> ShowS
show :: FeaturesetList -> String
$cshow :: FeaturesetList -> String
showsPrec :: Int -> FeaturesetList -> ShowS
$cshowsPrec :: Int -> FeaturesetList -> ShowS
Show)

-- | Constructor of a @Featureset@.
getFeaturesetList :: FeaturesetList -> NE.NonEmpty Featureset
getFeaturesetList :: FeaturesetList -> NonEmpty Featureset
getFeaturesetList (MkFeaturesetList NonEmpty Featureset
x) = NonEmpty Featureset
x

-- | Transpose a FeaturesetList
tpose :: FeaturesetList -> FeaturesetList
tpose :: FeaturesetList -> FeaturesetList
tpose (MkFeaturesetList NonEmpty Featureset
x) = NonEmpty Featureset -> FeaturesetList
MkFeaturesetList 
  ((NonEmpty Featureable -> Featureset)
-> NonEmpty (NonEmpty Featureable) -> NonEmpty Featureset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Featureable -> Featureset
featureset ( NonEmpty (NonEmpty Featureable) -> NonEmpty (NonEmpty Featureable)
forall a. NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
transpose ((Featureset -> NonEmpty Featureable)
-> NonEmpty Featureset -> NonEmpty (NonEmpty Featureable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Featureset -> NonEmpty Featureable
getFeatureset NonEmpty Featureset
x)))