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