{-|
Module      : Hasklepias Subject Type
Description : Defines the Subject type
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}

module Hasklepias.Cohort(
      Subject(..)
    , ID
    , Population(..)
    , ObsUnit(..)
    , Cohort(..)
    , makeObsUnitFeatures
    , makeCohort
) where

import Prelude                  ( Eq, Show, Functor(..) )     
import Data.Aeson               ( FromJSON, ToJSON )        
import Data.Text                ( Text )
import GHC.Generics             ( Generic)

type ID = Text
newtype Subject d = MkSubject (ID, d)
    deriving (Subject d -> Subject d -> Bool
(Subject d -> Subject d -> Bool)
-> (Subject d -> Subject d -> Bool) -> Eq (Subject d)
forall d. Eq d => Subject d -> Subject d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subject d -> Subject d -> Bool
$c/= :: forall d. Eq d => Subject d -> Subject d -> Bool
== :: Subject d -> Subject d -> Bool
$c== :: forall d. Eq d => Subject d -> Subject d -> Bool
Eq, Int -> Subject d -> ShowS
[Subject d] -> ShowS
Subject d -> String
(Int -> Subject d -> ShowS)
-> (Subject d -> String)
-> ([Subject d] -> ShowS)
-> Show (Subject d)
forall d. Show d => Int -> Subject d -> ShowS
forall d. Show d => [Subject d] -> ShowS
forall d. Show d => Subject d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject d] -> ShowS
$cshowList :: forall d. Show d => [Subject d] -> ShowS
show :: Subject d -> String
$cshow :: forall d. Show d => Subject d -> String
showsPrec :: Int -> Subject d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Subject d -> ShowS
Show, (forall x. Subject d -> Rep (Subject d) x)
-> (forall x. Rep (Subject d) x -> Subject d)
-> Generic (Subject d)
forall x. Rep (Subject d) x -> Subject d
forall x. Subject d -> Rep (Subject d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Subject d) x -> Subject d
forall d x. Subject d -> Rep (Subject d) x
$cto :: forall d x. Rep (Subject d) x -> Subject d
$cfrom :: forall d x. Subject d -> Rep (Subject d) x
Generic)

instance Functor Subject where
    fmap :: (a -> b) -> Subject a -> Subject b
fmap a -> b
f (MkSubject (ID
id, a
x)) = (ID, b) -> Subject b
forall d. (ID, d) -> Subject d
MkSubject (ID
id, a -> b
f a
x)

instance (FromJSON d) => FromJSON (Subject d) where

newtype Population d = MkPopulation [Subject d]
    deriving (Population d -> Population d -> Bool
(Population d -> Population d -> Bool)
-> (Population d -> Population d -> Bool) -> Eq (Population d)
forall d. Eq d => Population d -> Population d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Population d -> Population d -> Bool
$c/= :: forall d. Eq d => Population d -> Population d -> Bool
== :: Population d -> Population d -> Bool
$c== :: forall d. Eq d => Population d -> Population d -> Bool
Eq, Int -> Population d -> ShowS
[Population d] -> ShowS
Population d -> String
(Int -> Population d -> ShowS)
-> (Population d -> String)
-> ([Population d] -> ShowS)
-> Show (Population d)
forall d. Show d => Int -> Population d -> ShowS
forall d. Show d => [Population d] -> ShowS
forall d. Show d => Population d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Population d] -> ShowS
$cshowList :: forall d. Show d => [Population d] -> ShowS
show :: Population d -> String
$cshow :: forall d. Show d => Population d -> String
showsPrec :: Int -> Population d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Population d -> ShowS
Show, (forall x. Population d -> Rep (Population d) x)
-> (forall x. Rep (Population d) x -> Population d)
-> Generic (Population d)
forall x. Rep (Population d) x -> Population d
forall x. Population d -> Rep (Population d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Population d) x -> Population d
forall d x. Population d -> Rep (Population d) x
$cto :: forall d x. Rep (Population d) x -> Population d
$cfrom :: forall d x. Population d -> Rep (Population d) x
Generic)

instance (FromJSON d) => FromJSON (Population d) where

instance Functor Population where
    fmap :: (a -> b) -> Population a -> Population b
fmap a -> b
f (MkPopulation [Subject a]
x) = [Subject b] -> Population b
forall d. [Subject d] -> Population d
MkPopulation ((Subject a -> Subject b) -> [Subject a] -> [Subject b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Subject a -> Subject b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Subject a]
x)

