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