{-|
Module      : Cohort output (and some input)
Description : Methods for outputting a cohort
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Cohort.Output
  ( CohortJSON
  , CohortSetJSON(..)
  , CohortDataShape
  , CohortDataShapeJSON(..)
  , ColumnWiseJSON(..)
  , RowWiseJSON(..)
  , ShapeCohort(..)
  , toJSONCohortDataShape
  ) where

import           Control.Applicative            ( (<$>) )
import           Cohort.Core                    ( AttritionInfo
                                                , AttritionLevel
                                                , Cohort(..)
                                                , CohortData
                                                , CohortSet(..)
                                                , ID
                                                , ObsUnit
                                                , getCohortData
                                                , getCohortDataData
                                                , getCohortDataIDs
                                                , getCohortIDs
                                                )
import           Cohort.Criteria                ( CohortStatus )
import           Data.Aeson                     ( (.=)
                                                , FromJSON
                                                , ToJSON(..)
                                                , Value
                                                , object
                                                )
import           Data.Aeson.Types               ( FromJSON )
import           Data.Eq                        ( Eq )
import           Data.Function                  ( ($)
                                                , (.)
                                                )
import           Data.Functor                   ( Functor(fmap) )
import           Data.List                      ( zip, zipWith, head )
import           Data.List.NonEmpty            as NE
                                                ( NonEmpty(..)
                                                , nonEmpty
                                                , head
                                                , toList
                                                )
import           Data.Map.Strict               as Data.Map
                                                ( Map
                                                , unionWith )
import           Data.Maybe                     ( maybe, maybeToList
                                                , fromMaybe
                                                , Maybe(..) )
import           Data.Semigroup                 ( Semigroup(..) )
import           Data.Text                      ( Text )
import           Data.Tuple                     ( uncurry )
import           Features.Featureset            ( Featureset
                                                , FeaturesetList
                                                  ( MkFeaturesetList
                                                  )
                                                , getFeatureset
                                                , getFeaturesetList
                                                , tpose
                                                )
import           Features.Output                ( OutputShape
                                                , ShapeOutput
                                                  ( dataOnly
                                                  , nameAttr
                                                  )
                                                )
import           GHC.Generics                   ( Generic )
import           GHC.Show                       ( Show )
import           GHC.Types                      ( Type )
import           Safe                           ( headMay )

instance (ToJSON d) => ToJSON (ObsUnit d) where
instance (ToJSON d) => ToJSON (CohortData d) where
instance (ToJSON d) => ToJSON (Cohort d) where
instance (ToJSON d) => ToJSON (CohortSet d)

-- NOTE: The following purposefully use default encodings to make roundtrip easier
--       They can be changed from the default, but be sure that one can go to/from
--       JSON.
instance ToJSON CohortStatus where
instance FromJSON CohortStatus where
instance ToJSON AttritionLevel where
instance FromJSON AttritionLevel where
instance ToJSON AttritionInfo where
instance FromJSON AttritionInfo where

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

deriving instance Show d => Show (CohortDataShape d)

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

{- | 
A type containing all the information of a 'Cohort' but where the 'CohortData'
has been reshaped to a 'CohortDataShapeJSON'.
-}
newtype CohortJSON = MkCohortJSON (AttritionInfo, CohortDataShapeJSON)
    deriving (CohortJSON -> CohortJSON -> Bool
(CohortJSON -> CohortJSON -> Bool)
-> (CohortJSON -> CohortJSON -> Bool) -> Eq CohortJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CohortJSON -> CohortJSON -> Bool
$c/= :: CohortJSON -> CohortJSON -> Bool
== :: CohortJSON -> CohortJSON -> Bool
$c== :: CohortJSON -> CohortJSON -> Bool
Eq, Int -> CohortJSON -> ShowS
[CohortJSON] -> ShowS
CohortJSON -> String
(Int -> CohortJSON -> ShowS)
-> (CohortJSON -> String)
-> ([CohortJSON] -> ShowS)
-> Show CohortJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CohortJSON] -> ShowS
$cshowList :: [CohortJSON] -> ShowS
show :: CohortJSON -> String
$cshow :: CohortJSON -> String
showsPrec :: Int -> CohortJSON -> ShowS
$cshowsPrec :: Int -> CohortJSON -> ShowS
Show, (forall x. CohortJSON -> Rep CohortJSON x)
-> (forall x. Rep CohortJSON x -> CohortJSON) -> Generic CohortJSON
forall x. Rep CohortJSON x -> CohortJSON
forall x. CohortJSON -> Rep CohortJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CohortJSON x -> CohortJSON
$cfrom :: forall x. CohortJSON -> Rep CohortJSON x
Generic)

