.. and use them in Ganeti.THH
Signed-off-by: Petr Pudlak <[email protected]>
---
src/Ganeti/JSON.hs | 14 ++++++++++++++
src/Ganeti/THH.hs | 4 ++--
2 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/src/Ganeti/JSON.hs b/src/Ganeti/JSON.hs
index a9f6f1e..d2f4689 100644
--- a/src/Ganeti/JSON.hs
+++ b/src/Ganeti/JSON.hs
@@ -51,6 +51,8 @@ module Ganeti.JSON
, lookupContainer
, readContainer
, DictObject(..)
+ , showJSONtoDict
+ , readJSONfromDict
, ArrayObject(..)
, HasStringRepr(..)
, GenericContainer(..)
@@ -356,6 +358,18 @@ class DictObject a where
toDict :: a -> [(String, J.JSValue)]
fromDict :: [(String, J.JSValue)] -> J.Result a
+-- | A default implementation of 'showJSON' using 'toDict'.
+showJSONtoDict :: (DictObject a) => a -> J.JSValue
+showJSONtoDict = J.makeObj . toDict
+
+-- | A default implementation of 'readJSON' using 'fromDict'.
+-- Checks that the input value is a JSON object and
+-- converts it using 'fromDict'.
+-- Also checks the input contains only the used keys returned by 'fromDict'.
+readJSONfromDict :: (DictObject a)
+ => J.JSValue -> J.Result a
+readJSONfromDict = fromDict <=< liftM J.fromJSObject . J.readJSON
+
-- | Class of objects that can be converted from and to @[JSValue]@ with
-- a fixed length and order.
class ArrayObject a where
diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs
index 17042a9..3dab68a 100644
--- a/src/Ganeti/THH.hs
+++ b/src/Ganeti/THH.hs
@@ -1007,7 +1007,7 @@ genSaveObject :: String -> Q [Dec]
genSaveObject sname = do
let fname = mkName ("save" ++ sname)
sigt <- [t| $(conT $ mkName sname) -> JSON.JSValue |]
- cclause <- [| $makeObjE . $(varE $ 'toDict) |]
+ cclause <- [| showJSONtoDict |]
return [SigD fname sigt, ValD (VarP fname) (NormalB cclause) []]
-- | Generates the code for saving an object's field, handling the
@@ -1043,7 +1043,7 @@ genLoadObject :: String -> Q (Dec, Dec)
genLoadObject sname = do
let fname = mkName $ "load" ++ sname
sigt <- [t| JSON.JSValue -> JSON.Result $(conT $ mkName sname) |]
- cclause <- [| fromDict <=< liftM JSON.fromJSObject . JSON.readJSON |]
+ cclause <- [| readJSONfromDict |]
return $ (SigD fname sigt,
FunD fname [Clause [] (NormalB cclause) []])
--
2.0.0.526.g5318336
