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