1 {-| JSON utility functions. -}
5 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful, but
13 WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24 module Ganeti.HTools.JSON
41 import Control.Monad (liftM)
42 import Data.Maybe (fromMaybe)
43 import Text.Printf (printf)
45 import qualified Text.JSON as J
47 import Ganeti.BasicTypes
49 -- * JSON-related functions
51 -- | A type alias for the list-based representation of J.JSObject.
52 type JSRecord = [(String, J.JSValue)]
54 -- | Converts a JSON Result into a monadic value.
55 fromJResult :: Monad m => String -> J.Result a -> m a
56 fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
57 fromJResult _ (J.Ok x) = return x
59 -- | Tries to read a string from a JSON value.
61 -- In case the value was not a string, we fail the read (in the
62 -- context of the current monad.
63 readEitherString :: (Monad m) => J.JSValue -> m String
66 J.JSString s -> return $ J.fromJSString s
67 _ -> fail "Wrong JSON type"
69 -- | Converts a JSON message into an array of JSON objects.
70 loadJSArray :: (Monad m)
71 => String -- ^ Operation description (for error reporting)
72 -> String -- ^ Input message
73 -> m [J.JSObject J.JSValue]
74 loadJSArray s = fromJResult s . J.decodeStrict
76 -- | Reads the value of a key in a JSON object.
77 fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
80 Nothing -> fail $ printf "key '%s' not found, object contains only %s"
82 Just val -> fromKeyValue k val
84 -- | Reads the value of an optional key in a JSON object.
85 maybeFromObj :: (J.JSON a, Monad m) =>
86 JSRecord -> String -> m (Maybe a)
89 Nothing -> return Nothing
90 Just val -> liftM Just (fromKeyValue k val)
92 -- | Reads the value of a key in a JSON object with a default if missing.
93 fromObjWithDefault :: (J.JSON a, Monad m) =>
94 JSRecord -> String -> a -> m a
95 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
97 -- | Reads a JValue, that originated from an object key.
98 fromKeyValue :: (J.JSON a, Monad m)
99 => String -- ^ The key name
100 -> J.JSValue -- ^ The value to read
103 fromJResult (printf "key '%s'" k) (J.readJSON val)
105 -- | Small wrapper over readJSON.
106 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
109 J.Error s -> fail ("Cannot convert value '" ++ show v ++
113 -- | Converts a JSON value into a JSON object.
114 asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
115 asJSObject (J.JSObject a) = return a
116 asJSObject _ = fail "not an object"
118 -- | Coneverts a list of JSON values into a list of JSON objects.
119 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
120 asObjectList = mapM asJSObject
122 -- | Try to extract a key from a object with better error reporting
124 tryFromObj :: (J.JSON a) =>
125 String -- ^ Textual "owner" in error messages
126 -> JSRecord -- ^ The object array
127 -> String -- ^ The desired key from the object
129 tryFromObj t o = annotateResult t . fromObj o
131 -- | Ensure a given JSValue is actually a JSArray.
132 toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
133 toArray (J.JSArray arr) = return arr
134 toArray o = fail $ "Invalid input, expected array but got " ++ show o