newtype ObsUnit d = MkObsUnit (ID, d)
    deriving (ObsUnit d -> ObsUnit d -> Bool
(ObsUnit d -> ObsUnit d -> Bool)
-> (ObsUnit d -> ObsUnit d -> Bool) -> Eq (ObsUnit d)
forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObsUnit d -> ObsUnit d -> Bool
$c/= :: forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
== :: ObsUnit d -> ObsUnit d -> Bool
$c== :: forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
Eq, Int -> ObsUnit d -> ShowS
[ObsUnit d] -> ShowS
ObsUnit d -> String
(Int -> ObsUnit d -> ShowS)
-> (ObsUnit d -> String)
-> ([ObsUnit d] -> ShowS)
-> Show (ObsUnit d)
forall d. Show d => Int -> ObsUnit d -> ShowS
forall d. Show d => [ObsUnit d] -> ShowS
forall d. Show d => ObsUnit d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObsUnit d] -> ShowS
$cshowList :: forall d. Show d => [ObsUnit d] -> ShowS
show :: ObsUnit d -> String
$cshow :: forall d. Show d => ObsUnit d -> String
showsPrec :: Int -> ObsUnit d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> ObsUnit d -> ShowS
Show, (forall x. ObsUnit d -> Rep (ObsUnit d) x)
-> (forall x. Rep (ObsUnit d) x -> ObsUnit d)
-> Generic (ObsUnit d)
forall x. Rep (ObsUnit d) x -> ObsUnit d
forall x. ObsUnit d -> Rep (ObsUnit d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (ObsUnit d) x -> ObsUnit d
forall d x. ObsUnit d -> Rep (ObsUnit d) x
$cto :: forall d x. Rep (ObsUnit d) x -> ObsUnit d
$cfrom :: forall d x. ObsUnit d -> Rep (ObsUnit d) x
Generic)

instance (ToJSON d) => ToJSON (ObsUnit d) where

newtype Cohort d = MkCohort [ObsUnit d]
    deriving (Cohort d -> Cohort d -> Bool
(Cohort d -> Cohort d -> Bool)
-> (Cohort d -> Cohort d -> Bool) -> Eq (Cohort d)
forall d. Eq d => Cohort d -> Cohort d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cohort d -> Cohort d -> Bool
$c/= :: forall d. Eq d => Cohort d -> Cohort d -> Bool
== :: Cohort d -> Cohort d -> Bool
$c== :: forall d. Eq d => Cohort d -> Cohort d -> Bool
Eq, Int -> Cohort d -> ShowS
[Cohort d] -> ShowS
Cohort d -> String
(Int -> Cohort d -> ShowS)
-> (Cohort d -> String) -> ([Cohort d] -> ShowS) -> Show (Cohort d)
forall d. Show d => Int -> Cohort d -> ShowS
forall d. Show d => [Cohort d] -> ShowS
forall d. Show d => Cohort d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cohort d] -> ShowS
$cshowList :: forall d. Show d => [Cohort d] -> ShowS
show :: Cohort d -> String
$cshow :: forall d. Show d => Cohort d -> String
showsPrec :: Int -> Cohort d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Cohort d -> ShowS
Show, (forall x. Cohort d -> Rep (Cohort d) x)
-> (forall x. Rep (Cohort d) x -> Cohort d) -> Generic (Cohort d)
forall x. Rep (Cohort d) x -> Cohort d
forall x. Cohort d -> Rep (Cohort d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Cohort d) x -> Cohort d
forall d x. Cohort d -> Rep (Cohort d) x
$cto :: forall d x. Rep (Cohort d) x -> Cohort d
$cfrom :: forall d x. Cohort d -> Rep (Cohort d) x
Generic)

instance (ToJSON d) => ToJSON (Cohort d) where

makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0 
makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0
makeObsUnitFeatures d1 -> d0
f (MkSubject (ID
id, d1
dat)) = (ID, d0) -> ObsUnit d0
forall d. (ID, d) -> ObsUnit d
MkObsUnit (ID
id, d1 -> d0
f d1
dat)

makeCohort :: (d1 -> d0) -> Population d1 -> Cohort d0
makeCohort :: (d1 -> d0) -> Population d1 -> Cohort d0
makeCohort d1 -> d0
f (MkPopulation [Subject d1]
x) = [ObsUnit d0] -> Cohort d0
forall d. [ObsUnit d] -> Cohort d
MkCohort ((Subject d1 -> ObsUnit d0) -> [Subject d1] -> [ObsUnit d0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d1 -> d0) -> Subject d1 -> ObsUnit d0
forall d1 d0. (d1 -> d0) -> Subject d1 -> ObsUnit d0
makeObsUnitFeatures d1 -> d0
f) [Subject d1]
x)