1 {-| JSON utility functions. -}
5 Copyright (C) 2009, 2010, 2011 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
40 import Control.Monad (liftM)
41 import Data.Maybe (fromMaybe)
42 import Text.Printf (printf)
44 import qualified Text.JSON as J
46 import Ganeti.BasicTypes
48 -- * JSON-related functions
50 -- | A type alias for the list-based representation of J.JSObject.
51 type JSRecord = [(String, J.JSValue)]
53 -- | Converts a JSON Result into a monadic value.
54 fromJResult :: Monad m => String -> J.Result a -> m a
55 fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
56 fromJResult _ (J.Ok x) = return x
58 -- | Tries to read a string from a JSON value.
60 -- In case the value was not a string, we fail the read (in the
61 -- context of the current monad.
62 readEitherString :: (Monad m) => J.JSValue -> m String
65 J.JSString s -> return $ J.fromJSString s
66 _ -> fail "Wrong JSON type"
68 -- | Converts a JSON message into an array of JSON objects.
69 loadJSArray :: (Monad m)
70 => String -- ^ Operation description (for error reporting)
71 -> String -- ^ Input message
72 -> m [J.JSObject J.JSValue]
73 loadJSArray s = fromJResult s . J.decodeStrict
75 -- | Reads the value of a key in a JSON object.
76 fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
79 Nothing -> fail $ printf "key '%s' not found, object contains only %s"
81 Just val -> fromKeyValue k val
83 -- | Reads the value of an optional key in a JSON object.
84 maybeFromObj :: (J.JSON a, Monad m) =>
85 JSRecord -> String -> m (Maybe a)
88 Nothing -> return Nothing
89 Just val -> liftM Just (fromKeyValue k val)
91 -- | Reads the value of a key in a JSON object with a default if missing.
92 fromObjWithDefault :: (J.JSON a, Monad m) =>
93 JSRecord -> String -> a -> m a
94 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
96 -- | Reads a JValue, that originated from an object key.
97 fromKeyValue :: (J.JSON a, Monad m)
98 => String -- ^ The key name
99 -> J.JSValue -- ^ The value to read
102 fromJResult (printf "key '%s'" k) (J.readJSON val)
104 -- | Small wrapper over readJSON.
105 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
108 J.Error s -> fail ("Cannot convert value '" ++ show v ++
112 -- | Converts a JSON value into a JSON object.
113 asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
114 asJSObject (J.JSObject a) = return a
115 asJSObject _ = fail "not an object"
117 -- | Coneverts a list of JSON values into a list of JSON objects.
118 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
119 asObjectList = mapM asJSObject
121 -- | Try to extract a key from a object with better error reporting
123 tryFromObj :: (J.JSON a) =>
124 String -- ^ Textual "owner" in error messages
125 -> JSRecord -- ^ The object array
126 -> String -- ^ The desired key from the object
128 tryFromObj t o = annotateResult t . fromObj o