@@ -41,7 +41,7 @@ module Docker.Client.Types (
4141 , defaultLogOpts
4242 , VolumePermission(..)
4343 , Bind(..)
44− , Volumes(..)
44+ , Volume(..)
4545 , Device(..)
4646 , ContainerName
4747 , VolumeFrom(..)
@@ -79,6 +79,10 @@ module Docker.Client.Types (
7979 , DeviceRate(..)
8080 , addPortBinding
8181 , addBind
82+ , setCmd
83+ , addLink
84+ , addVolume
85+ , addVolumeFrom
8286 ) where
8387
8488import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
@@ -595,7 +599,7 @@ defaultContainerConfig imageName = ContainerConfig {
595599 , stdinOnce=False
596600 , env=[]
597601 , cmd=[]
598− , volumes=Nothing
602+ , volumes=[]
599603 , workingDir=Nothing
600604 , entrypoint=Nothing
601605 , networkDisabled=Nothing
@@ -732,16 +736,24 @@ instance FromJSON VolumePermission where
732736-- docker run --name app -v \/opt\/data -it myapp:latest
733737-- docker run --name app2 --volumes-from app \/bin\/bash -c "ls -l \/opt\/data"
734738-- @
735−newtype Volumes = Volumes [FilePath] deriving (Eq, Show)
739+newtype Volume = Volume FilePath deriving (Eq, Show)
736740
737−instance FromJSON Volumes where
738− parseJSON (JSON.Object o) = return $ Volumes $ map T.unpack $ HM.keys o
739− parseJSON _ = fail "Volumes is not an object"
741+instance ToJSON Volume where
742+ toJSON (Volume fp) = JSON.Object $ HM.insert (T.pack fp) (JSON.Object HM.empty) HM.empty
743+
744+instance FromJSON Volume where
745+ parseJSON (JSON.Object o) = return $ Volume $ T.unpack $ head $ HM.keys o
746+ parseJSON _ = fail "Volume is not an object"
747+
748+instance ToJSON [Volume] where
749+ toJSON [] = JSON.Object HM.empty
750+ toJSON (v:vs) = JSON.Object $ foldl f HM.empty (v:vs)
751+ where f acc (Volume k) = HM.insert (T.pack k) (JSON.Object HM.empty) acc
752+
753+instance FromJSON [Volume] where
754+ parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
755+ parseJSON _ = fail "Volume is not an object"
740756
741−instance ToJSON Volumes where
742− toJSON (Volumes []) = JSON.Object HM.empty
743− toJSON (Volumes (v:vs)) = JSON.Object $ foldl f HM.empty (v:vs)
744− where f acc k = HM.insert (T.pack k) (JSON.Object HM.empty) acc
745757
746758data Bind = Bind { hostSrc :: Text
747759 , containerDest :: Text
@@ -933,6 +945,33 @@ addBind b c = c{hostConfig=hc{binds=obs <> [b]}}
933945 where hc = hostConfig c
934946 obs = binds $ hostConfig c
935947
948+-- | Helper function for adding a Command to and existing
949+-- CreateOpts record.
950+setCmd :: Text -> CreateOpts -> CreateOpts
951+setCmd ccmd c = c{containerConfig=cc{cmd=[ccmd]}}
952+ where cc = containerConfig c
953+
954+-- | Helper function for adding a "Link" to and existing
955+-- CreateOpts record.
956+addLink :: Link -> CreateOpts -> CreateOpts
957+addLink l c = c{hostConfig=hc{links=ols <> [l]}}
958+ where hc = hostConfig c
959+ ols = links $ hostConfig c
960+
961+-- | Helper function for adding a "Volume" to and existing
962+-- CreateOpts record.
963+addVolume :: Volume -> CreateOpts -> CreateOpts
964+addVolume v c = c{containerConfig=cc{volumes=oldvs <> [v]}}
965+ where cc = containerConfig c
966+ oldvs = volumes cc
967+
968+-- | Helper function for adding a "VolumeFrom" to and existing
969+-- CreateOpts record.
970+addVolumeFrom :: VolumeFrom -> CreateOpts -> CreateOpts
971+addVolumeFrom vf c = c{hostConfig=hc{volumesFrom=oldvfs <> [vf]}}
972+ where hc = hostConfig c
973+ oldvfs = volumesFrom hc
974+
936975-- | A convenience function that adds PortBindings to and exiting
937976-- "CreateOpts" record. Useful with 'defaultCreateOpts'
938977-- Example:
@@ -1295,7 +1334,7 @@ data ContainerConfig = ContainerConfig {
12951334 , cmd :: [Text]
12961335 -- , argsEscaped :: Bool -- Don't see this in 1.24
12971336 , image :: Text
1298− , volumes :: Maybe Volumes
1337+ , volumes :: [Volume]
12991338 , workingDir :: Maybe FilePath
13001339 , entrypoint :: Maybe Text -- Can be null?
13011340 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?