on master help sign in
Standardizes a few jsonifications
e81de13Deni Bertovic
src/Docker/Client/Types.hs+32−15
@@ -541,9 +541,10 @@ data Label = Label Name Value deriving (Eq, Show)
541-- If there are multiple lables with the same Name in the list
541-- If there are multiple lables with the same Name in the list
542-- then the last one wins.
542-- then the last one wins.
543instance ToJSON [Label] where
543instance ToJSON [Label] where
544− toJSON [] = JSON.Object HM.empty
544+ toJSON [] = emptyJsonObject
545− toJSON (l:ls) = JSON.Object $ foldl f HM.empty (l:ls)
545+ toJSON (l:ls) = toJsonKeyVal (l:ls) key val
546− where f acc (Label n v) = HM.insert n (toJSON v) acc
546+ where key (Label k _) = T.unpack k
547+ val (Label _ v) = v
547
548
548instance FromJSON [Label] where
549instance FromJSON [Label] where
549 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
550 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
@@ -763,9 +764,9 @@ instance FromJSON VolumePermission where
763newtype Volume = Volume FilePath deriving (Eq, Show)
764newtype Volume = Volume FilePath deriving (Eq, Show)
764
765
765instance ToJSON [Volume] where
766instance ToJSON [Volume] where
766− toJSON [] = JSON.Object HM.empty
767+ toJSON [] = emptyJsonObject
767− toJSON (v:vs) = JSON.Object $ foldl f HM.empty (v:vs)
768+ toJSON (v:vs) = toJsonKey (v:vs) getKey
768− where f acc (Volume k) = HM.insert (T.pack k) (JSON.Object HM.empty) acc
769+ where getKey (Volume v) = v
769
770
770instance FromJSON [Volume] where
771instance FromJSON [Volume] where
771 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
772 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
@@ -1017,11 +1018,10 @@ instance FromJSON [PortBinding] where
1017 parseJSON _ = fail "PortBindings is not an object"
1018 parseJSON _ = fail "PortBindings is not an object"
1018
1019
1019instance ToJSON [PortBinding] where
1020instance ToJSON [PortBinding] where
1020− toJSON [] = JSON.Object HM.empty
1021+ toJSON [] = emptyJsonObject
1021− toJSON (p:ps) = JSON.Object $ foldl f HM.empty (p:ps)
1022+ toJSON (p:ps) = toJsonKeyVal (p:ps) key val
1022− where mKey p = portAndType2Text (containerPort p) (portType p)
1023+ where key p = T.unpack $ portAndType2Text (containerPort p) (portType p)
1023− mVal p = toJSON $ hostPorts p
1024+ val p = hostPorts p
1024− f acc p = HM.insert (mKey p) (mVal p) acc
1025
1025
1026data HostPort = HostPort {
1026data HostPort = HostPort {
1027 hostIp :: Text
1027 hostIp :: Text
@@ -1326,10 +1326,10 @@ instance FromJSON [ExposedPort] where
1326 parseJSON _ = fail "ExposedPorts is not an object"
1326 parseJSON _ = fail "ExposedPorts is not an object"
1327
1327
1328instance ToJSON [ExposedPort] where
1328instance ToJSON [ExposedPort] where
1329− toJSON [] = JSON.Object HM.empty
1329+ toJSON [] = emptyJsonObject
1330− toJSON (p:ps) = JSON.Object $ foldl f HM.empty (p:ps)
1330+ toJSON (p:ps) = toJsonKey (p:ps) key
1331− where f acc (ExposedPort p t) = HM.insert (exposify p t) (JSON.Object HM.empty) acc
1331+ where key (ExposedPort p t) = show p <> slash <> show t
1332− exposify p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
1332+ slash = T.unpack "/"
1333
1333
1334data ContainerConfig = ContainerConfig {
1334data ContainerConfig = ContainerConfig {
1335 hostname :: Maybe Text
1335 hostname :: Maybe Text
@@ -1397,3 +1397,20 @@ parseIntegerText t = case readMaybe $ T.unpack t of
1397 fail "Could not parse Integer"
1397 fail "Could not parse Integer"
1398 Just i ->
1398 Just i ->
1399 return i
1399 return i
1400+
1401+-- | Helper function for converting a data type [a] to a json dictionary
1402+-- like so {"something": {}, "something2": {}}
1403+toJsonKey :: Foldable t => t a -> (a -> String) -> JSON.Value
1404+toJsonKey vs getKey = JSON.Object $ foldl f HM.empty vs
1405+ where f acc x = HM.insert (T.pack $ getKey x) (JSON.Object HM.empty) acc
1406+
1407+-- | Helper function for converting a data type [a] to a json dictionary
1408+-- like so {"something": "val1", "something2": "val2"}
1409+toJsonKeyVal :: (Foldable t, JSON.ToJSON r) => t a -> (a -> String) -> (a -> r) -> JSON.Value
1410+toJsonKeyVal vs getKey getVal = JSON.Object $ foldl f HM.empty vs
1411+ where f acc x = HM.insert (T.pack $ getKey x) (toJSON $ getVal x) acc
1412+
1413+-- | Helper function that return an empty dictionary "{}"
1414+emptyJsonObject :: JSON.Value
1415+emptyJsonObject = JSON.Object HM.empty
1416+