1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} 2 module Databrary.Model.Record.SQL 3 ( selectVolumeRecord 4 , selectRecord 5 , insertRecord 6 , updateRecord 7 , deleteRecord 8 , makeRecord 9 ) where 10 11 import qualified Data.ByteString.Char8 as BSC 12 import Data.Maybe (fromMaybe) 13 import qualified Language.Haskell.TH as TH 14 15 import Databrary.Model.SQL.Select 16 import Databrary.Model.Audit.SQL 17 import Databrary.Model.Id.Types 18 import Databrary.Model.Release.Types 19 import Databrary.Model.Volume.Types 20 import Databrary.Model.Volume.SQL 21 import Databrary.Model.Category 22 import Databrary.Model.Metric 23 import Databrary.Model.Record.Types 24 25 parseMeasure :: Record -> BSC.ByteString -> Measure 26 parseMeasure r s = Measure r (getMetric' (Id (read (BSC.unpack m)))) (BSC.tail d) where 27 (m, d) = BSC.splitAt (fromMaybe (error $ "parseMeasure " ++ show (recordId $ recordRow r) ++ ": " ++ BSC.unpack s) $ BSC.elemIndex ':' s) s 28 29 makeRecord :: Id Record -> Id Category -> [Maybe BSC.ByteString] -> Maybe Release -> Volume -> Record 30 makeRecord i c ms p v = r where 31 r = Record (RecordRow i (getCategory' c)) (map (parseMeasure r . fromMaybe (error "NULL record.measure")) ms) p v 32 33 selectRecordRow :: Selector -- ^ @Maybe 'Release' -> 'Volume' -> 'Record'@ 34 selectRecordRow = fromMap ("record_measures AS " ++) $ 35 selectColumns 'makeRecord "record" ["id", "category", "measures"] 36 37 selectVolumeRecord :: Selector -- ^ @'Volume' -> 'Record'@ 38 selectVolumeRecord = addSelects '($) selectRecordRow [SelectExpr "record_release(record.id)"] -- XXX explicit table reference (throughout) 39 40 selectRecord :: TH.Name -- ^ @'Identity'@ 41 -> Selector -- ^ @'Record'@ 42 selectRecord ident = selectJoin '($) 43 [ selectVolumeRecord 44 , joinOn "record.volume = volume.id" $ selectVolume ident 45 ] 46 47 recordKeys :: String -- ^ @'Record'@ 48 -> [(String, String)] 49 recordKeys r = 50 [ ("id", "${recordId $ recordRow " ++ r ++ "}") ] 51 52 recordSets :: String -- ^ @'Record'@ 53 -> [(String, String)] 54 recordSets r = 55 [ ("volume", "${volumeId $ volumeRow $ recordVolume " ++ r ++ "}") 56 , ("category", "${categoryId $ recordCategory $ recordRow " ++ r ++ "}") 57 ] 58 59 setRecordId :: Record -> Id Record -> Record 60 setRecordId r i = r{ recordRow = (recordRow r){ recordId = i } } 61 62 insertRecord :: TH.Name -- ^ @'AuditIdentity'@ 63 -> TH.Name -- ^ @'Record'@ 64 -> TH.ExpQ -- ^ @'Record'@ 65 insertRecord ident r = auditInsert ident "record" 66 (recordSets (nameRef r)) 67 (Just $ selectOutput $ selectMap ((TH.VarE 'setRecordId `TH.AppE` TH.VarE r) `TH.AppE`) $ selectColumn "record" "id") 68 69 updateRecord :: TH.Name -- ^ @'AuditIdentity'@ 70 -> TH.Name -- ^ @'Record'@ 71 -> TH.ExpQ -- ^ @()@ 72 updateRecord ident r = auditUpdate ident "record" 73 (recordSets (nameRef r)) 74 (whereEq $ recordKeys (nameRef r)) 75 Nothing 76 77 deleteRecord :: TH.Name -- ^ @'AuditIdentity'@ 78 -> TH.Name -- ^ @'Record'@ 79 -> TH.ExpQ -- ^ @()@ 80 deleteRecord ident r = auditDelete ident "record" 81 (whereEq $ recordKeys (nameRef r)) 82 Nothing