1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} 2 module 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 Model.SQL.Select 16 import Model.Audit.SQL 17 import Model.Id.Types 18 import Model.Release.Types 19 import Model.Volume.Types 20 import Model.Volume.SQL 21 import Model.Category 22 import Model.Metric 23 import 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