module Model.Metric.Types
( MeasureDatum
, MeasureType(..)
, Metric(..)
, ParticipantFieldMapping2(..)
, mkParticipantFieldMapping2
, lookupField
) where
import Control.Monad (when)
import qualified Data.ByteString as BS
import Data.Function (on)
import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ord (comparing)
import qualified Data.Text as T
import Data.Text (Text)
import Instances.TH.Lift ()
import Language.Haskell.TH.Lift (deriveLiftMany)
import qualified Data.Typeable.Internal
import qualified GHC.Arr
import qualified Database.PostgreSQL.Typed.Types
import qualified Database.PostgreSQL.Typed.Dynamic
import qualified Database.PostgreSQL.Typed.Enum
import qualified Data.Aeson.Types
import qualified Data.ByteString.Char8
import Model.Enum
import Model.Kind
import Model.Release.Types
import Model.Id.Types
import Model.Category.Types
import qualified HTTP.Form.Deform
data MeasureType
= MeasureTypeText |
MeasureTypeNumeric |
MeasureTypeDate |
MeasureTypeVoid
deriving (Eq,
Ord,
Enum,
GHC.Arr.Ix,
Bounded,
Data.Typeable.Internal.Typeable)
instance Show MeasureType where
show MeasureTypeText = "text"
show MeasureTypeNumeric = "numeric"
show MeasureTypeDate = "date"
show MeasureTypeVoid = "void"
instance Database.PostgreSQL.Typed.Types.PGType "data_type"
instance Database.PostgreSQL.Typed.Types.PGParameter "data_type" MeasureType where
pgEncode _ MeasureTypeText
= BS.pack [116, 101, 120, 116]
pgEncode _ MeasureTypeNumeric
= BS.pack [110, 117, 109, 101, 114, 105, 99]
pgEncode _ MeasureTypeDate
= BS.pack [100, 97, 116, 101]
pgEncode _ MeasureTypeVoid
= BS.pack [118, 111, 105, 100]
instance Database.PostgreSQL.Typed.Types.PGColumn "data_type" MeasureType where
pgDecode _ x_a4zCt
= case BS.unpack x_a4zCt of
[116, 101, 120, 116] -> MeasureTypeText
[110, 117, 109, 101, 114, 105, 99] -> MeasureTypeNumeric
[100, 97, 116, 101] -> MeasureTypeDate
[118, 111, 105, 100] -> MeasureTypeVoid
_ -> error
("pgDecode data_type: "
++ Data.ByteString.Char8.unpack x_a4zCt)
instance Database.PostgreSQL.Typed.Dynamic.PGRep "data_type" MeasureType
instance Database.PostgreSQL.Typed.Enum.PGEnum MeasureType
instance Kinded MeasureType where
kindOf _ = "data_type"
instance DBEnum MeasureType
instance Data.Aeson.Types.ToJSON MeasureType where
toJSON
= Data.Aeson.Types.toJSON . fromEnum
instance Data.Aeson.Types.FromJSON MeasureType where
parseJSON = parseJSONEnum
instance HTTP.Form.Deform.Deform f_a4zCu MeasureType where
deform = enumForm
type MeasureDatum = BS.ByteString
type instance IdType Metric = Int32
data Metric = Metric
{ metricId :: !(Id Metric)
, metricCategory :: !Category
, metricName :: !T.Text
, metricRelease :: !(Maybe Release)
, metricType :: !MeasureType
, metricOptions :: ![MeasureDatum]
, metricAssumed :: !(Maybe MeasureDatum)
, metricDescription :: !(Maybe T.Text)
, metricRequired :: !(Maybe Bool)
} deriving (Show)
instance Kinded Metric where
kindOf _ = "metric"
instance Eq Metric where
(==) = on (==) metricId
(/=) = on (/=) metricId
instance Ord Metric where
compare = comparing metricId
deriveLiftMany [''MeasureType, ''Metric]
mkParticipantFieldMapping2 :: [(Metric, Text)] -> Either String ParticipantFieldMapping2
mkParticipantFieldMapping2 metricColumn = do
let mpng = Map.fromList metricColumn
columns = Map.elems mpng
when (length (L.nub columns) /= length columns) (Left "columns mapped to are not unique")
(pure . ParticipantFieldMapping2) mpng
lookupField :: Metric -> ParticipantFieldMapping2 -> Maybe Text
lookupField m (ParticipantFieldMapping2 mp) = Map.lookup m mp
newtype ParticipantFieldMapping2 = ParticipantFieldMapping2 { pfmGetMapping :: Map Metric Text }