summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Docker.hs
diff options
context:
space:
mode:
authorAntoine Eiche2015-05-16 00:00:00 +0200
committerJoey Hess2015-05-16 13:26:43 -0400
commita781e43b227afcf094387057ade072d442b4ff6a (patch)
tree39993ed92c916f9f411a50e39d77a34df873f244 /src/Propellor/Property/Docker.hs
parent04d04fe9174563fef2276fc66235074ac2a3392f (diff)
Add HasImage type class which provides getImageName method to extract an image name. Image related functions now require a HasImage instance.
Diffstat (limited to 'src/Propellor/Property/Docker.hs')
-rw-r--r--src/Propellor/Property/Docker.hs24
1 files changed, 15 insertions, 9 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 745b5622..8e60c2a0 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -18,7 +18,8 @@ module Propellor.Property.Docker (
tweaked,
Image,
ContainerName,
- Container(..),
+ Container,
+ HasImage(..),
-- * Container configuration
dns,
hostname,
@@ -79,10 +80,13 @@ configured = prop `requires` installed
type ContainerName = String
-- | A docker container.
-data Container = Container
- { containerImage :: Image
- , containerHost :: Host
- }
+data Container = Container Image Host
+
+class HasImage a where
+ getImageName :: a -> Image
+
+instance HasImage Container where
+ getImageName (Container i _) = i
instance PropAccum Container where
(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.
-imageBuilt :: FilePath -> Image -> Property NoInfo
-imageBuilt directory image = describe built msg
+imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo
+imageBuilt directory ctr = describe built msg
where
msg = "docker image " ++ image ++ " built from " ++ directory
built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir
workDir p = p { cwd = Just directory }
+ image = getImageName ctr
-- | Pull the image from the standard Docker Hub registry.
-imagePulled :: Image -> Property NoInfo
-imagePulled image = describe pulled msg
+imagePulled :: HasImage c => c -> Property NoInfo
+imagePulled ctr = describe pulled msg
where
msg = "docker image " ++ image ++ " pulled"
pulled = Cmd.cmdProperty dockercmd ["pull", image]
+ image = getImageName ctr
propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'