1 {-# LANGUAGE TemplateHaskell #-} 2 module Databrary.Model.Excerpt.SQL 3 ( selectAssetSlotExcerpt 4 , selectContainerExcerpt 5 , selectVolumeExcerpt 6 , insertExcerpt 7 , updateExcerpt 8 , deleteExcerpt 9 ) where 10 11 import qualified Language.Haskell.TH as TH 12 13 import Databrary.Model.SQL.Select 14 import Databrary.Model.Audit.SQL 15 import Databrary.Model.Release.Types 16 import Databrary.Model.Volume.Types 17 import Databrary.Model.Container.Types 18 import Databrary.Model.Container.SQL 19 import Databrary.Model.Segment 20 import Databrary.Model.Asset.Types 21 import Databrary.Model.Asset.SQL 22 import Databrary.Model.AssetSlot.Types 23 import Databrary.Model.AssetSlot.SQL 24 import Databrary.Model.AssetSegment.Types 25 26 makeExcerpt :: Segment -> Maybe Release -> AssetSlot -> Excerpt 27 makeExcerpt s r a = newExcerpt a s r 28 29 excerptRow :: Selector -- ^ @'AssetSlot' -> 'Excerpt'@ 30 excerptRow = selectColumns 'makeExcerpt "excerpt" ["segment", "release"] 31 32 selectAssetSlotExcerpt :: Selector -- ^ @'AssetSlot' -> 'Excerpt'@ 33 selectAssetSlotExcerpt = excerptRow 34 35 makeAssetContainerExcerpt :: Segment -> (AssetSlot -> Excerpt) -> Asset -> Container -> Excerpt 36 makeAssetContainerExcerpt as e a c = e $ makeSlotAsset a c as 37 38 selectAssetContainerExcerpt :: Selector -- ^ @'Asset' -> 'Container' -> 'Excerpt'@ 39 selectAssetContainerExcerpt = selectJoin 'makeAssetContainerExcerpt 40 [ slotAssetRow 41 , joinOn "slot_asset.asset = excerpt.asset" 42 excerptRow 43 ] 44 45 makeContainerExcerpt :: (Asset -> Container -> Excerpt) -> AssetRow -> Container -> Excerpt 46 makeContainerExcerpt f ar c = f (Asset ar (containerVolume c)) c 47 48 selectContainerExcerpt :: Selector -- ^ @'Container' -> 'Excerpt'@ 49 selectContainerExcerpt = selectJoin 'makeContainerExcerpt 50 [ selectAssetContainerExcerpt 51 , joinOn "slot_asset.asset = asset.id" 52 selectAssetRow -- XXX volumes match? 53 ] 54 55 makeVolumeExcerpt :: (Asset -> Container -> Excerpt) -> AssetRow -> (Volume -> Container) -> Volume -> Excerpt 56 makeVolumeExcerpt f ar cf v = f (Asset ar v) (cf v) 57 58 selectVolumeExcerpt :: Selector -- ^ @'Volume' -> 'Excerpt'@ 59 selectVolumeExcerpt = selectJoin 'makeVolumeExcerpt 60 [ selectAssetContainerExcerpt 61 , joinOn "slot_asset.asset = asset.id" 62 selectAssetRow 63 , joinOn "slot_asset.container = container.id AND asset.volume = container.volume" 64 selectVolumeContainer 65 ] 66 67 excerptKeys :: String -- ^ @'Excerpt'@ 68 -> [(String, String)] 69 excerptKeys o = 70 [ ("asset", "${assetId $ assetRow $ slotAsset $ segmentAsset $ excerptAsset " ++ o ++ "}") 71 , ("segment", "${assetSegment $ excerptAsset " ++ o ++ "}") 72 ] 73 74 excerptSets :: String -- ^ @'Excerpt'@ 75 -> [(String, String)] 76 excerptSets o = 77 [ ("release", "${excerptRelease " ++ o ++ "}") 78 ] 79 80 insertExcerpt :: TH.Name -- ^ @'AuditIdentity'@ 81 -> TH.Name -- ^ @'Excerpt'@ 82 -> TH.ExpQ 83 insertExcerpt ident o = auditInsert ident "excerpt" 84 (excerptKeys os ++ excerptSets os) 85 Nothing 86 where os = nameRef o 87 88 updateExcerpt :: TH.Name -- ^ @'AuditIdentity'@ 89 -> TH.Name -- ^ @'Excerpt'@ 90 -> TH.ExpQ 91 updateExcerpt ident o = auditUpdate ident "excerpt" 92 (excerptSets os) 93 (whereEq $ excerptKeys os) 94 Nothing 95 where os = nameRef o 96 97 deleteExcerpt :: TH.Name -- ^ @'AuditIdentity'@ 98 -> TH.Name -- ^ @'AssetSegment'@ 99 -> TH.ExpQ 100 deleteExcerpt ident o = auditDelete ident "excerpt" 101 ("asset = ${assetId $ assetRow $ slotAsset $ segmentAsset " ++ os ++ "} AND segment <@ ${assetSegment " ++ os ++ "}") 102 Nothing 103 where os = nameRef o