    {-# 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 = HostName -> Props (ZonkAny 0) -> Host
    forall metatypes. HostName -> Props metatypes -> Host
    host (Host -> HostName
    hostName Host
    h) ([ChildProperty] -> Props (ZonkAny 0)
    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 = [ChildProperty] -> Props UnixLike
    forall metatypes. [ChildProperty] -> Props metatypes
    Props ([ChildProperty] -> Props UnixLike)
    -> (c -> [ChildProperty]) -> c -> Props UnixLike
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . c -> [ChildProperty]
    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) = c -> [ChildProperty] -> c
    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
    	Property metatypes -> [ChildProperty] -> Property metatypes
    forall p. IsProp p => p -> [ChildProperty] -> p
    `addChildren` (ChildProperty -> ChildProperty)
    -> [ChildProperty] -> [ChildProperty]
    forall a b. (a -> b) -> [a] -> [b]
    map ChildProperty -> ChildProperty
    convert (c -> [ChildProperty]
    forall c. IsContainer c => c -> [ChildProperty]
    containerProperties c
    c)
      where
    	convert :: ChildProperty -> ChildProperty
    convert ChildProperty
    p =
    		let n :: Property UnixLike
    n = HostName -> Maybe (Propellor Result) -> Property UnixLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    HostName
    -> Maybe (Propellor Result) -> Property (MetaTypes metatypes)
    property'' (ChildProperty -> HostName
    forall p. IsProp p => p -> HostName
    getDesc ChildProperty
    p) (ChildProperty -> Maybe (Propellor Result)
    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
    		    	Property UnixLike
    -> Info
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall {k} (metatypes' :: k) metatypes.
    (MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
    Property metatypes -> Info -> Property (MetaTypes metatypes')
    `setInfoProperty` (PrivInfo -> PrivInfo) -> Info -> Info
    forall v. IsInfo v => (v -> v) -> Info -> Info
    mapInfo (HostName -> PrivInfo -> PrivInfo
    forceHostContext HostName
    containername)
    				((PropagateInfo -> Bool) -> Info -> Info
    propagatableInfo PropagateInfo -> Bool
    wanted (ChildProperty -> Info
    forall p. IsProp p => p -> Info
    getInfo ChildProperty
    p))
    		   	Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> [ChildProperty]
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall p. IsProp p => p -> [ChildProperty] -> p
    `addChildren` (ChildProperty -> ChildProperty)
    -> [ChildProperty] -> [ChildProperty]
    forall a b. (a -> b) -> [a] -> [b]
    map ChildProperty -> ChildProperty
    convert (ChildProperty -> [ChildProperty]
    forall p. IsProp p => p -> [ChildProperty]
    getChildren ChildProperty
    p)
    		in Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> ChildProperty
    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 ([InfoEntry] -> Info) -> [InfoEntry] -> Info
    forall a b. (a -> b) -> a -> b
    $
    	(InfoEntry -> Bool) -> [InfoEntry] -> [InfoEntry]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(InfoEntry v
    a) -> PropagateInfo -> Bool
    wanted (v -> PropagateInfo
    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