Add a server-side Luxi implementation

[ganeti-local] / htools / Ganeti / HTools / JSON.hs

diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs
index 185201f..684711f 100644 (file)
--- a/htools/Ganeti/HTools/JSON.hs
+++ b/htools/Ganeti/HTools/JSON.hs
@@ -2,7 +2,7 @@
 
 {-
 
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -33,6 +33,8 @@ module Ganeti.HTools.JSON
   , fromJVal
   , asJSObject
   , asObjectList
+  , tryFromObj
+  , toArray
   )
   where
 
@@ -42,6 +44,8 @@ import Text.Printf (printf)
 
 import qualified Text.JSON as J
 
+import Ganeti.BasicTypes
+
 -- * JSON-related functions
 
 -- | A type alias for the list-based representation of J.JSObject.
@@ -114,3 +118,17 @@ asJSObject _ = fail "not an object"
 -- | Coneverts a list of JSON values into a list of JSON objects.
 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
 asObjectList = mapM asJSObject
+
+-- | Try to extract a key from a object with better error reporting
+-- than fromObj.
+tryFromObj :: (J.JSON a) =>
+              String     -- ^ Textual "owner" in error messages
+           -> JSRecord   -- ^ The object array
+           -> String     -- ^ The desired key from the object
+           -> Result a
+tryFromObj t o = annotateResult t . fromObj o
+
+-- | Ensure a given JSValue is actually a JSArray.
+toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
+toArray (J.JSArray arr) = return arr
+toArray o = fail $ "Invalid input, expected array but got " ++ show o