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