{-# LANGUAGE TypeFamilies, FlexibleInstances #-}

module Propellor.Types.Container where

import Propellor.Types.Info

-- | A value that can be bound between the host and a container.
--
-- For example, a Bound Port is a Port on the container that is bound to
-- a Port on the host.
data Bound v = Bound
	{ forall v. Bound v -> v
hostSide :: v
	, forall v. Bound v -> v
containerSide :: v
	}

-- | Create a Bound value, from two different values for the host and
-- container.
--
-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host
-- is bound to port 80 from the container.
(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v
-<- :: forall hostv v containerv.
(hostv ~ v, containerv ~ v) =>
hostv -> containerv -> Bound v
(-<-) = forall v. v -> v -> Bound v
Bound

-- | Flipped version of -<- with the container value first and host value
-- second.
(->-) :: (containerv ~ v, hostv ~ v) => containerv -> hostv -> Bound v
->- :: forall hostv v containerv.
(hostv ~ v, containerv ~ v) =>
hostv -> containerv -> Bound v
(->-) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall hostv v containerv.
(hostv ~ v, containerv ~ v) =>
hostv -> containerv -> Bound v
(-<-)

-- | Create a Bound value, that is the same on both the host and container.
same :: v -> Bound v
same :: forall v. v -> Bound v
same v
v = forall v. v -> v -> Bound v
Bound v
v v
v

-- | Capabilities of a container.
data ContainerCapability
	= HostnameContained
	-- ^ The container has its own hostname (and domain name)
	-- separate from the system that contains it.
	| FilesystemContained
	-- ^ The container has its own root filesystem, rather than sharing
	-- the root filesystem of the system that contains it.
	deriving (Typeable, ContainerCapability -> ContainerCapability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerCapability -> ContainerCapability -> Bool
$c/= :: ContainerCapability -> ContainerCapability -> Bool
== :: ContainerCapability -> ContainerCapability -> Bool
$c== :: ContainerCapability -> ContainerCapability -> Bool
Eq, ReadPrec [ContainerCapability]
ReadPrec ContainerCapability
Int -> ReadS ContainerCapability
ReadS [ContainerCapability]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContainerCapability]
$creadListPrec :: ReadPrec [ContainerCapability]
readPrec :: ReadPrec ContainerCapability
$creadPrec :: ReadPrec ContainerCapability
readList :: ReadS [ContainerCapability]
$creadList :: ReadS [ContainerCapability]
readsPrec :: Int -> ReadS ContainerCapability
$creadsPrec :: Int -> ReadS ContainerCapability
Read, Int -> ContainerCapability -> ShowS
[ContainerCapability] -> ShowS
ContainerCapability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContainerCapability] -> ShowS
$cshowList :: [ContainerCapability] -> ShowS
show :: ContainerCapability -> String
$cshow :: ContainerCapability -> String
showsPrec :: Int -> ContainerCapability -> ShowS
$cshowsPrec :: Int -> ContainerCapability -> ShowS
Show)

-- | A [ContainerCapability] can be used as Info.
-- It does not propagate out to the Host.
-- When not in a container, the Info value will be [].
instance IsInfo [ContainerCapability] where
        propagateInfo :: [ContainerCapability] -> PropagateInfo
propagateInfo [ContainerCapability]
_ = Bool -> PropagateInfo
PropagateInfo Bool
False