1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, TypeFamilies #-} 2 module Databrary.Model.Container.Types 3 ( ContainerRow(..) 4 , Container(..) 5 , getContainerVolumeRole 6 , getContainerRelease 7 ) where 8 9 import Data.Foldable (fold) 10 import qualified Data.Text as T 11 12 import Databrary.Has (Has(..)) 13 import Databrary.Model.Time 14 import Databrary.Model.Kind 15 import Databrary.Model.Release.Types 16 import Databrary.Model.Id.Types 17 import Databrary.Model.Volume.Types 18 import Databrary.Model.Permission.Types 19 20 type instance IdType Container = Int32 21 22 data ContainerRow = ContainerRow 23 { containerId :: Id Container 24 , containerTop :: Bool 25 , containerName :: Maybe T.Text 26 , containerDate :: Maybe Date 27 } deriving (Eq, Show) 28 29 data Container = Container 30 { containerRow :: !ContainerRow 31 , containerRelease :: Maybe Release 32 , containerVolume :: Volume 33 } 34 35 getContainerVolumeRole :: Container -> VolumeRolePolicy 36 getContainerVolumeRole = volumeRolePolicy . containerVolume 37 38 getContainerRelease :: Container -> EffectiveRelease 39 getContainerRelease c = 40 EffectiveRelease { 41 effRelPublic = (fold . containerRelease) c 42 , effRelPrivate = ReleasePRIVATE -- TODO: name hardcoded default level for Private release centrally 43 } 44 45 instance Kinded Container where 46 kindOf _ = "container" 47 48 -- makeHasRec ''ContainerRow ['containerId] 49 -- makeHasRec ''Container ['containerRow, 'containerRelease, 'containerVolume] 50 instance Has (Id Container) ContainerRow where 51 view = containerId 52 53 -- instance Has ContainerRow Container where 54 -- view = containerRow 55 instance Has (Id Container) Container where 56 view = (view . containerRow) 57 instance Has (Maybe Release) Container where 58 view = containerRelease 59 -- instance Has Release Container where 60 -- view = (view . containerRelease) 61 instance Has Volume Container where 62 view = containerVolume 63 instance Has Permission Container where 64 view = (view . containerVolume) 65 instance Has (Id Volume) Container where 66 view = (view . containerVolume) 67 -- instance Has VolumeRow Container where 68 -- view = (view . containerVolume)