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
42 import Control.Arrow (second)
43 import Control.Monad (liftM)
44 import Data.Maybe (fromMaybe)
45 import qualified Data.Map as Map
46 import Text.Printf (printf)
48 import qualified Text.JSON as J
50 import Ganeti.BasicTypes
52 -- * JSON-related functions
54 -- | A type alias for the list-based representation of J.JSObject.
55 type JSRecord = [(String, J.JSValue)]
57 -- | Converts a JSON Result into a monadic value.
58 fromJResult :: Monad m => String -> J.Result a -> m a
59 fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
60 fromJResult _ (J.Ok x) = return x
62 -- | Tries to read a string from a JSON value.
64 -- In case the value was not a string, we fail the read (in the
65 -- context of the current monad.
66 readEitherString :: (Monad m) => J.JSValue -> m String
69 J.JSString s -> return $ J.fromJSString s
70 _ -> fail "Wrong JSON type"
72 -- | Converts a JSON message into an array of JSON objects.
73 loadJSArray :: (Monad m)
74 => String -- ^ Operation description (for error reporting)
75 -> String -- ^ Input message
76 -> m [J.JSObject J.JSValue]
77 loadJSArray s = fromJResult s . J.decodeStrict
79 -- | Reads the value of a key in a JSON object.
80 fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
83 Nothing -> fail $ printf "key '%s' not found, object contains only %s"
85 Just val -> fromKeyValue k val
87 -- | Reads the value of an optional key in a JSON object.
88 maybeFromObj :: (J.JSON a, Monad m) =>
89 JSRecord -> String -> m (Maybe a)
92 Nothing -> return Nothing
93 Just val -> liftM Just (fromKeyValue k val)
95 -- | Reads the value of a key in a JSON object with a default if missing.
96 fromObjWithDefault :: (J.JSON a, Monad m) =>
97 JSRecord -> String -> a -> m a
98 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
100 -- | Reads a JValue, that originated from an object key.
101 fromKeyValue :: (J.JSON a, Monad m)
102 => String -- ^ The key name
103 -> J.JSValue -- ^ The value to read
106 fromJResult (printf "key '%s'" k) (J.readJSON val)
108 -- | Small wrapper over readJSON.
109 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
112 J.Error s -> fail ("Cannot convert value '" ++ show v ++
116 -- | Converts a JSON value into a JSON object.
117 asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
118 asJSObject (J.JSObject a) = return a
119 asJSObject _ = fail "not an object"
121 -- | Coneverts a list of JSON values into a list of JSON objects.
122 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
123 asObjectList = mapM asJSObject
125 -- | Try to extract a key from a object with better error reporting
127 tryFromObj :: (J.JSON a) =>
128 String -- ^ Textual "owner" in error messages
129 -> JSRecord -- ^ The object array
130 -> String -- ^ The desired key from the object
132 tryFromObj t o = annotateResult t . fromObj o
134 -- | Ensure a given JSValue is actually a JSArray.
135 toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
136 toArray (J.JSArray arr) = return arr
137 toArray o = fail $ "Invalid input, expected array but got " ++ show o
139 -- * Container type (special type for JSON serialisation)
141 -- | The container type, a wrapper over Data.Map
142 newtype Container a = Container { fromContainer :: Map.Map String a }
143 deriving (Show, Read, Eq)
145 -- | Container loader.
146 readContainer :: (Monad m, J.JSON a) =>
147 J.JSObject J.JSValue -> m (Container a)
148 readContainer obj = do
149 let kjvlist = J.fromJSObject obj
150 kalist <- mapM (\(k, v) -> fromKeyValue k v >>= \a -> return (k, a)) kjvlist
151 return $ Container (Map.fromList kalist)
153 -- | Container dumper.
154 showContainer :: (J.JSON a) => Container a -> J.JSValue
156 J.makeObj . map (second J.showJSON) . Map.toList . fromContainer
158 instance (J.JSON a) => J.JSON (Container a) where
159 showJSON = showContainer
160 readJSON (J.JSObject o) = readContainer o
161 readJSON v = fail $ "Failed to load container, expected object but got "