code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/JSON.hs

   1 {-| JSON utility functions. -}
   2
   3 {-
   4
   5 Copyright (C) 2009, 2010, 2011 Google Inc.
   6
   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.
  11
  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.
  16
  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
  20 02110-1301, USA.
  21
  22 -}
  23
  24 module Ganeti.HTools.JSON
  25     ( fromJResult
  26     , readEitherString
  27     , JSRecord
  28     , loadJSArray
  29     , fromObj
  30     , maybeFromObj
  31     , fromObjWithDefault
  32     , fromJVal
  33     , asJSObject
  34     , asObjectList
  35     )
  36     where
  37
  38 import Control.Monad (liftM)
  39 import Data.Maybe (fromMaybe)
  40 import Text.Printf (printf)
  41
  42 import qualified Text.JSON as J
  43
  44 -- * JSON-related functions
  45
  46 -- | A type alias for the list-based representation of J.JSObject.
  47 type JSRecord = [(String, J.JSValue)]
  48
  49 -- | Converts a JSON Result into a monadic value.
  50 fromJResult :: Monad m => String -> J.Result a -> m a
  51 fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
  52 fromJResult _ (J.Ok x) = return x
  53
  54 -- | Tries to read a string from a JSON value.
  55 --
  56 -- In case the value was not a string, we fail the read (in the
  57 -- context of the current monad.
  58 readEitherString :: (Monad m) => J.JSValue -> m String
  59 readEitherString v =
  60     case v of
  61       J.JSString s -> return $ J.fromJSString s
  62       _ -> fail "Wrong JSON type"
  63
  64 -- | Converts a JSON message into an array of JSON objects.
  65 loadJSArray :: (Monad m)
  66                => String -- ^ Operation description (for error reporting)
  67                -> String -- ^ Input message
  68                -> m [J.JSObject J.JSValue]
  69 loadJSArray s = fromJResult s . J.decodeStrict
  70
  71 -- | Reads the value of a key in a JSON object.
  72 fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
  73 fromObj o k =
  74     case lookup k o of
  75       Nothing -> fail $ printf "key '%s' not found, object contains only %s"
  76                  k (show (map fst o))
  77       Just val -> fromKeyValue k val
  78
  79 -- | Reads the value of an optional key in a JSON object.
  80 maybeFromObj :: (J.JSON a, Monad m) =>
  81                 JSRecord -> String -> m (Maybe a)
  82 maybeFromObj o k =
  83     case lookup k o of
  84       Nothing -> return Nothing
  85       Just val -> liftM Just (fromKeyValue k val)
  86
  87 -- | Reads the value of a key in a JSON object with a default if missing.
  88 fromObjWithDefault :: (J.JSON a, Monad m) =>
  89                       JSRecord -> String -> a -> m a
  90 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
  91
  92 -- | Reads a JValue, that originated from an object key.
  93 fromKeyValue :: (J.JSON a, Monad m)
  94               => String     -- ^ The key name
  95               -> J.JSValue  -- ^ The value to read
  96               -> m a
  97 fromKeyValue k val =
  98   fromJResult (printf "key '%s', value '%s'" k (show val)) (J.readJSON val)
  99
 100 -- | Small wrapper over readJSON.
 101 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
 102 fromJVal v =
 103     case J.readJSON v of
 104       J.Error s -> fail ("Cannot convert value '" ++ show v ++
 105                          "', error: " ++ s)
 106       J.Ok x -> return x
 107
 108 -- | Converts a JSON value into a JSON object.
 109 asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
 110 asJSObject (J.JSObject a) = return a
 111 asJSObject _ = fail "not an object"
 112
 113 -- | Coneverts a list of JSON values into a list of JSON objects.
 114 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
 115 asObjectList = mapM asJSObject