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 -}