1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} 2 module Databrary.Model.AssetSlot.SQL 3 ( slotAssetRow 4 , makeSlotAsset 5 , selectContainerSlotAsset 6 -- , selectOrigContainerSlotAsset 7 , selectAssetSlotAsset 8 , selectVolumeSlotAsset 9 , selectVolumeSlotIdAsset 10 -- , selectSlotAsset 11 , selectAssetSlot 12 -- , insertSlotAsset 13 -- , updateSlotAsset 14 -- , deleteSlotAsset 15 ) where 16 17 import Data.Maybe (fromMaybe) 18 import qualified Language.Haskell.TH as TH 19 20 import Databrary.Has (view) 21 import Databrary.Model.Segment 22 import Databrary.Model.Volume.Types 23 import Databrary.Model.Asset.Types 24 import Databrary.Model.Asset.SQL 25 import Databrary.Model.Container.Types 26 import Databrary.Model.Container.SQL 27 import Databrary.Model.Slot.Types 28 import Databrary.Model.SQL.Select 29 import Databrary.Model.Volume.SQL 30 import Databrary.Model.AssetSlot.Types 31 32 slotAssetRow :: Selector -- ^ @'Segment'@ 33 slotAssetRow = selectColumn "slot_asset" "segment" 34 35 makeSlotAsset :: Asset -> Container -> Segment -> AssetSlot 36 makeSlotAsset a c s = AssetSlot a (Just (Slot c s)) 37 38 _selectAssetContainerSlotAsset :: Selector -- ^ @'Asset' -> 'Container' -> 'AssetSlot'@ 39 _selectAssetContainerSlotAsset = selectMap (TH.VarE 'makeSlotAsset `TH.AppE`) slotAssetRow 40 41 makeContainerSlotAsset :: Segment -> AssetRow -> Container -> AssetSlot 42 makeContainerSlotAsset s ar c = makeSlotAsset (Asset ar $ view c) c s 43 44 selectContainerSlotAsset :: Selector -- ^ @'Container' -> 'AssetSlot'@ 45 selectContainerSlotAsset = selectJoin 'makeContainerSlotAsset 46 [ slotAssetRow 47 , joinOn "slot_asset.asset = asset.id" selectAssetRow -- XXX volumes match? 48 ] 49 50 {- 51 selectOrigContainerSlotAsset :: Selector -- ^ @'Container' -> 'AssetSlot'@ 52 selectOrigContainerSlotAsset = selectJoin 'makeContainerSlotAsset 53 [ slotAssetRow 54 , joinOn "slot_asset.asset = asset.id" selectAssetRow -- XXX volumes match? 55 ] 56 -} 57 58 makeVolumeSlotIdAsset :: SlotId -> AssetRow -> Volume -> (Asset, SlotId) 59 makeVolumeSlotIdAsset s ar v = (Asset ar v, s) 60 61 selectVolumeSlotIdAsset :: Selector -- ^ @'Volume' -> ('Asset', 'SlotId')@ 62 selectVolumeSlotIdAsset = selectJoin 'makeVolumeSlotIdAsset 63 [ selectColumns 'SlotId "slot_asset" ["container", "segment"] 64 , joinOn "slot_asset.asset = asset.id" 65 selectAssetRow -- XXX volumes match? 66 ] 67 68 makeAssetSlotAsset :: Segment -> (Volume -> Container) -> Asset -> AssetSlot 69 makeAssetSlotAsset s cf a = makeSlotAsset a (cf (view a)) s 70 71 selectAssetSlotAsset :: Selector -- ^ @'Asset' -> 'AssetSlot'@ 72 selectAssetSlotAsset = selectJoin 'makeAssetSlotAsset 73 [ slotAssetRow 74 , joinOn "slot_asset.container = container.id" 75 selectVolumeContainer -- XXX volumes match? 76 ] 77 78 makeVolumeSlotAsset :: Segment -> AssetRow -> (Volume -> Container) -> Volume -> AssetSlot 79 makeVolumeSlotAsset s ar cf v = makeSlotAsset (Asset ar v) (cf v) s 80 81 selectVolumeSlotAsset :: Selector -- ^ @'Volume' -> 'AssetSlot'@ 82 selectVolumeSlotAsset = selectJoin 'makeVolumeSlotAsset 83 [ slotAssetRow 84 , joinOn "slot_asset.asset = asset.id" 85 selectAssetRow 86 , joinOn "slot_asset.container = container.id AND asset.volume = container.volume" 87 selectVolumeContainer 88 ] 89 90 {- 91 selectSlotAsset :: TH.Name -- ^ @'Identity'@ 92 -> Selector -- ^ @'AssetSlot'@ 93 selectSlotAsset ident = selectJoin '($) 94 [ selectVolumeSlotAsset 95 , joinOn "asset.volume = volume.id" 96 $ selectVolume ident 97 ] 98 -} 99 100 makeVolumeAssetSlot :: AssetRow -> Maybe (Asset -> AssetSlot) -> Volume -> AssetSlot 101 makeVolumeAssetSlot ar sf = fromMaybe assetNoSlot sf . Asset ar 102 103 selectVolumeAssetSlot :: Selector -- ^ @'Volume' -> 'AssetSlot'@ 104 selectVolumeAssetSlot = selectJoin 'makeVolumeAssetSlot 105 [ selectAssetRow 106 , maybeJoinOn "asset.id = slot_asset.asset AND asset.volume = container.volume" 107 selectAssetSlotAsset 108 ] 109 110 selectAssetSlot :: TH.Name -- ^ @'Identity'@ 111 -> Selector -- ^ @'AssetSlot'@ 112 selectAssetSlot ident = selectJoin '($) 113 [ selectVolumeAssetSlot 114 , joinOn "asset.volume = volume.id" 115 $ selectVolume ident 116 ] 117 118 {- 119 slotAssetKeys :: String -- ^ @'AssetSlot'@ 120 -> [(String, String)] 121 slotAssetKeys as = 122 [ ("asset", "${assetId $ assetRow $ slotAsset " ++ as ++ "}") ] 123 124 slotAssetSets :: String -- ^ @'AssetSlot'@ 125 -> [(String, String)] 126 slotAssetSets as = 127 [ ("container", "${containerId . containerRow . slotContainer <$> assetSlot " ++ as ++ "}") 128 , ("segment", "${slotSegment <$> assetSlot " ++ as ++ "}") 129 ] 130 131 insertSlotAsset :: TH.Name -- ^ @'AuditIdentity'@ 132 -> TH.Name -- ^ @'AssetSlot'@ 133 -> TH.ExpQ 134 insertSlotAsset ident o = auditInsert ident "slot_asset" 135 (slotAssetKeys os ++ slotAssetSets os) 136 Nothing 137 where os = nameRef o 138 139 updateSlotAsset :: TH.Name -- ^ @'AuditIdentity'@ 140 -> TH.Name -- ^ @'AssetSlot'@ 141 -> TH.ExpQ 142 updateSlotAsset ident o = auditUpdate ident "slot_asset" 143 (slotAssetSets os) 144 (whereEq $ slotAssetKeys os) 145 Nothing 146 where os = nameRef o 147 148 deleteSlotAsset :: TH.Name -- ^ @'AuditIdentity'@ 149 -> TH.Name -- ^ @'AssetSlot'@ 150 -> TH.ExpQ 151 deleteSlotAsset ident o = auditDelete ident "slot_asset" 152 (whereEq $ slotAssetKeys os) 153 Nothing 154 where os = nameRef o 155 -}