module Model.AssetSegment.SQL
( excerptRow
, makeExcerpt
, selectAssetSegment
, selectContainerAssetSegment
) where
import Data.Maybe (fromMaybe)
import qualified Language.Haskell.TH as TH
import Model.SQL.Select
import Model.Release.Types
import Model.Segment
import Model.Volume.Types
import Model.Volume.SQL
import Model.Container.Types
import Model.Container.SQL
import Model.Asset.Types
import Model.Asset.SQL
import Model.AssetSlot.Types
import Model.AssetSlot.SQL
import Model.AssetSegment.Types
excerptTuple :: Segment -> Maybe Release -> (Segment, Maybe Release)
excerptTuple = (,)
excerptRow :: Selector
excerptRow = selectColumns 'excerptTuple "excerpt" ["segment", "release"]
makeExcerpt :: AssetSlot -> Segment -> Maybe (Segment, Maybe Release) -> AssetSegment
makeExcerpt a s = newAssetSegment a s . fmap (uncurry $ newExcerpt a)
makeAssetSegment :: Segment -> Maybe Segment -> Maybe (Segment, Maybe Release) -> Asset -> Container -> AssetSegment
makeAssetSegment as ss e a c = makeExcerpt sa ss' e where
sa = makeSlotAsset a c as
ss' = fromMaybe emptySegment ss
selectAssetContainerAssetSegment :: TH.Name
-> Selector
selectAssetContainerAssetSegment seg = selectJoin 'makeAssetSegment
[ slotAssetRow
, crossJoin
$ selector ("LATERAL (VALUES (slot_asset.segment * ${" ++ nameRef seg ++ "})) AS asset_segment (segment)")
$ SelectColumn "asset_segment" "segment"
, maybeJoinOn "slot_asset.asset = excerpt.asset AND asset_segment.segment <@ excerpt.segment"
excerptRow
]
makeContainerAssetSegment :: (Asset -> Container -> AssetSegment) -> AssetRow -> Container -> AssetSegment
makeContainerAssetSegment f ar c = f (Asset ar $ containerVolume c) c
selectContainerAssetSegment :: TH.Name
-> Selector
selectContainerAssetSegment seg = selectJoin 'makeContainerAssetSegment
[ selectAssetContainerAssetSegment seg
, joinOn "slot_asset.asset = asset.id"
selectAssetRow
]
makeVolumeAssetSegment :: (Asset -> Container -> AssetSegment) -> AssetRow -> (Volume -> Container) -> Volume -> AssetSegment
makeVolumeAssetSegment f ar cf v = f (Asset ar v) (cf v)
selectVolumeAssetSegment :: TH.Name
-> Selector
selectVolumeAssetSegment seg = selectJoin 'makeVolumeAssetSegment
[ selectAssetContainerAssetSegment seg
, joinOn "slot_asset.asset = asset.id"
selectAssetRow
, joinOn "slot_asset.container = container.id AND asset.volume = container.volume"
selectVolumeContainer
]
selectAssetSegment :: TH.Name
-> TH.Name
-> Selector
selectAssetSegment ident seg = selectJoin '($)
[ selectVolumeAssetSegment seg
, joinOn "asset.volume = volume.id"
$ selectVolume ident
]