{-|
Module      : Hasklepias Cohorts
Description : Defines the options for outputting a cohort
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveAnyClass #-}

module Cohort.Output(
    CohortShape
  , ShapeCohort(..)
  , toJSONCohortShape
) where

import Data.Aeson                           ( ToJSON(..)
                                            , Value
                                            , object
                                            , (.=) )
import Data.Function                        ( (.) )
import Data.Functor                         ( Functor(fmap) )
import Data.List.NonEmpty as NE             ( NonEmpty(..)
                                            , head
                                            , fromList
                                            , zip )
import Data.Tuple                           ( uncurry )
import GHC.Generics                         ( Generic )
import GHC.Types                            ( Type )
import GHC.Show                             ( Show )
import Cohort.Core                          ( AttritionInfo,
                                              Cohort,
                                              ObsUnit,
                                              ID,
                                              CohortData,
                                              getCohortData,
                                              getCohortIDs )
import Cohort.Criteria                      ( CohortStatus )
import Features.Featureset                  ( FeaturesetList(MkFeaturesetList)
                                            , Featureset
                                            , getFeatureset
                                            , getFeaturesetList
                                            , tpose )
import Features.Output                      ( ShapeOutput(dataOnly, nameAttr)
                                            , OutputShape )

instance (ToJSON d) => ToJSON (ObsUnit d) where
instance (ToJSON d) => ToJSON (CohortData d) where
instance (ToJSON d) => ToJSON (Cohort d) where
instance ToJSON CohortStatus where
instance ToJSON AttritionInfo where

-- | A type used to determine the output shape of a Cohort.
data CohortShape d where
  ColumnWise :: (Show a, ToJSON a) => a -> CohortShape ColumnWise
  RowWise :: (Show a, ToJSON a) => a -> CohortShape RowWise

deriving instance Show d => Show (CohortShape d)

-- | Maps CohortShape into an Aeson Value. 
-- TODO: implement Generic and ToJSON instance of CohortShape directly.
toJSONCohortShape :: CohortShape shape -> Value
toJSONCohortShape :: CohortShape shape -> Value
toJSONCohortShape (ColumnWise a
x) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
toJSONCohortShape (RowWise a
x)    = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x

-- | Provides methods for reshaping a 'Cohort.Cohort' to a 'CohortShape'.
class ShapeCohort d where
  colWise :: Cohort d -> CohortShape ColumnWise
  rowWise :: Cohort d -> CohortShape RowWise

instance ShapeCohort Featureset where
  colWise :: Cohort Featureset -> CohortShape ColumnWise
colWise Cohort Featureset
x = ColumnWise -> CohortShape ColumnWise
forall a. (Show a, ToJSON a) => a -> CohortShape ColumnWise
ColumnWise (Cohort Featureset -> ColumnWise
shapeColumnWise Cohort Featureset
x)
  rowWise :: Cohort Featureset -> CohortShape RowWise
rowWise Cohort Featureset
x = RowWise -> CohortShape RowWise
forall a. (Show a, ToJSON a) => a -> CohortShape RowWise
RowWise (Cohort Featureset -> RowWise
shapeRowWise Cohort Featureset
x)

data ColumnWise = MkColumnWise {
    ColumnWise -> NonEmpty (OutputShape *)
colAttributes :: NonEmpty (OutputShape Type)
  , ColumnWise -> [ID]
ids     :: [ID]
  , ColumnWise -> NonEmpty (NonEmpty (OutputShape *))
colData :: NonEmpty (NonEmpty (OutputShape Type))
  } deriving ( Int -> ColumnWise -> ShowS
[ColumnWise] -> ShowS
ColumnWise -> String
(Int -> ColumnWise -> ShowS)
-> (ColumnWise -> String)
-> ([ColumnWise] -> ShowS)
-> Show ColumnWise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnWise] -> ShowS
$cshowList :: [ColumnWise] -> ShowS
show :: ColumnWise -> String
$cshow :: ColumnWise -> String
showsPrec :: Int -> ColumnWise -> ShowS
$cshowsPrec :: Int -> ColumnWise -> ShowS
Show, (forall x. ColumnWise -> Rep ColumnWise x)
-> (forall x. Rep ColumnWise x -> ColumnWise) -> Generic ColumnWise
forall x. Rep ColumnWise x -> ColumnWise
forall x. ColumnWise -> Rep ColumnWise x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnWise x -> ColumnWise
$cfrom :: forall x. ColumnWise -> Rep ColumnWise x
Generic )

