1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, TypeFamilies #-} 2 module Databrary.Model.Slot.Types 3 ( SlotId(..) 4 , Slot(..) 5 , slotId 6 , containerSlotId 7 , containerSlot 8 , getSlotReleaseMaybe 9 ) where 10 11 import Databrary.Has (Has(..)) 12 import Databrary.Model.Id 13 import Databrary.Model.Kind 14 import Databrary.Model.Segment 15 import Databrary.Model.Container.Types 16 import Databrary.Model.Permission.Types 17 import Databrary.Model.Release.Types 18 import Databrary.Model.Volume.Types 19 20 data SlotId = SlotId 21 { slotContainerId :: !(Id Container) 22 , slotSegmentId :: !Segment 23 } deriving (Eq, Show) 24 25 type instance IdType Slot = SlotId 26 27 containerSlotId :: Id Container -> Id Slot 28 containerSlotId c = Id $ SlotId c fullSegment 29 30 data Slot = Slot 31 { slotContainer :: !Container 32 , slotSegment :: !Segment 33 } 34 instance Show Slot where 35 show _ = "Slot" 36 37 slotId :: Slot -> Id Slot 38 slotId (Slot c s) = Id $ SlotId (containerId (containerRow c)) s 39 40 containerSlot :: Container -> Slot 41 containerSlot c = Slot c fullSegment 42 43 instance Kinded Slot where 44 kindOf _ = "slot" 45 46 -- makeHasRec ''SlotId ['slotContainerId, 'slotSegmentId] 47 -- makeHasRec ''Slot ['slotContainer, 'slotSegment] 48 -- instance Has (Id Container) SlotId where 49 -- view = slotContainerId 50 -- instance Has Segment SlotId where 51 -- view = slotSegmentId 52 53 instance Has Container Slot where 54 view = slotContainer 55 -- instance Has Databrary.Model.Volume.Types.VolumeRow Slot where 56 -- view = (view . slotContainer) 57 instance Has (Id Databrary.Model.Volume.Types.Volume) Slot where 58 view = (view . slotContainer) 59 instance Has Databrary.Model.Permission.Types.Permission Slot where 60 view = (view . slotContainer) 61 instance Has Databrary.Model.Volume.Types.Volume Slot where 62 view = (view . slotContainer) 63 -- instance Has Databrary.Model.Release.Types.Release Slot where 64 -- view = (view . slotContainer) 65 instance Has (Maybe Databrary.Model.Release.Types.Release) Slot where 66 view = (view . slotContainer) 67 instance Has (Id Container) Slot where 68 view = (view . slotContainer) 69 -- instance Has ContainerRow Slot where 70 -- view = (view . slotContainer) 71 instance Has Segment Slot where 72 view = slotSegment 73 74 getSlotReleaseMaybe :: Slot -> Maybe Release 75 getSlotReleaseMaybe = containerRelease . slotContainer