1 {-# LANGUAGE TemplateHaskell #-} 2 module 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 Model.SQL.Select 14 import Model.Audit.SQL 15 import Model.Release.Types 16 import Model.Volume.Types 17 import Model.Container.Types 18 import Model.Container.SQL 19 import Model.Segment 20 import Model.Asset.Types 21 import Model.Asset.SQL 22 import Model.AssetSlot.Types 23 import Model.AssetSlot.SQL 24 import 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