1 {-# LANGUAGE TypeFamilies #-} 2 module Databrary.Model.AssetSlot.Types 3 ( AssetSlotId(..) 4 , AssetSlot(..) 5 , assetSlotId 6 , assetNoSlot 7 , getAssetSlotVolume 8 , getAssetSlotVolumePermission2 9 , getAssetSlotRelease 10 , getAssetSlotReleaseMaybe 11 , getAssetSlotRelease2 12 , getAssetSlotFormat 13 ) where 14 15 import Control.Applicative ((<|>)) 16 import Data.Foldable (fold) 17 18 import Databrary.Has (Has(..)) 19 import Databrary.Model.Id.Types 20 import Databrary.Model.Permission 21 import Databrary.Model.Release 22 import Databrary.Model.Segment 23 import Databrary.Model.Volume.Types 24 import Databrary.Model.Container.Types 25 import Databrary.Model.Format.Types 26 import Databrary.Model.Asset.Types 27 import Databrary.Model.Slot.Types 28 -- import Databrary.Model.Asset (blankAsset) 29 30 data AssetSlotId = AssetSlotId 31 { slotAssetId :: !(Id Asset) 32 , _assetSlotId :: !(Maybe (Id Slot)) 33 } 34 35 type instance IdType AssetSlot = AssetSlotId 36 37 -- | An entire asset in its assigned position. 38 data AssetSlot = AssetSlot 39 { slotAsset :: Asset 40 , assetSlot :: Maybe Slot 41 } 42 -- deriving (Show) 43 44 assetSlotId :: AssetSlot -> Id AssetSlot 45 assetSlotId (AssetSlot a s) = Id $ AssetSlotId (assetId $ assetRow a) (slotId <$> s) 46 47 assetNoSlot :: Asset -> AssetSlot 48 assetNoSlot a = AssetSlot a Nothing 49 50 instance Has Asset AssetSlot where 51 view = slotAsset 52 instance Has (Id Asset) AssetSlot where 53 view = view . slotAsset 54 instance Has Format AssetSlot where 55 view = view . slotAsset 56 instance Has (Id Format) AssetSlot where 57 view = view . slotAsset 58 instance Has Volume AssetSlot where 59 view = view . slotAsset 60 getAssetSlotVolume :: AssetSlot -> Volume 61 getAssetSlotVolume = assetVolume . slotAsset 62 instance Has (Id Volume) AssetSlot where 63 view = view . slotAsset 64 getAssetSlotVolumePermission2 :: AssetSlot -> VolumeRolePolicy 65 getAssetSlotVolumePermission2 = volumeRolePolicy . getAssetSlotVolume 66 getAssetSlotFormat :: AssetSlot -> Format 67 getAssetSlotFormat = getAssetFormat . slotAsset 68 69 instance Has (Maybe Slot) AssetSlot where 70 view = assetSlot 71 instance Has (Maybe Container) AssetSlot where 72 view = fmap view . assetSlot 73 instance Has (Maybe (Id Container)) AssetSlot where 74 view = fmap view . assetSlot 75 instance Has (Maybe Segment) AssetSlot where 76 view = fmap view . assetSlot 77 instance Has Segment AssetSlot where 78 view = maybe fullSegment slotSegment . assetSlot 79 80 getAssetSlotRelease :: AssetSlot -> Release -- TODO: Delete this and fix usages 81 getAssetSlotRelease as = 82 fold (getAssetSlotReleaseMaybe as) 83 getAssetSlotReleaseMaybe :: AssetSlot -> Maybe Release 84 getAssetSlotReleaseMaybe as = 85 (case as of 86 AssetSlot a (Just s) -> 87 getAssetReleaseMaybe a <|> getSlotReleaseMaybe s 88 AssetSlot a Nothing -> 89 if not (assetSlotIsDeletedFromItsContainer as) 90 then getAssetReleaseMaybe a 91 else Nothing) -- "deleted" assets are always unreleased (private?), not view a 92 93 assetSlotIsDeletedFromItsContainer :: AssetSlot -> Bool 94 assetSlotIsDeletedFromItsContainer (AssetSlot a Nothing) = volumeId (volumeRow $ assetVolume a) /= coreVolumeId 95 assetSlotIsDeletedFromItsContainer (AssetSlot _ (Just _)) = False 96 97 getAssetSlotRelease2 :: AssetSlot -> EffectiveRelease -- TODO: use this throughout? 98 getAssetSlotRelease2 as = 99 let 100 pubRel = fold (getAssetSlotReleaseMaybe as) 101 in 102 EffectiveRelease { effRelPublic = pubRel, effRelPrivate = ReleasePRIVATE } 103