{-# LANGUAGE DataKinds, TypeFamilies #-}

module Propellor.Container where

import Propellor.Types
import Propellor.Types.Core
import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.Info
import Propellor.PrivData
import Propellor.PropAccum

class IsContainer c where
	containerProperties :: c -> [ChildProperty]
	containerInfo :: c -> Info
	setContainerProperties :: c -> [ChildProperty] -> c

instance IsContainer Host where
	containerProperties :: Host -> [ChildProperty]
containerProperties = Host -> [ChildProperty]
hostProperties
	containerInfo :: Host -> Info
containerInfo = Host -> Info
hostInfo
	setContainerProperties :: Host -> [ChildProperty] -> Host
setContainerProperties Host
h [ChildProperty]
ps = forall metatypes. HostName -> Props metatypes -> Host
host (Host -> HostName
hostName Host
h) (forall metatypes. [ChildProperty] -> Props metatypes
Props [ChildProperty]
ps)

-- | Note that the metatype of a container's properties is not retained,
-- so this defaults to UnixLike. So, using this with setContainerProps can
-- add properties to a container that conflict with properties already in it.
-- Use caution when using this; only add properties that do not have
-- restricted targets.
containerProps :: IsContainer c => c -> Props UnixLike
containerProps :: forall c. IsContainer c => c -> Props UnixLike
containerProps = forall metatypes. [ChildProperty] -> Props metatypes
Props forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. IsContainer c => c -> [ChildProperty]
containerProperties

setContainerProps :: IsContainer c => c -> Props metatypes -> c
setContainerProps :: forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps c
c (Props [ChildProperty]
ps) = forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties c
c [ChildProperty]
ps

-- | Adjust the provided Property, adding to its
-- propertyChidren the properties of the provided container.
-- 
-- The Info of the propertyChildren is adjusted to only include 
-- info that should be propagated out to the Property.
--
-- Any PrivInfo that uses HostContext is adjusted to use the name
-- of the container as its context.
propagateContainer
	::
		-- Since the children being added probably have info,
		-- require the Property's metatypes to have info.
		-- -Wredundant-constraints is turned off because
		-- this constraint appears redundant, but is actually
		-- crucial.
		( IncludesInfo metatypes ~ 'True
		, IsContainer c
		)
	=> String
	-> c
	-> (PropagateInfo -> Bool)
	-> Property metatypes
	-> Property metatypes
propagateContainer :: forall metatypes c.
(IncludesInfo metatypes ~ 'True, IsContainer c) =>
HostName
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer HostName
containername c
c PropagateInfo -> Bool
wanted Property metatypes
prop = Property metatypes
prop
	forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
convert (forall c. IsContainer c => c -> [ChildProperty]
containerProperties c
c)
  where
	convert :: ChildProperty -> ChildProperty
convert ChildProperty
p = 
		let n :: Property UnixLike
n = forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> Maybe (Propellor Result) -> Property (MetaTypes metatypes)
property'' (forall p. IsProp p => p -> HostName
getDesc ChildProperty
p) (forall p. IsProp p => p -> Maybe (Propellor Result)
getSatisfy ChildProperty
p) :: Property UnixLike
		    n' :: Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
n' = Property UnixLike
n
		    	forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` forall v. IsInfo v => (v -> v) -> Info -> Info
mapInfo (HostName -> PrivInfo -> PrivInfo
forceHostContext HostName
containername)
				((PropagateInfo -> Bool) -> Info -> Info
propagatableInfo PropagateInfo -> Bool
wanted (forall p. IsProp p => p -> Info
getInfo ChildProperty
p))
		   	forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
convert (forall p. IsProp p => p -> [ChildProperty]
getChildren ChildProperty
p)
		in forall p. IsProp p => p -> ChildProperty
toChildProperty Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
n'

-- | Filters out parts of the Info that should not propagate out of a
-- container.
propagatableInfo :: (PropagateInfo -> Bool) -> Info -> Info
propagatableInfo :: (PropagateInfo -> Bool) -> Info -> Info
propagatableInfo PropagateInfo -> Bool
wanted (Info [InfoEntry]
l) = [InfoEntry] -> Info
Info forall a b. (a -> b) -> a -> b
$
	forall a. (a -> Bool) -> [a] -> [a]
filter (\(InfoEntry v
a) -> PropagateInfo -> Bool
wanted (forall v. IsInfo v => v -> PropagateInfo
propagateInfo v
a)) [InfoEntry]
l

normalContainerInfo :: PropagateInfo -> Bool
normalContainerInfo :: PropagateInfo -> Bool
normalContainerInfo PropagateInfo
PropagatePrivData = Bool
True
normalContainerInfo (PropagateInfo Bool
b) = Bool
b

onlyPrivData :: PropagateInfo -> Bool
onlyPrivData :: PropagateInfo -> Bool
onlyPrivData PropagateInfo
PropagatePrivData = Bool
True
onlyPrivData (PropagateInfo Bool
_) = Bool
False