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