Synnefo » snf-ganeti

import Text.JSON

import Ganeti.THH

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import qualified Ganeti.Constants as C

import Ganeti.THH

{-

   Note that we re-export as is from Constants the following simple items:

  ) where

import qualified Data.Map as M

import qualified Ganeti.Constants as C

import qualified Ganeti.THH as THH

import Ganeti.BasicTypes

-- | The instance index type.

type Idx = Int

import qualified Text.JSON as J

import Text.JSON.Pretty (pp_value)

import Ganeti.BasicTypes

-- * JSON-related functions

  , JobStatus(..)

  ) where

import qualified Ganeti.Constants as C

import qualified Ganeti.THH as THH

import Data.Maybe

import qualified Data.Map as Map

import qualified Data.Set as Set

import qualified Text.JSON as J

import qualified Ganeti.Constants as C

  , allOpIDs

  ) where

import Text.JSON.Pretty (pp_value)

import qualified Ganeti.Constants as C

import qualified Ganeti.Constants as C

import Ganeti.THH

-- * THH declarations, that require ordering.

import Control.Arrow (second)

import qualified Text.JSON as J

import Text.JSON.Pretty (pp_value)

#ifndef NO_CURL

import Network.Curl

import Ganeti.Objects

import Ganeti.THH

import Ganeti.Compat

-- * Base RPC functionality and types

import qualified Text.JSON as JSON

import Text.JSON.Pretty (pp_value)

-- * Exported types

-- | Class of objects that can be converted to 'JSObject'

-- | showJSON as an expression, for reuse.

showJSONE :: Q Exp

-- | ToRaw function name.

toRawName :: String -> Name

genShowJSON :: String -> Q Dec

genShowJSON name = do

  body <- [| JSON.showJSON . $(varE (toRawName name)) |]

-- | Creates the readJSON member of a JSON instance declaration.

--

                           $(stringE name) ++ ": " ++ e ++ " from " ++

                           show $(varE s)

           |]

-- | Generates a JSON instance for a given type.

--

                   JSON.showJSON $(stringE . deCamelCase $ sname) )] |]

      flist = listE (opid:felems)

      -- and finally convert all this to a json object

  clause [pat] (normalB flist') []

-- | Generates the main save opcode function.

      opid = mkName "op_id"

  st1 <- bindS (varP objname) [| liftM JSON.fromJSObject

                                 (JSON.readJSON $(varE arg1)) |]

  -- the match results (per-constructor blocks)

  mexps <- mapM (uncurry loadConstructor) opdefs

  fails <- [| fail $ "Unknown opcode " ++ $(varE opid) |]

      tdlist = [| concat $flist |]

      iname = mkName "i"

  tclause <- clause [pat] (normalB tdlist) []

  let fname = mkName ("save" ++ sname)

  sigt <- [t| $(conT name) -> JSON.JSValue |]

  return [SigD tdname tdsigt, FunD tdname [tclause],

objectShowJSON :: String -> Q Dec

objectShowJSON name = do

  body <- [| JSON.showJSON . $(varE . mkName $ "save" ++ name) |]

-- | Generates the load object functionality.

genLoadObject :: (Field -> Q (Name, Stmt))

          -- we treat both optional types the same, since

          -- 'maybeFromObj' can deal with both missing and null values

          -- appropriately (the same)

          else case fieldDefault field of

                 Just defv ->

                      $objfield $defv |]

  bexp <- loadFn field loadexp objvar

  return (fvar, BindS (VarP fvar) bexp)

                 JSON.Error $ "Can't parse value for type " ++

                       $(stringE name) ++ ": " ++ e

           |]

-- * Inheritable parameter tables implementation

  -- these are used in all patterns below

  let objvar = varNameE "o"

      objfield = stringE name

  bexp <- loadFn field loadexp objvar

  return (fvar, BindS (VarP fvar) bexp)

buildFromMaybe :: String -> Q Dec

buildFromMaybe fname =

  valD (varP (mkName $ "n_" ++ fname))

                        $(varNameE $ "f_" ++ fname)

                        $(varNameE $ "p_" ++ fname) |]) []