1 module Databrary.Model.AssetSegment.Types 2 ( AssetSegment(..) 3 , getAssetSegmentRelease2 4 , getAssetSegmentVolumePermission2 5 , getAssetSegmentVolume 6 , newAssetSegment 7 , assetFullSegment 8 , assetSlotSegment 9 , assetSegmentFull 10 , assetSegmentRange 11 , Excerpt(..) 12 , newExcerpt 13 , excerptInSegment 14 ) where 15 16 import Data.Foldable (fold) 17 import Data.Maybe (fromMaybe) 18 import Data.Monoid ((<>)) 19 import qualified Database.PostgreSQL.Typed.Range as Range 20 21 import Databrary.Ops 22 import Databrary.Has (Has(..)) 23 import Databrary.Model.Offset 24 import Databrary.Model.Segment 25 import Databrary.Model.Id.Types 26 import Databrary.Model.Permission.Types 27 import Databrary.Model.Volume.Types 28 import Databrary.Model.Release.Types 29 import Databrary.Model.Container.Types 30 import Databrary.Model.Slot.Types 31 import Databrary.Model.Format 32 import Databrary.Model.Asset.Types 33 import Databrary.Model.AssetSlot.Types 34 35 data AssetSegment = AssetSegment 36 { segmentAsset :: AssetSlot 37 , assetSegment :: !Segment 38 , assetExcerpt :: Maybe Excerpt 39 } 40 -- deriving (Show) 41 42 assetAssumedSegment :: AssetSlot -> Segment 43 assetAssumedSegment a 44 | segmentFull seg = Segment $ Range.bounded 0 $ fromMaybe 0 $ assetDuration $ assetRow $ slotAsset a 45 | otherwise = seg where seg = view a 46 47 -- |A "fake" (possibly invalid) 'AssetSegment' corresponding to the full 'AssetSlot' 48 assetSlotSegment :: AssetSlot -> AssetSegment 49 assetSlotSegment a = AssetSegment a (assetAssumedSegment a) Nothing 50 51 assetFullSegment :: AssetSegment -> AssetSegment 52 assetFullSegment AssetSegment{ assetExcerpt = Just e } = excerptFullSegment e 53 assetFullSegment AssetSegment{ segmentAsset = a } = assetSlotSegment a 54 55 newAssetSegment :: AssetSlot -> Segment -> Maybe Excerpt -> AssetSegment 56 newAssetSegment a s e = AssetSegment a (assetAssumedSegment a `segmentIntersect` s) e 57 58 assetSegmentFull :: AssetSegment -> Bool 59 assetSegmentFull AssetSegment{ segmentAsset = a, assetSegment = s } = assetAssumedSegment a == s 60 61 assetSegmentRange :: AssetSegment -> Range.Range Offset 62 assetSegmentRange AssetSegment{ segmentAsset = a, assetSegment = Segment s } = 63 maybe id (fmap . subtract) (lowerBound $ segmentRange $ assetAssumedSegment a) s 64 65 instance Has AssetSlot AssetSegment where 66 view = segmentAsset 67 instance Has Asset AssetSegment where 68 view = view . segmentAsset 69 instance Has (Id Asset) AssetSegment where 70 view = view . segmentAsset 71 getAssetSegmentVolume :: AssetSegment -> Volume 72 getAssetSegmentVolume = getAssetSlotVolume . segmentAsset 73 instance Has Volume AssetSegment where 74 view = view . segmentAsset 75 instance Has (Id Volume) AssetSegment where 76 view = view . segmentAsset 77 getAssetSegmentVolumePermission2 :: AssetSegment -> VolumeRolePolicy 78 getAssetSegmentVolumePermission2 = getAssetSlotVolumePermission2 . segmentAsset 79 80 instance Has Slot AssetSegment where 81 view AssetSegment{ segmentAsset = AssetSlot{ assetSlot = Just s }, assetSegment = seg } = s{ slotSegment = seg } 82 view _ = error "unlinked AssetSegment" 83 instance Has Container AssetSegment where 84 view = slotContainer . view 85 instance Has (Id Container) AssetSegment where 86 view = containerId . containerRow . slotContainer . view 87 instance Has Segment AssetSegment where 88 view = assetSegment 89 90 instance Has Format AssetSegment where 91 view AssetSegment{ segmentAsset = a, assetSegment = Segment rng } 92 | Just s <- formatSample fmt 93 , Just _ <- assetDuration $ assetRow $ slotAsset a 94 , Just _ <- Range.getPoint rng = s 95 | otherwise = fmt 96 where fmt = getAssetSlotFormat a 97 instance Has (Id Format) AssetSegment where 98 view = formatId . view 99 100 -- when the assetslot has lower permissions than the excerpt, then use the excerpt's permissions 101 -- when no excerpt is present, then assume no access 102 getAssetSegmentRelease2 :: AssetSegment -> EffectiveRelease 103 getAssetSegmentRelease2 as = 104 case as of 105 AssetSegment{ segmentAsset = a, assetExcerpt = Just e } -> 106 let 107 rel = 108 fold ( 109 excerptRelease e -- Maybe Release monoid takes the first just, if both just, then max of values 110 <> getAssetSlotReleaseMaybe a) -- TODO: should I expose the guts of getAssetSlotRelease2? 111 in 112 EffectiveRelease { 113 effRelPublic = rel 114 , effRelPrivate = rel 115 } 116 AssetSegment{ segmentAsset = a } -> 117 getAssetSlotRelease2 a 118 119 data Excerpt = Excerpt 120 { excerptAsset :: !AssetSegment 121 , excerptRelease :: !(Maybe Release) 122 } 123 instance Show Excerpt where 124 show _ = "Excerpt" 125 126 newExcerpt :: AssetSlot -> Segment -> Maybe Release -> Excerpt 127 newExcerpt a s r = e where 128 as = newAssetSegment a s (Just e) 129 e = Excerpt as r 130 131 excerptInSegment :: Excerpt -> Segment -> AssetSegment 132 excerptInSegment e@Excerpt{ excerptAsset = AssetSegment{ segmentAsset = a, assetSegment = es } } s 133 | segmentOverlaps es s = as 134 | otherwise = error "excerptInSegment: non-overlapping" 135 where as = newAssetSegment a s ((es `segmentContains` assetSegment as) `thenUse` e) 136 137 excerptFullSegment :: Excerpt -> AssetSegment 138 excerptFullSegment e = excerptInSegment e fullSegment 139 140 instance Has AssetSegment Excerpt where 141 view = excerptAsset 142 instance Has AssetSlot Excerpt where 143 view = view . excerptAsset 144 instance Has Asset Excerpt where 145 view = view . excerptAsset 146 instance Has (Id Asset) Excerpt where 147 view = view . excerptAsset 148 instance Has Volume Excerpt where 149 view = view . excerptAsset 150 instance Has (Id Volume) Excerpt where 151 view = view . excerptAsset 152 instance Has Slot Excerpt where 153 view = view . excerptAsset 154 instance Has Container Excerpt where 155 view = view . excerptAsset 156 instance Has (Id Container) Excerpt where 157 view = view . excerptAsset 158 instance Has Segment Excerpt where 159 view = view . excerptAsset