Revision 84835174 htools/Ganeti/HTools/JSON.hs

b/htools/Ganeti/HTools/JSON.hs
35 35
  , asObjectList
36 36
  , tryFromObj
37 37
  , toArray
38
  , Container(..)
38 39
  )
39 40
  where
40 41

  
42
import Control.Arrow (second)
41 43
import Control.Monad (liftM)
42 44
import Data.Maybe (fromMaybe)
45
import qualified Data.Map as Map
43 46
import Text.Printf (printf)
44 47

  
45 48
import qualified Text.JSON as J
......
132 135
toArray :: (Monad m) => J.JSValue -> m [J.JSValue]
133 136
toArray (J.JSArray arr) = return arr
134 137
toArray o = fail $ "Invalid input, expected array but got " ++ show o
138

  
139
-- * Container type (special type for JSON serialisation)
140

  
141
-- | The container type, a wrapper over Data.Map
142
newtype Container a = Container { fromContainer :: Map.Map String a }
143
  deriving (Show, Read, Eq)
144

  
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)
152

  
153
-- | Container dumper.
154
showContainer :: (J.JSON a) => Container a -> J.JSValue
155
showContainer =
156
  J.makeObj . map (second J.showJSON) . Map.toList . fromContainer
157

  
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 "
162
               ++ show v

Also available in: Unified diff