From: Iustin Pop <iustin@google.com>
Date: Thu, 16 Dec 2010 13:35:28 +0000 (+0100)
Subject: Implement a JSON instance for AllocPolicy
X-Git-Tag: htools-v0.3.0~51
X-Git-Url: https://code.grnet.gr/git/ganeti-local/commitdiff_plain/b2ba46699b54f3d4d740db5145274f4f59fe7cfd

Implement a JSON instance for AllocPolicy

This will allow reading this attribute via the Rapi/Luxi backends.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>
---

diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index ba3b70d..c86ce1e 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -32,6 +32,8 @@ module Ganeti.HTools.Types
     , Weight
     , GroupID
     , AllocPolicy(..)
+    , apolFromString
+    , apolToString
     , RSpec(..)
     , DynUtil(..)
     , zeroUtil
@@ -60,6 +62,7 @@ module Ganeti.HTools.Types
     ) where
 
 import qualified Data.Map as M
+import qualified Text.JSON as JSON
 
 -- | The instance index type.
 type Idx = Int
@@ -88,6 +91,28 @@ data AllocPolicy = AllocPreferred
                  | AllocUnallocable
                    deriving (Show, Eq)
 
+-- | Convert a string to an alloc policy
+apolFromString :: (Monad m) => String -> m AllocPolicy
+apolFromString s =
+    case s of
+      "preferred"   -> return AllocPreferred
+      "last_resort" -> return AllocLastResort
+      "unallocable" -> return AllocUnallocable
+      o -> fail $ "Invalid alloc policy mode: " ++ o
+
+-- | Convert an alloc policy to the Ganeti string equivalent
+apolToString :: AllocPolicy -> String
+apolToString AllocPreferred   = "preferred"
+apolToString AllocLastResort  = "last_resort"
+apolToString AllocUnallocable = "unallocable"
+
+instance JSON.JSON AllocPolicy where
+    showJSON = JSON.showJSON . apolToString
+    readJSON s = case JSON.readJSON s of
+                   JSON.Ok s' -> apolFromString s'
+                   JSON.Error e -> JSON.Error $
+                                   "Can't parse alloc_policy: " ++ e
+
 -- | The resource spec type.
 data RSpec = RSpec
     { rspecCpu  :: Int  -- ^ Requested VCPUs