Revision e817723c src/Ganeti/OpParams.hs
b/src/Ganeti/OpParams.hs | ||
---|---|---|
255 | 255 |
, pEnabledDiskTemplates |
256 | 256 |
) where |
257 | 257 |
|
258 |
import Control.Monad (liftM) |
|
258 |
import Control.Monad (liftM, mplus)
|
|
259 | 259 |
import Text.JSON (JSON, JSValue(..), JSObject (..), readJSON, showJSON, |
260 | 260 |
fromJSString, toJSObject) |
261 | 261 |
import qualified Text.JSON |
... | ... | |
403 | 403 |
= SetParamsEmpty |
404 | 404 |
| SetParamsDeprecated (NonEmpty (DdmOldChanges, a)) |
405 | 405 |
| SetParamsNew (NonEmpty (DdmFull, Int, a)) |
406 |
| SetParamsNewName (NonEmpty (DdmFull, String, a)) |
|
406 | 407 |
deriving (Eq, Show) |
407 | 408 |
|
408 | 409 |
-- | Custom deserialiser for 'SetParamsMods'. |
409 | 410 |
readSetParams :: (JSON a) => JSValue -> Text.JSON.Result (SetParamsMods a) |
410 | 411 |
readSetParams (JSArray []) = return SetParamsEmpty |
411 | 412 |
readSetParams v = |
412 |
case readJSON v::Text.JSON.Result [(DdmOldChanges, JSValue)] of
|
|
413 |
Text.JSON.Ok _ -> liftM SetParamsDeprecated $ readJSON v
|
|
414 |
_ -> liftM SetParamsNew $ readJSON v
|
|
413 |
liftM SetParamsDeprecated (readJSON v)
|
|
414 |
`mplus` liftM SetParamsNew (readJSON v)
|
|
415 |
`mplus` liftM SetParamsNewName (readJSON v)
|
|
415 | 416 |
|
416 | 417 |
instance (JSON a) => JSON (SetParamsMods a) where |
417 | 418 |
showJSON SetParamsEmpty = showJSON () |
418 | 419 |
showJSON (SetParamsDeprecated v) = showJSON v |
419 | 420 |
showJSON (SetParamsNew v) = showJSON v |
421 |
showJSON (SetParamsNewName v) = showJSON v |
|
420 | 422 |
readJSON = readSetParams |
421 | 423 |
|
422 | 424 |
-- | Custom type for target_node parameter of OpBackupExport, which |
Also available in: Unified diff