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