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