instance ToJSON CohortJSON
instance FromJSON CohortJSON

instance Semigroup CohortJSON where
  <> :: CohortJSON -> CohortJSON -> CohortJSON
(<>) (MkCohortJSON (AttritionInfo, CohortDataShapeJSON)
x) (MkCohortJSON (AttritionInfo, CohortDataShapeJSON)
y) = (AttritionInfo, CohortDataShapeJSON) -> CohortJSON
MkCohortJSON ((AttritionInfo, CohortDataShapeJSON)
x (AttritionInfo, CohortDataShapeJSON)
-> (AttritionInfo, CohortDataShapeJSON)
-> (AttritionInfo, CohortDataShapeJSON)
forall a. Semigroup a => a -> a -> a
<> (AttritionInfo, CohortDataShapeJSON)
y)

{- | 
Similar to 'CohortSet', but where the 'Cohort's have been mapped to a 'CohortJSON'.
-}
newtype CohortSetJSON = MkCohortSetJSON (Map Text CohortJSON)
    deriving (CohortSetJSON -> CohortSetJSON -> Bool
(CohortSetJSON -> CohortSetJSON -> Bool)
-> (CohortSetJSON -> CohortSetJSON -> Bool) -> Eq CohortSetJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CohortSetJSON -> CohortSetJSON -> Bool
$c/= :: CohortSetJSON -> CohortSetJSON -> Bool
== :: CohortSetJSON -> CohortSetJSON -> Bool
$c== :: CohortSetJSON -> CohortSetJSON -> Bool
Eq, Int -> CohortSetJSON -> ShowS
[CohortSetJSON] -> ShowS
CohortSetJSON -> String
(Int -> CohortSetJSON -> ShowS)
-> (CohortSetJSON -> String)
-> ([CohortSetJSON] -> ShowS)
-> Show CohortSetJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CohortSetJSON] -> ShowS
$cshowList :: [CohortSetJSON] -> ShowS
show :: CohortSetJSON -> String
$cshow :: CohortSetJSON -> String
showsPrec :: Int -> CohortSetJSON -> ShowS
$cshowsPrec :: Int -> CohortSetJSON -> ShowS
Show, (forall x. CohortSetJSON -> Rep CohortSetJSON x)
-> (forall x. Rep CohortSetJSON x -> CohortSetJSON)
-> Generic CohortSetJSON
forall x. Rep CohortSetJSON x -> CohortSetJSON
forall x. CohortSetJSON -> Rep CohortSetJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CohortSetJSON x -> CohortSetJSON
$cfrom :: forall x. CohortSetJSON -> Rep CohortSetJSON x
Generic)

instance ToJSON CohortSetJSON
instance FromJSON CohortSetJSON

instance Semigroup CohortSetJSON where
  <> :: CohortSetJSON -> CohortSetJSON -> CohortSetJSON
(<>) (MkCohortSetJSON Map Text CohortJSON
x) (MkCohortSetJSON Map Text CohortJSON
y) = 
    Map Text CohortJSON -> CohortSetJSON
MkCohortSetJSON ((CohortJSON -> CohortJSON -> CohortJSON)
-> Map Text CohortJSON
-> Map Text CohortJSON
-> Map Text CohortJSON
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith CohortJSON -> CohortJSON -> CohortJSON
forall a. Semigroup a => a -> a -> a
(<>) Map Text CohortJSON
x Map Text CohortJSON
y)

