1 {-# LANGUAGE TemplateHaskell #-} 2 {-# LANGUAGE TypeFamilies #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 {-# LANGUAGE DeriveFunctor #-} 5 6 module Databrary.Model.Record.Types 7 ( RecordRow(..) 8 , Record(..) 9 , ParticipantRecord(..) 10 , FieldUse(..) 11 , getRecordVolumePermission 12 -- , ParticipantFieldMapping(..) 13 , Measure(..) 14 , Measures 15 , blankRecord 16 ) where 17 18 import Control.Applicative ((<|>)) 19 import Data.ByteString (ByteString) 20 import Data.Foldable (fold) 21 import Data.Time (Day) 22 23 import Databrary.Has (Has(..)) 24 import Databrary.Model.Kind 25 import Databrary.Model.Id.Types 26 import Databrary.Model.Permission.Types 27 import Databrary.Model.Release.Types 28 import Databrary.Model.Volume.Types 29 import Databrary.Model.Metric.Types 30 import Databrary.Model.Category.Types 31 32 type instance IdType Record = Int32 33 34 data RecordRow = RecordRow 35 { recordId :: Id Record 36 , recordCategory :: Category 37 } deriving (Show, Eq) 38 39 data Record = Record 40 { recordRow :: !RecordRow 41 , recordMeasures :: Measures 42 , recordRelease :: Maybe Release 43 , recordVolume :: Volume 44 } 45 46 instance Kinded Record where 47 kindOf _ = "record" 48 49 -- | States for fields within 'ParticipantRecord'. 50 -- 51 -- We keep both the parsed and raw values for data for now... 52 data FieldUse a 53 = FieldUnused -- ^ Unused/not supplied 54 | FieldEmpty -- ^ Supplied, but empty 55 | Field MeasureDatum a -- ^ The raw value and its converted form 56 deriving (Show, Eq, Ord, Functor) 57 58 data ParticipantRecord = 59 ParticipantRecord -- are some of these required? 60 { prdId :: FieldUse ByteString 61 , prdInfo :: FieldUse ByteString 62 , prdDescription :: FieldUse ByteString 63 , prdBirthdate :: FieldUse Day 64 , prdGender :: FieldUse ByteString 65 , prdRace :: FieldUse ByteString 66 , prdEthnicity :: FieldUse ByteString 67 , prdGestationalAge :: FieldUse Double 68 , prdPregnancyTerm :: FieldUse ByteString 69 , prdBirthWeight :: FieldUse Double 70 , prdDisability :: FieldUse ByteString 71 , prdLanguage :: FieldUse ByteString 72 , prdCountry :: FieldUse ByteString 73 , prdState :: FieldUse ByteString 74 , prdSetting :: FieldUse ByteString 75 } 76 deriving (Show, Eq, Ord) 77 78 data Measure = Measure 79 { measureRecord :: Record 80 , measureMetric :: Metric 81 , measureDatum :: !MeasureDatum 82 } 83 84 instance Kinded Measure where 85 kindOf _ = "measure" 86 87 -- TODO: example building circular Record + Measure 88 89 type Measures = [Measure] 90 91 -- makeHasRec ''RecordRow ['recordId, 'recordCategory] 92 -- makeHasRec ''Record ['recordRow, 'recordVolume, 'recordRelease] 93 instance Has (Id Record) RecordRow where 94 view = recordId 95 instance Has Category RecordRow where 96 view = recordCategory 97 instance Has (Id Category) RecordRow where 98 view = (view . recordCategory) 99 100 -- instance Has RecordRow Record where 101 -- view = recordRow 102 instance Has (Id Record) Record where 103 view = (view . recordRow) 104 instance Has Category Record where 105 view = (view . recordRow) 106 instance Has (Id Category) Record where 107 view = (view . recordRow) 108 instance Has Volume Record where 109 view = recordVolume 110 instance Has Permission Record where 111 view = (view . recordVolume) 112 instance Has (Id Volume) Record where 113 view = (view . recordVolume) 114 -- instance Has VolumeRow Record where 115 -- view = (view . recordVolume) 116 instance Has (Maybe Release) Record where 117 view = recordRelease 118 instance Has Release Record where 119 view = (view . recordRelease) 120 121 getRecordVolumePermission :: Record -> VolumeRolePolicy 122 getRecordVolumePermission = volumeRolePolicy . recordVolume 123 124 instance Has Record Measure where 125 view = measureRecord 126 -- instance Has (Id Record) Measure where 127 -- view = recordId . recordRow . measureRecord 128 -- instance Has Volume Measure where 129 -- view = view . measureRecord 130 -- instance Has (Id Volume) Measure where 131 -- view = view . measureRecord 132 -- instance Has Category Measure where 133 -- view = view . measureRecord 134 -- instance Has (Id Category) Measure where 135 --- view = view . measureRecord 136 -- instance Has Permission Measure where 137 -- view = view . measureRecord 138 139 -- instance Has Metric Measure where 140 -- view = measureMetric 141 -- instance Has (Id Metric) Measure where 142 -- view = view . measureMetric 143 -- instance Has MeasureType Measure where 144 -- view = view . measureMetric 145 146 instance Has (Maybe Release) Measure where 147 view m = metricRelease (measureMetric m) <|> recordRelease (measureRecord m) 148 instance Has Release Measure where 149 view = fold . (view :: Measure -> Maybe Release) 150 151 blankRecord :: Category -> Volume -> Record 152 blankRecord cat vol = Record 153 { recordRow = RecordRow 154 { recordId = error "blankRecord" 155 , recordCategory = cat 156 } 157 , recordVolume = vol 158 , recordRelease = Nothing 159 , recordMeasures = [] 160 } 161