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