-- | A type used to represent JSON formats for each shape
data CohortDataShapeJSON =
    CW ColumnWiseJSON
  | RW RowWiseJSON
  deriving (CohortDataShapeJSON -> CohortDataShapeJSON -> Bool
(CohortDataShapeJSON -> CohortDataShapeJSON -> Bool)
-> (CohortDataShapeJSON -> CohortDataShapeJSON -> Bool)
-> Eq CohortDataShapeJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CohortDataShapeJSON -> CohortDataShapeJSON -> Bool
$c/= :: CohortDataShapeJSON -> CohortDataShapeJSON -> Bool
== :: CohortDataShapeJSON -> CohortDataShapeJSON -> Bool
$c== :: CohortDataShapeJSON -> CohortDataShapeJSON -> Bool
Eq, Int -> CohortDataShapeJSON -> ShowS
[CohortDataShapeJSON] -> ShowS
CohortDataShapeJSON -> String
(Int -> CohortDataShapeJSON -> ShowS)
-> (CohortDataShapeJSON -> String)
-> ([CohortDataShapeJSON] -> ShowS)
-> Show CohortDataShapeJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CohortDataShapeJSON] -> ShowS
$cshowList :: [CohortDataShapeJSON] -> ShowS
show :: CohortDataShapeJSON -> String
$cshow :: CohortDataShapeJSON -> String
showsPrec :: Int -> CohortDataShapeJSON -> ShowS
$cshowsPrec :: Int -> CohortDataShapeJSON -> ShowS
Show, (forall x. CohortDataShapeJSON -> Rep CohortDataShapeJSON x)
-> (forall x. Rep CohortDataShapeJSON x -> CohortDataShapeJSON)
-> Generic CohortDataShapeJSON
forall x. Rep CohortDataShapeJSON x -> CohortDataShapeJSON
forall x. CohortDataShapeJSON -> Rep CohortDataShapeJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CohortDataShapeJSON x -> CohortDataShapeJSON
$cfrom :: forall x. CohortDataShapeJSON -> Rep CohortDataShapeJSON x
Generic)

instance ToJSON    CohortDataShapeJSON
instance FromJSON  CohortDataShapeJSON
instance Semigroup CohortDataShapeJSON where
  <> :: CohortDataShapeJSON -> CohortDataShapeJSON -> CohortDataShapeJSON
(<>) (CW ColumnWiseJSON
x) (CW ColumnWiseJSON
y) = ColumnWiseJSON -> CohortDataShapeJSON
CW (ColumnWiseJSON
x ColumnWiseJSON -> ColumnWiseJSON -> ColumnWiseJSON
forall a. Semigroup a => a -> a -> a
<> ColumnWiseJSON
y)
  (<>) (RW RowWiseJSON
x) (RW RowWiseJSON
y) = RowWiseJSON -> CohortDataShapeJSON
RW (RowWiseJSON
x RowWiseJSON -> RowWiseJSON -> RowWiseJSON
forall a. Semigroup a => a -> a -> a
<> RowWiseJSON
y)
  (<>) (RW RowWiseJSON
x) (CW ColumnWiseJSON
y) = RowWiseJSON -> CohortDataShapeJSON
RW RowWiseJSON
x
  (<>) (CW ColumnWiseJSON
x) (RW RowWiseJSON
y) = ColumnWiseJSON -> CohortDataShapeJSON
CW ColumnWiseJSON
x

-- | Provides methods for reshaping a 'Cohort.Cohort' to a 'CohortDataShapeJSON'.
class ShapeCohort d where
  colWise :: Cohort d -> CohortJSON
  rowWise :: Cohort d -> CohortJSON

instance ShapeCohort Featureset  where
  colWise :: Cohort Featureset -> CohortJSON
colWise (MkCohort (AttritionInfo
a, CohortData Featureset
d)) = (AttritionInfo, CohortDataShapeJSON) -> CohortJSON
MkCohortJSON (AttritionInfo
a, ColumnWiseJSON -> CohortDataShapeJSON
CW (ColumnWiseJSON -> CohortDataShapeJSON)
-> ColumnWiseJSON -> CohortDataShapeJSON
forall a b. (a -> b) -> a -> b
$ ColumnWise -> ColumnWiseJSON
colWiseJson (CohortData Featureset -> ColumnWise
shapeColumnWise CohortData Featureset
d))
  rowWise :: Cohort Featureset -> CohortJSON
