{-# 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 = hostProperties
        containerInfo = hostInfo
        setContainerProperties h ps = host (hostName h) (Props 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 = Props . containerProperties

setContainerProps :: IsContainer c => c -> Props metatypes -> c
setContainerProps c (Props ps) = setContainerProperties c 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 containername c wanted prop = prop
        `addChildren` map convert (containerProperties c)
  where
        convert p =
                let n = property'' (getDesc p) (getSatisfy p) :: Property UnixLike
                    n' = n
                        `setInfoProperty` mapInfo (forceHostContext containername)
                                (propagatableInfo wanted (getInfo p))
                        `addChildren` map convert (getChildren p)
                in toChildProperty n'

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

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

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