instance ToJSON ColumnWise where
  toJSON :: ColumnWise -> Value
toJSON ColumnWise
x = [Pair] -> Value
object [ ID
"attributes" ID -> NonEmpty (OutputShape *) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
.= ColumnWise -> NonEmpty (OutputShape *)
colAttributes ColumnWise
x
                    , ID
"ids"        ID -> [ID] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
.= ColumnWise -> [ID]
ids ColumnWise
x
                    , ID
"data"       ID -> NonEmpty (NonEmpty (OutputShape *)) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
.= ColumnWise -> NonEmpty (NonEmpty (OutputShape *))
colData ColumnWise
x ]

newtype IDRow = MkIDRow (ID, NonEmpty (OutputShape Type))
  deriving ( Int -> IDRow -> ShowS
[IDRow] -> ShowS
IDRow -> String
(Int -> IDRow -> ShowS)
-> (IDRow -> String) -> ([IDRow] -> ShowS) -> Show IDRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDRow] -> ShowS
$cshowList :: [IDRow] -> ShowS
show :: IDRow -> String
$cshow :: IDRow -> String
showsPrec :: Int -> IDRow -> ShowS
$cshowsPrec :: Int -> IDRow -> ShowS
Show, (forall x. IDRow -> Rep IDRow x)
-> (forall x. Rep IDRow x -> IDRow) -> Generic IDRow
forall x. Rep IDRow x -> IDRow
forall x. IDRow -> Rep IDRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IDRow x -> IDRow
$cfrom :: forall x. IDRow -> Rep IDRow x
Generic )

instance ToJSON IDRow where
  toJSON :: IDRow -> Value
toJSON (MkIDRow (ID, NonEmpty (OutputShape *))
x) = [Pair] -> Value
object [ (ID -> NonEmpty (OutputShape *) -> Pair)
-> (ID, NonEmpty (OutputShape *)) -> Pair
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ID -> NonEmpty (OutputShape *) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
(.=) (ID, NonEmpty (OutputShape *))
x]

data RowWise = MkRowWise {
    RowWise -> NonEmpty (OutputShape *)
attributes :: NonEmpty (OutputShape Type)
  , RowWise -> NonEmpty IDRow
rowData :: NonEmpty IDRow
  } deriving ( Int -> RowWise -> ShowS
[RowWise] -> ShowS
RowWise -> String
(Int -> RowWise -> ShowS)
-> (RowWise -> String) -> ([RowWise] -> ShowS) -> Show RowWise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowWise] -> ShowS
$cshowList :: [RowWise] -> ShowS
show :: RowWise -> String
$cshow :: RowWise -> String
showsPrec :: Int -> RowWise -> ShowS
$cshowsPrec :: Int -> RowWise -> ShowS
Show, (forall x. RowWise -> Rep RowWise x)
-> (forall x. Rep RowWise x -> RowWise) -> Generic RowWise
forall x. Rep RowWise x -> RowWise
forall x. RowWise -> Rep RowWise x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowWise x -> RowWise
$cfrom :: forall x. RowWise -> Rep RowWise x
Generic )

instance ToJSON RowWise where
  toJSON :: RowWise -> Value
toJSON RowWise
x = [Pair] -> Value
object [ ID
"attributes" ID -> NonEmpty (OutputShape *) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
.= RowWise -> NonEmpty (OutputShape *)
attributes RowWise
x
                    , ID
"data"       ID -> NonEmpty IDRow -> Pair
forall kv v. (KeyValue kv, ToJSON v) => ID -> v -> kv
.= RowWise -> NonEmpty IDRow
rowData RowWise
x ]