rowWise (MkCohort (AttritionInfo
a, CohortData Featureset
d)) = (AttritionInfo, CohortDataShapeJSON) -> CohortJSON
MkCohortJSON (AttritionInfo
a, RowWiseJSON -> CohortDataShapeJSON
RW (RowWiseJSON -> CohortDataShapeJSON)
-> RowWiseJSON -> CohortDataShapeJSON
forall a b. (a -> b) -> a -> b
$ RowWise -> RowWiseJSON
rowWiseJson (CohortData Featureset -> RowWise
shapeRowWise CohortData Featureset
d))

---- ColumnWise ---- 

data ColumnWise = MkColumnWise [OutputShape Type] -- attributes
                                                  [ID] -- ids
                                                       [[OutputShape Type]] -- data
  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

-- | A type to hold 'Cohort' information in a column-wise manner.
data ColumnWiseJSON = MkColumnWiseJSON
  { ColumnWiseJSON -> [Value]
attributes  :: [Value]
  , ColumnWiseJSON -> [Value]
ids        :: [Value]
  , ColumnWiseJSON -> [[Value]]
cohortData :: [[Value]]
  }
  deriving (ColumnWiseJSON -> ColumnWiseJSON -> Bool
(ColumnWiseJSON -> ColumnWiseJSON -> Bool)
-> (ColumnWiseJSON -> ColumnWiseJSON -> Bool) -> Eq ColumnWiseJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnWiseJSON -> ColumnWiseJSON -> Bool
$c/= :: ColumnWiseJSON -> ColumnWiseJSON -> Bool
== :: ColumnWiseJSON -> ColumnWiseJSON -> Bool
$c== :: ColumnWiseJSON -> ColumnWiseJSON -> Bool
Eq, Int -> ColumnWiseJSON -> ShowS
[ColumnWiseJSON] -> ShowS
ColumnWiseJSON -> String
(Int -> ColumnWiseJSON -> ShowS)
-> (ColumnWiseJSON -> String)
-> ([ColumnWiseJSON] -> ShowS)
-> Show ColumnWiseJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnWiseJSON] -> ShowS
$cshowList :: [ColumnWiseJSON] -> ShowS
show :: ColumnWiseJSON -> String
$cshow :: ColumnWiseJSON -> String
showsPrec :: Int -> ColumnWiseJSON -> ShowS
$cshowsPrec :: Int -> ColumnWiseJSON -> ShowS
Show, (forall x. ColumnWiseJSON -> Rep ColumnWiseJSON x)
-> (forall x. Rep ColumnWiseJSON x -> ColumnWiseJSON)
-> Generic ColumnWiseJSON
forall x. Rep ColumnWiseJSON x -> ColumnWiseJSON
forall x. ColumnWiseJSON -> Rep ColumnWiseJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnWiseJSON x -> ColumnWiseJSON
$cfrom :: forall x. ColumnWiseJSON -> Rep ColumnWiseJSON x
Generic)

instance ToJSON   ColumnWiseJSON
instance FromJSON ColumnWiseJSON

instance Semigroup ColumnWiseJSON where
  <> :: ColumnWiseJSON -> ColumnWiseJSON -> ColumnWiseJSON
(<>) (MkColumnWiseJSON [Value]
a1 [Value]
i1 [[Value]]
d1) (MkColumnWiseJSON [Value]
_ [Value]
i2 [[Value]]
d2) =
    [Value] -> [Value] -> [[Value]] -> ColumnWiseJSON
