{-|
Module      : Cohort output
Description : Methods for outputting a cohort
Copyright   : (c) Target RWE 2023
License     : BSD3
Maintainer  : bbrown@targetrwe.com
              ljackman@targetrwe.com
              dpritchard@targetrwe.com
-}

{-# LANGUAGE DeriveGeneric #-}

module Cohort.Output where

import           Cohort.Cohort
import           Data.Aeson        (ToJSON (..), Value)
import           Data.Map.Strict   (Map)
import qualified Data.Map.Strict   as M
import           Data.Text         (Text)
import           GHC.Generics      (Generic)
import           Variable.Variable

-- | Internal. Type controling the output shape of a 'Cohort'.
data CohortJSON
  = MkCohortJSON
      { CohortJSON -> AttritionInfo
attritionJSON :: AttritionInfo
      , CohortJSON -> [ObsUnitJSON]
cohortJSON    :: [ObsUnitJSON]
      }
  deriving (CohortJSON -> CohortJSON -> Bool
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, 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, Int -> CohortJSON -> ShowS
[CohortJSON] -> ShowS
CohortJSON -> String
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)

instance ToJSON CohortJSON

-- | Internal. Type controling the output shape of each 'ObsUnit'.
data ObsUnitJSON
  = MkObsUnitJSON
      { ObsUnitJSON -> Value
obsIdJSON       :: Value
      , ObsUnitJSON -> [VariableWrapped]
variableRowJSON :: [VariableWrapped]
      }
  deriving (ObsUnitJSON -> ObsUnitJSON -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObsUnitJSON -> ObsUnitJSON -> Bool
$c/= :: ObsUnitJSON -> ObsUnitJSON -> Bool
== :: ObsUnitJSON -> ObsUnitJSON -> Bool
$c== :: ObsUnitJSON -> ObsUnitJSON -> Bool
Eq, forall x. Rep ObsUnitJSON x -> ObsUnitJSON
forall x. ObsUnitJSON -> Rep ObsUnitJSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObsUnitJSON x -> ObsUnitJSON
$cfrom :: forall x. ObsUnitJSON -> Rep ObsUnitJSON x
Generic, Int -> ObsUnitJSON -> ShowS
[ObsUnitJSON] -> ShowS
ObsUnitJSON -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObsUnitJSON] -> ShowS
$cshowList :: [ObsUnitJSON] -> ShowS
show :: ObsUnitJSON -> String
$cshow :: ObsUnitJSON -> String
showsPrec :: Int -> ObsUnitJSON -> ShowS
$cshowsPrec :: Int -> ObsUnitJSON -> ShowS
Show)

instance ToJSON ObsUnitJSON

-- | Internal. Convert 'ObsUnit' to 'ObsUnitJSON' using the 'ToJSON' instances
-- for 'ObsId' and 'VariableWrapped', to which the 'obsData' are first
-- converted.
toObsUnitJSON :: (ToJSON a) => ObsUnit a -> ObsUnitJSON
toObsUnitJSON :: forall a. ToJSON a => ObsUnit a -> ObsUnitJSON
toObsUnitJSON ObsUnit a
ou = Value -> [VariableWrapped] -> ObsUnitJSON
MkObsUnitJSON (forall a. ToJSON a => a -> Value
toJSON (forall a. ObsUnit a -> ObsId a
obsId ObsUnit a
ou)) [VariableWrapped]
dt
  where dt :: [VariableWrapped]
dt = forall a b. (a -> b) -> [a] -> [b]
map Variable -> VariableWrapped
asVariableWrapped (forall a. ObsUnit a -> VariableRow
obsData ObsUnit a
ou)

-- | Internal. Convert each 'Cohort' in a 'CohortMap' to 'CohortJSON'.
toCohortJSON :: (ToJSON a) => CohortMap a -> CohortMapJSON
toCohortJSON :: forall a. ToJSON a => CohortMap a -> CohortMapJSON
toCohortJSON CohortMap a
chtm = let f :: Cohort a -> CohortJSON
f Cohort a
cht = AttritionInfo -> [ObsUnitJSON] -> CohortJSON
MkCohortJSON (forall a. Cohort a -> AttritionInfo
attritionInfo Cohort a
cht) (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => ObsUnit a -> ObsUnitJSON
toObsUnitJSON (forall a. Cohort a -> [ObsUnit a]
cohortData Cohort a
cht))
                    in forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a}. ToJSON a => Cohort a -> CohortJSON
f CohortMap a
chtm


-- | Similar to 'CohortMap', but where the 'Cohort's have been mapped to a
-- 'CohortJSON'.
type CohortMapJSON = Map Text CohortJSON