1 {-# LANGUAGE TemplateHaskell, QuasiQuotes, DataKinds #-} 2 module Databrary.Model.VolumeMetric 3 ( lookupVolumeMetrics 4 , lookupVolumeParticipantMetrics 5 , addVolumeCategory 6 , addVolumeMetric 7 , removeVolumeMetric 8 , removeVolumeCategory 9 ) where 10 11 import Control.Exception.Lifted (handleJust) 12 import Control.Monad (guard) 13 import Database.PostgreSQL.Typed.Query 14 import Database.PostgreSQL.Typed.Types 15 import qualified Data.ByteString 16 import Data.ByteString (ByteString) 17 import qualified Data.List as L 18 import qualified Data.String 19 20 import Databrary.Service.DB 21 import Databrary.Model.SQL 22 import Databrary.Model.Id.Types 23 import Databrary.Model.Volume.Types 24 import Databrary.Model.Category 25 import Databrary.Model.Metric 26 27 lookupVolumeMetrics :: (MonadDB c m) => Volume -> m [Id Metric] 28 lookupVolumeMetrics v = do 29 let _tenv_a80O7 = unknownPGTypeEnv 30 -- dbQuery $(selectQuery selectVolumeMetric "$WHERE volume = ${volumeId $ volumeRow v} ORDER BY metric") 31 rows <- mapRunPrepQuery 32 ((\ _p_a80O8 -> 33 (Data.String.fromString 34 "SELECT volume_metric.metric FROM volume_metric WHERE volume = $1 ORDER BY metric", 35 [pgEncodeParameter 36 _tenv_a80O7 (PGTypeProxy :: PGTypeName "integer") _p_a80O8], 37 [pgBinaryColumn _tenv_a80O7 (PGTypeProxy :: PGTypeName "integer")])) 38 (volumeId $ volumeRow v)) 39 (\ [_cmetric_a80O9] 40 -> (pgDecodeColumnNotNull 41 _tenv_a80O7 (PGTypeProxy :: PGTypeName "integer") _cmetric_a80O9)) 42 pure 43 (fmap 44 (\ (vmetric_a80O2) -> id vmetric_a80O2) 45 rows) 46 47 lookupVolumeParticipantMetrics :: (MonadDB c m) => Volume -> m [Metric] 48 lookupVolumeParticipantMetrics vol = do 49 volumeActiveMetricIds <- lookupVolumeMetrics vol 50 -- liftIO (print ("metric ids", metricIds)) 51 pure ((fmap getMetric' volumeActiveMetricIds) `L.intersect` participantMetrics) 52 53 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a 54 mapQuery qry mkResult = 55 fmap mkResult (rawPGSimpleQuery qry) 56 57 addVolumeCategory :: (MonadDB c m) => Volume -> Id Category -> m [Id Metric] 58 addVolumeCategory v c = do 59 let _tenv_a6Dpx = unknownPGTypeEnv 60 dbQuery -- [pgSQL|INSERT INTO volume_metric SELECT ${volumeId $ volumeRow v}, id FROM metric WHERE category = ${c} AND required IS NOT NULL RETURNING metric|] 61 (mapQuery 62 ((\ _p_a6Dpy _p_a6Dpz -> 63 (Data.ByteString.concat 64 [Data.String.fromString "INSERT INTO volume_metric SELECT ", 65 Database.PostgreSQL.Typed.Types.pgEscapeParameter 66 _tenv_a6Dpx 67 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 68 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 69 _p_a6Dpy, 70 Data.String.fromString ", id FROM metric WHERE category = ", 71 Database.PostgreSQL.Typed.Types.pgEscapeParameter 72 _tenv_a6Dpx 73 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 74 Database.PostgreSQL.Typed.Types.PGTypeName "smallint") 75 _p_a6Dpz, 76 Data.String.fromString 77 " AND required IS NOT NULL RETURNING metric"])) 78 (volumeId $ volumeRow v) c) 79 (\ [_cmetric_a6DpA] 80 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 81 _tenv_a6Dpx 82 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 83 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 84 _cmetric_a6DpA))) 85 86 addVolumeMetric :: (MonadDB c m) => Volume -> Id Metric -> m Bool 87 addVolumeMetric v m = liftDBM $ do 88 let _tenv_a6Dqi = unknownPGTypeEnv 89 handleJust (guard . isUniqueViolation) (const $ return False) $ 90 dbExecute1 -- [pgSQL|INSERT INTO volume_metric VALUES (${volumeId $ volumeRow v}, ${m})|] 91 (mapQuery 92 ((\ _p_a6Dqk _p_a6Dql -> 93 (Data.ByteString.concat 94 [Data.String.fromString "INSERT INTO volume_metric VALUES (", 95 Database.PostgreSQL.Typed.Types.pgEscapeParameter 96 _tenv_a6Dqi 97 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 98 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 99 _p_a6Dqk, 100 Data.String.fromString ", ", 101 Database.PostgreSQL.Typed.Types.pgEscapeParameter 102 _tenv_a6Dqi 103 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 104 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 105 _p_a6Dql, 106 Data.String.fromString ")"])) 107 (volumeId $ volumeRow v) m) 108 (\ [] -> ())) 109 110 removeVolumeMetric :: (MonadDB c m) => Volume -> Id Metric -> m Bool 111 removeVolumeMetric v m = do 112 let _tenv_a6DCn = unknownPGTypeEnv 113 dbExecute1 -- [pgSQL|DELETE FROM volume_metric WHERE volume = ${volumeId $ volumeRow v} AND metric = ${m}|] 114 (mapQuery 115 ((\ _p_a6DCo _p_a6DCp -> 116 (Data.ByteString.concat 117 [Data.String.fromString 118 "DELETE FROM volume_metric WHERE volume = ", 119 Database.PostgreSQL.Typed.Types.pgEscapeParameter 120 _tenv_a6DCn 121 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 122 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 123 _p_a6DCo, 124 Data.String.fromString " AND metric = ", 125 Database.PostgreSQL.Typed.Types.pgEscapeParameter 126 _tenv_a6DCn 127 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 128 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 129 _p_a6DCp])) 130 (volumeId $ volumeRow v) m) 131 (\[] -> ())) 132 133 removeVolumeCategory :: (MonadDB c m) => Volume -> Id Category -> m Int 134 removeVolumeCategory v c = do 135 let _tenv_a6Gu0 = unknownPGTypeEnv 136 dbExecute -- [pgSQL|DELETE FROM volume_metric USING metric WHERE volume = ${volumeId $ volumeRow v} AND metric = id AND category = ${c}|] 137 (mapQuery 138 ((\ _p_a6Gu1 _p_a6Gu2 -> 139 (Data.ByteString.concat 140 [Data.String.fromString 141 "DELETE FROM volume_metric USING metric WHERE volume = ", 142 Database.PostgreSQL.Typed.Types.pgEscapeParameter 143 _tenv_a6Gu0 144 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 145 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 146 _p_a6Gu1, 147 Data.String.fromString " AND metric = id AND category = ", 148 Database.PostgreSQL.Typed.Types.pgEscapeParameter 149 _tenv_a6Gu0 150 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 151 Database.PostgreSQL.Typed.Types.PGTypeName "smallint") 152 _p_a6Gu2])) 153 (volumeId $ volumeRow v) c) 154 (\[] -> ()))