MkColumnWiseJSON [Value]
a1 ([Value]
i1 [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
i2) (([Value] -> [Value] -> [Value])
-> [[Value]] -> [[Value]] -> [[Value]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
(<>) [[Value]]
d1 [[Value]]
d2)

colWiseJson :: ColumnWise -> ColumnWiseJSON
colWiseJson :: ColumnWise -> ColumnWiseJSON
colWiseJson (MkColumnWise [OutputShape *]
a [Text]
ids [[OutputShape *]]
cd) =
  [Value] -> [Value] -> [[Value]] -> ColumnWiseJSON
MkColumnWiseJSON ((OutputShape * -> Value) -> [OutputShape *] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputShape * -> Value
forall a. ToJSON a => a -> Value
toJSON [OutputShape *]
a) ((Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
ids) (([OutputShape *] -> [Value]) -> [[OutputShape *]] -> [[Value]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OutputShape * -> Value) -> [OutputShape *] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputShape * -> Value
forall a. ToJSON a => a -> Value
toJSON) [[OutputShape *]]
cd)

shapeColumnWise :: CohortData Featureset -> ColumnWise
shapeColumnWise :: CohortData Featureset -> ColumnWise
shapeColumnWise CohortData Featureset
x = [OutputShape *] -> [Text] -> [[OutputShape *]] -> ColumnWise
MkColumnWise
  ([OutputShape *] -> Maybe [OutputShape *] -> [OutputShape *]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [OutputShape *]
attr)
  (CohortData Featureset -> [Text]
forall d. CohortData d -> [Text]
getCohortDataIDs CohortData Featureset
x)
  ([[OutputShape *]] -> Maybe [[OutputShape *]] -> [[OutputShape *]]
forall a. a -> Maybe a -> a
fromMaybe [[]] Maybe [[OutputShape *]]
dat)
 where
  feat :: Maybe (NonEmpty Featureset)
feat = (NonEmpty Featureset -> NonEmpty Featureset)
-> Maybe (NonEmpty Featureset) -> Maybe (NonEmpty Featureset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FeaturesetList -> NonEmpty Featureset
getFeaturesetList (FeaturesetList -> NonEmpty Featureset)
-> (NonEmpty Featureset -> FeaturesetList)
-> NonEmpty Featureset
-> NonEmpty Featureset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeaturesetList -> FeaturesetList
tpose (FeaturesetList -> FeaturesetList)
-> (NonEmpty Featureset -> FeaturesetList)
-> NonEmpty Featureset
-> FeaturesetList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Featureset -> FeaturesetList
MkFeaturesetList)) ([Featureset] -> Maybe (NonEmpty Featureset)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (CohortData Featureset -> [Featureset]
forall d. CohortData d -> [d]
getCohortDataData CohortData Featureset
x))
  attr :: Maybe [OutputShape *]
attr = (NonEmpty Featureset -> [OutputShape *])
-> Maybe (NonEmpty Featureset) -> Maybe [OutputShape *]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (OutputShape *) -> [OutputShape *]
forall a. NonEmpty a -> [a]
toList (NonEmpty (OutputShape *) -> [OutputShape *])
-> (NonEmpty Featureset -> NonEmpty (OutputShape *))
-> NonEmpty Featureset
-> [OutputShape *]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)) Maybe (NonEmpty Featureset)
feat
  dat :: Maybe [[OutputShape *]]
dat  = (NonEmpty Featureset -> [[OutputShape *]])
-> Maybe (NonEmpty Featureset) -> Maybe [[OutputShape *]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty [OutputShape *] -> [[OutputShape *]]
forall a. NonEmpty a -> [a]
toList (NonEmpty [OutputShape *] -> [[OutputShape *]])
-> (NonEmpty Featureset -> NonEmpty [OutputShape *])
-> NonEmpty Featureset
-> [[OutputShape *]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Featureset -> [OutputShape *])
-> NonEmpty Featureset -> NonEmpty [OutputShape *]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (OutputShape *) -> [OutputShape *]
forall a. NonEmpty a -> [a]
toList (NonEmpty (OutputShape *) -> [OutputShape *])
-> (Featureset -> NonEmpty (OutputShape *))
-> Featureset
-> [OutputShape *]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))) Maybe (NonEmpty Featureset)
feat

---- Rowwise ---- 

