diff --git a/htest/Test/Ganeti/THH.hs b/htest/Test/Ganeti/THH.hs index 90f683c03ed421db548c80c42e5f1144d2a0df4b..5d0c9d79d7f7d8d1e283a16a9e0067ffa1675770 100644 --- a/htest/Test/Ganeti/THH.hs +++ b/htest/Test/Ganeti/THH.hs @@ -34,7 +34,6 @@ import Test.QuickCheck import Text.JSON import Ganeti.THH -import Ganeti.JSON import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon diff --git a/htools/Ganeti/Confd/Types.hs b/htools/Ganeti/Confd/Types.hs index 4ac4eaeade2659272a52e169baf9d51269ae2c05..44dbd030b211ebb8e47d4cbd6cd703113cb46247 100644 --- a/htools/Ganeti/Confd/Types.hs +++ b/htools/Ganeti/Confd/Types.hs @@ -50,7 +50,6 @@ import Text.JSON import qualified Ganeti.Constants as C import Ganeti.THH -import Ganeti.JSON {- Note that we re-export as is from Constants the following simple items: diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs index 7efda992e24f92941d2e82d6fdddf73fbfab237c..e0fdf5428ede32f5f6844f66f58bcbf0bfdc1c96 100644 --- a/htools/Ganeti/HTools/Types.hs +++ b/htools/Ganeti/HTools/Types.hs @@ -75,12 +75,10 @@ module Ganeti.HTools.Types ) where import qualified Data.Map as M -import Text.JSON (makeObj, readJSON, showJSON) import qualified Ganeti.Constants as C import qualified Ganeti.THH as THH import Ganeti.BasicTypes -import Ganeti.JSON -- | The instance index type. type Idx = Int diff --git a/htools/Ganeti/JSON.hs b/htools/Ganeti/JSON.hs index 178915a8c9012d9efac30f5f14ff77e613055b23..1480140e8b552ebdd1c960e89d116eb0510cb7c4 100644 --- a/htools/Ganeti/JSON.hs +++ b/htools/Ganeti/JSON.hs @@ -50,6 +50,10 @@ import Text.Printf (printf) import qualified Text.JSON as J import Text.JSON.Pretty (pp_value) +-- Note: this module should not import any Ganeti-specific modules +-- beside BasicTypes, since it's used in THH which is used itself to +-- build many other modules. + import Ganeti.BasicTypes -- * JSON-related functions diff --git a/htools/Ganeti/Jobs.hs b/htools/Ganeti/Jobs.hs index 405f833b815a385ddc7e2d67b812c45c0c8d6a30..04ac18088d32d8a2eeee19eaeb68c617e6780159 100644 --- a/htools/Ganeti/Jobs.hs +++ b/htools/Ganeti/Jobs.hs @@ -30,8 +30,6 @@ module Ganeti.Jobs , JobStatus(..) ) where -import Text.JSON (readJSON, showJSON, JSON) - import qualified Ganeti.Constants as C import qualified Ganeti.THH as THH diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index dfc64803821bb4ca43130bd5ab8df070702b5dfc..71dd349d1b7f20210b6bd64f0618bcff04a98ae7 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -95,7 +95,7 @@ import Data.List (foldl') import Data.Maybe import qualified Data.Map as Map import qualified Data.Set as Set -import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..)) +import Text.JSON (showJSON, readJSON, JSON, JSValue(..)) import qualified Text.JSON as J import qualified Ganeti.Constants as C diff --git a/htools/Ganeti/OpCodes.hs b/htools/Ganeti/OpCodes.hs index e2c91810fe49eb1da648a18fe2741d2777869a24..c4f75f56f9c5645b4dadb5a448bc6c8c2885736c 100644 --- a/htools/Ganeti/OpCodes.hs +++ b/htools/Ganeti/OpCodes.hs @@ -39,7 +39,7 @@ module Ganeti.OpCodes , allOpIDs ) where -import Text.JSON (readJSON, showJSON, makeObj, JSON, JSValue(..), fromJSString) +import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString) import Text.JSON.Pretty (pp_value) import qualified Ganeti.Constants as C diff --git a/htools/Ganeti/Query/Language.hs b/htools/Ganeti/Query/Language.hs index 4128bcd950a8ea942ace8cb7eff521a4f9320e6b..bb2c07ea00b54ada190a06a74445e12fb662fb27 100644 --- a/htools/Ganeti/Query/Language.hs +++ b/htools/Ganeti/Query/Language.hs @@ -63,7 +63,6 @@ import qualified Text.Regex.PCRE as PCRE import qualified Ganeti.Constants as C import Ganeti.THH -import Ganeti.JSON -- * THH declarations, that require ordering. diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs index 547cb2d6075851fc0a78c229dfd1eeee6e942c4a..f328b0e0c8524bf331892154c1fb8c5558bfbe09 100644 --- a/htools/Ganeti/Rpc.hs +++ b/htools/Ganeti/Rpc.hs @@ -73,7 +73,6 @@ module Ganeti.Rpc import Control.Arrow (second) import qualified Text.JSON as J import Text.JSON.Pretty (pp_value) -import Text.JSON (makeObj) #ifndef NO_CURL import Network.Curl @@ -84,7 +83,6 @@ import qualified Ganeti.Constants as C import Ganeti.Objects import Ganeti.THH import Ganeti.Compat -import Ganeti.JSON -- * Base RPC functionality and types diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs index 489413d78d31701cacc4d832858ef345b5953cd4..338d40cc1a7011eb72bdfb946f9eb805fcb3d7c8 100644 --- a/htools/Ganeti/THH.hs +++ b/htools/Ganeti/THH.hs @@ -69,6 +69,8 @@ import Language.Haskell.TH import qualified Text.JSON as JSON import Text.JSON.Pretty (pp_value) +import Ganeti.JSON + -- * Exported types -- | Class of objects that can be converted to 'JSObject' @@ -239,7 +241,15 @@ varNameE = varE . mkName -- | showJSON as an expression, for reuse. showJSONE :: Q Exp -showJSONE = varNameE "showJSON" +showJSONE = varE 'JSON.showJSON + +-- | makeObj as an expression, for reuse. +makeObjE :: Q Exp +makeObjE = varE 'JSON.makeObj + +-- | fromObj (Ganeti specific) as an expression, for reuse. +fromObjE :: Q Exp +fromObjE = varE 'fromObj -- | ToRaw function name. toRawName :: String -> Name @@ -394,7 +404,7 @@ declareSADT = declareADT ''String genShowJSON :: String -> Q Dec genShowJSON name = do body <- [| JSON.showJSON . $(varE (toRawName name)) |] - return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []] + return $ FunD 'JSON.showJSON [Clause [] (NormalB body) []] -- | Creates the readJSON member of a JSON instance declaration. -- @@ -417,7 +427,7 @@ genReadJSON name = do $(stringE name) ++ ": " ++ e ++ " from " ++ show $(varE s) |] - return $ FunD (mkName "readJSON") [Clause [VarP s] (NormalB body) []] + return $ FunD 'JSON.readJSON [Clause [VarP s] (NormalB body) []] -- | Generates a JSON instance for a given type. -- @@ -546,7 +556,7 @@ saveConstructor sname fields = do JSON.showJSON $(stringE . deCamelCase $ sname) )] |] flist = listE (opid:felems) -- and finally convert all this to a json object - flist' = [| $(varNameE "makeObj") (concat $flist) |] + flist' = [| $makeObjE (concat $flist) |] clause [pat] (normalB flist') [] -- | Generates the main save opcode function. @@ -583,8 +593,7 @@ genLoadOpCode opdefs = do opid = mkName "op_id" st1 <- bindS (varP objname) [| liftM JSON.fromJSObject (JSON.readJSON $(varE arg1)) |] - st2 <- bindS (varP opid) [| $(varNameE "fromObj") - $(varE objname) $(stringE "OP_ID") |] + st2 <- bindS (varP opid) [| $fromObjE $(varE objname) $(stringE "OP_ID") |] -- the match results (per-constructor blocks) mexps <- mapM (uncurry loadConstructor) opdefs fails <- [| fail $ "Unknown opcode " ++ $(varE opid) |] @@ -706,7 +715,7 @@ genSaveObject save_fn sname fields = do tdlist = [| concat $flist |] iname = mkName "i" tclause <- clause [pat] (normalB tdlist) [] - cclause <- [| $(varNameE "makeObj") . $(varE tdname) |] + cclause <- [| $makeObjE . $(varE tdname) |] let fname = mkName ("save" ++ sname) sigt <- [t| $(conT name) -> JSON.JSValue |] return [SigD tdname tdsigt, FunD tdname [tclause], @@ -741,7 +750,7 @@ saveObjectField fvar field = objectShowJSON :: String -> Q Dec objectShowJSON name = do body <- [| JSON.showJSON . $(varE . mkName $ "save" ++ name) |] - return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []] + return $ FunD 'JSON.showJSON [Clause [] (NormalB body) []] -- | Generates the load object functionality. genLoadObject :: (Field -> Q (Name, Stmt)) @@ -775,12 +784,12 @@ loadObjectField field = do -- we treat both optional types the same, since -- 'maybeFromObj' can deal with both missing and null values -- appropriately (the same) - then [| $(varNameE "maybeFromObj") $objvar $objfield |] + then [| $(varE 'maybeFromObj) $objvar $objfield |] else case fieldDefault field of Just defv -> - [| $(varNameE "fromObjWithDefault") $objvar + [| $(varE 'fromObjWithDefault) $objvar $objfield $defv |] - Nothing -> [| $(varNameE "fromObj") $objvar $objfield |] + Nothing -> [| $fromObjE $objvar $objfield |] bexp <- loadFn field loadexp objvar return (fvar, BindS (VarP fvar) bexp) @@ -795,7 +804,7 @@ objectReadJSON name = do JSON.Error $ "Can't parse value for type " ++ $(stringE name) ++ ": " ++ e |] - return $ FunD (mkName "readJSON") [Clause [VarP s] (NormalB body) []] + return $ FunD 'JSON.readJSON [Clause [VarP s] (NormalB body) []] -- * Inheritable parameter tables implementation @@ -886,7 +895,7 @@ loadPParamField field = do -- these are used in all patterns below let objvar = varNameE "o" objfield = stringE name - loadexp = [| $(varNameE "maybeFromObj") $objvar $objfield |] + loadexp = [| $(varE 'maybeFromObj) $objvar $objfield |] bexp <- loadFn field loadexp objvar return (fvar, BindS (VarP fvar) bexp) @@ -894,7 +903,7 @@ loadPParamField field = do buildFromMaybe :: String -> Q Dec buildFromMaybe fname = valD (varP (mkName $ "n_" ++ fname)) - (normalB [| $(varNameE "fromMaybe") + (normalB [| $(varE 'fromMaybe) $(varNameE $ "f_" ++ fname) $(varNameE $ "p_" ++ fname) |]) []