Add HasImage type class which provides getImageName method to extract an image name. Image related functions now require a HasImage instance.

This commit is contained in:
Antoine Eiche 2015-05-16 00:00:00 +02:00 committed by Joey Hess
parent 04d04fe917
commit a781e43b22
1 changed files with 15 additions and 9 deletions

View File

@ -18,7 +18,8 @@ module Propellor.Property.Docker (
tweaked, tweaked,
Image, Image,
ContainerName, ContainerName,
Container(..), Container,
HasImage(..),
-- * Container configuration -- * Container configuration
dns, dns,
hostname, hostname,
@ -79,10 +80,13 @@ configured = prop `requires` installed
type ContainerName = String type ContainerName = String
-- | A docker container. -- | A docker container.
data Container = Container data Container = Container Image Host
{ containerImage :: Image
, containerHost :: Host class HasImage a where
} getImageName :: a -> Image
instance HasImage Container where
getImageName (Container i _) = i
instance PropAccum Container where instance PropAccum Container where
(Container i h) & p = Container i (h & p) (Container i h) & p = Container i (h & p)
@ -142,19 +146,21 @@ docked ctr@(Container _ h) =
] ]
-- | Build the image from a directory containing a Dockerfile. -- | Build the image from a directory containing a Dockerfile.
imageBuilt :: FilePath -> Image -> Property NoInfo imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo
imageBuilt directory image = describe built msg imageBuilt directory ctr = describe built msg
where where
msg = "docker image " ++ image ++ " built from " ++ directory msg = "docker image " ++ image ++ " built from " ++ directory
built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir
workDir p = p { cwd = Just directory } workDir p = p { cwd = Just directory }
image = getImageName ctr
-- | Pull the image from the standard Docker Hub registry. -- | Pull the image from the standard Docker Hub registry.
imagePulled :: Image -> Property NoInfo imagePulled :: HasImage c => c -> Property NoInfo
imagePulled image = describe pulled msg imagePulled ctr = describe pulled msg
where where
msg = "docker image " ++ image ++ " pulled" msg = "docker image " ++ image ++ " pulled"
pulled = Cmd.cmdProperty dockercmd ["pull", image] pulled = Cmd.cmdProperty dockercmd ["pull", image]
image = getImageName ctr
propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p' propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'