shapeColumnWise :: Cohort Featureset -> ColumnWise
shapeColumnWise :: Cohort Featureset -> ColumnWise
shapeColumnWise Cohort Featureset
x = NonEmpty (OutputShape *)
-> [ID] -> NonEmpty (NonEmpty (OutputShape *)) -> ColumnWise
MkColumnWise
        ((Featureset -> OutputShape *)
-> NonEmpty Featureset -> NonEmpty (OutputShape *)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Featureable -> OutputShape *
forall a b. ShapeOutput a => a -> OutputShape b
nameAttr (Featureable -> OutputShape *)
-> (Featureset -> Featureable) -> Featureset -> OutputShape *
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Featureable -> Featureable
forall a. NonEmpty a -> a
NE.head (NonEmpty Featureable -> Featureable)
-> (Featureset -> NonEmpty Featureable)
-> Featureset
-> Featureable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featureset -> NonEmpty Featureable
getFeatureset) NonEmpty Featureset
z)
        (Cohort Featureset -> [ID]
forall d. Cohort d -> [ID]
getCohortIDs Cohort Featureset
x)
        ((Featureset -> NonEmpty (OutputShape *))
-> NonEmpty Featureset -> NonEmpty (NonEmpty (OutputShape *))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Featureable -> OutputShape *)
-> NonEmpty Featureable -> NonEmpty (OutputShape *)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Featureable -> OutputShape *
forall a b. ShapeOutput a => a -> OutputShape b
dataOnly (NonEmpty Featureable -> NonEmpty (OutputShape *))
-> (Featureset -> NonEmpty Featureable)
-> Featureset
-> NonEmpty (OutputShape *)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featureset -> NonEmpty Featureable
getFeatureset)  NonEmpty Featureset
z)
        -- TODO: don't use fromList; do something more principled
        where z :: NonEmpty Featureset
z = FeaturesetList -> NonEmpty Featureset
getFeaturesetList (FeaturesetList -> FeaturesetList
tpose (NonEmpty Featureset -> FeaturesetList
MkFeaturesetList ([Featureset] -> NonEmpty Featureset
forall a. [a] -> NonEmpty a
NE.fromList (Cohort Featureset -> [Featureset]
forall d. Cohort d -> [d]
getCohortData Cohort Featureset
x))))

shapeRowWise :: Cohort Featureset -> RowWise
shapeRowWise :: Cohort Featureset -> RowWise
shapeRowWise Cohort Featureset
x = NonEmpty (OutputShape *) -> NonEmpty IDRow -> RowWise
MkRowWise
        ((Featureset -> OutputShape *)
-> NonEmpty Featureset -> NonEmpty (OutputShape *)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Featureable -> OutputShape *
forall a b. ShapeOutput a => a -> OutputShape b
nameAttr (Featureable -> OutputShape *)
-> (Featureset -> Featureable) -> Featureset -> OutputShape *
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Featureable -> Featureable
forall a. NonEmpty a -> a
NE.head (NonEmpty Featureable -> Featureable)
-> (Featureset -> NonEmpty Featureable)
-> Featureset
-> Featureable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featureset -> NonEmpty Featureable
getFeatureset) NonEmpty Featureset
z)
        (((ID, NonEmpty (OutputShape *)) -> IDRow)
-> NonEmpty (ID, NonEmpty (OutputShape *)) -> NonEmpty IDRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ID, NonEmpty (OutputShape *)) -> IDRow
MkIDRow (NonEmpty ID
-> NonEmpty (NonEmpty (OutputShape *))
-> NonEmpty (ID, NonEmpty (OutputShape *))
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip NonEmpty ID
ids ((Featureset -> NonEmpty (OutputShape *))
-> NonEmpty Featureset -> NonEmpty (NonEmpty (OutputShape *))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Featureable -> OutputShape *)
-> NonEmpty Featureable -> NonEmpty (OutputShape *)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Featureable -> OutputShape *
forall a b. ShapeOutput a => a -> OutputShape b
dataOnly (NonEmpty Featureable -> NonEmpty (OutputShape *))
-> (Featureset -> NonEmpty Featureable)
-> Featureset
-> NonEmpty (OutputShape *)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featureset -> NonEmpty Featureable
getFeatureset) NonEmpty Featureset
z)))
        -- TODO: don't use fromList; do something more principled
        where z :: NonEmpty Featureset
z = [Featureset] -> NonEmpty Featureset
forall a. [a] -> NonEmpty a
NE.fromList (Cohort Featureset -> [Featureset]
forall d. Cohort d -> [d]
getCohortData Cohort Featureset
x)
              ids :: NonEmpty ID
ids = [ID] -> NonEmpty ID
forall a. [a] -> NonEmpty a
fromList (Cohort Featureset -> [ID]
forall d. Cohort d -> [ID]
getCohortIDs Cohort Featureset
x)