1 {-# LANGUAGE OverloadedStrings, TypeFamilies #-}
    2 module Model.Slot.Types
    3   ( SlotId(..)
    4   , Slot(..)
    5   , slotId
    6   , containerSlotId
    7   , containerSlot
    8   , getSlotReleaseMaybe
    9   ) where
   10 
   11 import Has (Has(..))
   12 import Model.Id
   13 import Model.Kind
   14 import Model.Segment
   15 import Model.Container.Types
   16 import Model.Permission.Types
   17 import Model.Release.Types
   18 import 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 {-
   35 instance Show Slot where
   36   show _ = "Slot"
   37 -}
   38 slotId :: Slot -> Id Slot
   39 slotId (Slot c s) = Id $ SlotId (containerId (containerRow c)) s
   40 
   41 containerSlot :: Container -> Slot
   42 containerSlot c = Slot c fullSegment
   43 
   44 instance Kinded Slot where
   45   kindOf _ = "slot"
   46 
   47 instance Has Container Slot where
   48   view = slotContainer
   49 instance Has Model.Permission.Types.Permission Slot where
   50   view = view . slotContainer
   51 instance Has Model.Volume.Types.Volume Slot where
   52   view = view . slotContainer
   53 instance Has (Maybe Model.Release.Types.Release) Slot where
   54   view = view . slotContainer
   55 instance Has (Id Container) Slot where
   56   view = view . slotContainer
   57 instance Has Segment Slot where
   58   view = slotSegment
   59 
   60 getSlotReleaseMaybe :: Slot -> Maybe Release
   61 getSlotReleaseMaybe = containerRelease . slotContainer