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