newtype IDRow = MkIDRow (ID, [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 (MkIDRow x) = object [uncurry (.=) x]

data RowWise = MkRowWise [OutputShape Type] -- attributes
                                            [IDRow]  -- data
  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

-- | A type to hold 'Cohort' information in a row-wise manner.
data RowWiseJSON = MkRowWiseJSON
  { RowWiseJSON -> [Value]
attributes :: [Value]
  , RowWiseJSON -> [Value]
cohortData :: [Value]
  }
  deriving (RowWiseJSON -> RowWiseJSON -> Bool
(RowWiseJSON -> RowWiseJSON -> Bool)
-> (RowWiseJSON -> RowWiseJSON -> Bool) -> Eq RowWiseJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowWiseJSON -> RowWiseJSON -> Bool
$c/= :: RowWiseJSON -> RowWiseJSON -> Bool
== :: RowWiseJSON -> RowWiseJSON -> Bool
$c== :: RowWiseJSON -> RowWiseJSON -> Bool
Eq, Int -> RowWiseJSON -> ShowS
[RowWiseJSON] -> ShowS
RowWiseJSON -> String
(Int -> RowWiseJSON -> ShowS)
-> (RowWiseJSON -> String)
-> ([RowWiseJSON] -> ShowS)
-> Show RowWiseJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowWiseJSON] -> ShowS
$cshowList :: [RowWiseJSON] -> ShowS
show :: RowWiseJSON -> String
$cshow :: RowWiseJSON -> String
showsPrec :: Int -> RowWiseJSON -> ShowS
$cshowsPrec :: Int -> RowWiseJSON -> ShowS
Show, (forall x. RowWiseJSON -> Rep RowWiseJSON x)
-> (forall x. Rep RowWiseJSON x -> RowWiseJSON)
-> Generic RowWiseJSON
forall x. Rep RowWiseJSON x -> RowWiseJSON
forall x. RowWiseJSON -> Rep RowWiseJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowWiseJSON x -> RowWiseJSON
$cfrom :: forall x. RowWiseJSON -> Rep RowWiseJSON x
Generic)

instance ToJSON   RowWiseJSON
instance FromJSON RowWiseJSON
instance Semigroup RowWiseJSON where
  <> :: RowWiseJSON -> RowWiseJSON -> RowWiseJSON
(<>) (MkRowWiseJSON [Value]
a1 [Value]
d1) (MkRowWiseJSON [Value]
_ [Value]
d2) =
    [Value] -> [Value] -> RowWiseJSON
MkRowWiseJSON [Value]
a1 ([Value]
d1 [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
d2)

rowWiseJson :: RowWise -> RowWiseJSON
rowWiseJson :: RowWise -> RowWiseJSON
rowWiseJson (MkRowWise [OutputShape *]
a [IDRow]
rd) = [Value] -> [Value] -> RowWiseJSON
MkRowWiseJSON ((OutputShape * -> Value) -> [OutputShape *] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputShape * -> Value
forall a. ToJSON a => a -> Value
toJSON [OutputShape *]
a) ((IDRow -> Value) -> [IDRow] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IDRow -> Value
forall a. ToJSON a => a -> Value
toJSON [IDRow]
rd)

shapeRowWise :: CohortData Featureset -> RowWise
shapeRowWise :: CohortData Featureset -> RowWise
shapeRowWise CohortData Featureset
x = [OutputShape *] -> [IDRow] -> RowWise
MkRowWise
  ( [OutputShape *]
-> (Featureset -> [OutputShape *])
-> Maybe Featureset
-> [OutputShape *]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Featureable -> OutputShape *) -> [Featureable] -> [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]
toList (NonEmpty Featureable -> [Featureable])
-> (Featureset -> NonEmpty Featureable)
-> Featureset
-> [Featureable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Featureset -> NonEmpty Featureable
getFeatureset) ( [Featureset] -> Maybe Featureset
forall a. [a] -> Maybe a
headMay [Featureset]
cd ) )
  (((Text, [OutputShape *]) -> IDRow)
-> [(Text, [OutputShape *])] -> [IDRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, [OutputShape *]) -> IDRow
MkIDRow ([Text] -> [[OutputShape *]] -> [(Text, [OutputShape *])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ids ((Featureset -> [OutputShape *])
-> [Featureset] -> [[OutputShape *]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (OutputShape *) -> [OutputShape *]
forall a. NonEmpty a -> [a]
toList (NonEmpty (OutputShape *) -> [OutputShape *])
-> (Featureset -> NonEmpty (OutputShape *))
-> Featureset
-> [OutputShape *]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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)) [Featureset]
cd)))
 where
  cd :: [Featureset]
cd  = CohortData Featureset -> [Featureset]
forall d. CohortData d -> [d]
getCohortDataData CohortData Featureset
x
  ids :: [Text]
ids = CohortData Featureset -> [Text]
forall d. CohortData d -> [Text]
getCohortDataIDs CohortData Featureset
x