Initial query daemon implementation

[ganeti-local] / htools / Ganeti / THH.hs

diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
index 972e4c7..291228f 100644 (file)
--- a/htools/Ganeti/THH.hs
+++ b/htools/Ganeti/THH.hs
@@ -42,7 +42,6 @@ module Ganeti.THH ( declareSADT
                   , defaultField
                   , optionalField
                   , renameField
-                  , containerField
                   , customField
                   , timeStampFields
                   , uuidFields
@@ -51,25 +50,18 @@ module Ganeti.THH ( declareSADT
                   , buildObject
                   , buildObjectSerialisation
                   , buildParam
-                  , Container
                   ) where
 
-import Control.Arrow
 import Control.Monad (liftM, liftM2)
 import Data.Char
 import Data.List
-import qualified Data.Map as M
 import qualified Data.Set as Set
 import Language.Haskell.TH
 
 import qualified Text.JSON as JSON
 
-import Ganeti.HTools.JSON
-
 -- * Exported types
 
-type Container = M.Map String
-
 -- | Serialised field data type.
 data Field = Field { fieldName        :: String
                    , fieldType        :: Q Type
@@ -77,7 +69,6 @@ data Field = Field { fieldName        :: String
                    , fieldShow        :: Maybe (Q Exp)
                    , fieldDefault     :: Maybe (Q Exp)
                    , fieldConstr      :: Maybe String
-                   , fieldIsContainer :: Bool
                    , fieldIsOptional  :: Bool
                    }
 
@@ -90,7 +81,6 @@ simpleField fname ftype =
         , fieldShow        = Nothing
         , fieldDefault     = Nothing
         , fieldConstr      = Nothing
-        , fieldIsContainer = False
         , fieldIsOptional  = False
         }
 
@@ -107,10 +97,6 @@ defaultField defval field = field { fieldDefault = Just defval }
 optionalField :: Field -> Field
 optionalField field = field { fieldIsOptional = True }
 
--- | Marks a field as a container.
-containerField :: Field -> Field
-containerField field = field { fieldIsContainer = True }
-
 -- | Sets custom functions on a field.
 customField :: Name    -- ^ The name of the read function
             -> Name    -- ^ The name of the show function
@@ -134,8 +120,7 @@ fieldVariable f =
     _ -> map (\c -> if c == '-' then '_' else c) $ fieldName f
 
 actualFieldType :: Field -> Q Type
-actualFieldType f | fieldIsContainer f = [t| Container $t |]
-                  | fieldIsOptional f  = [t| Maybe $t     |]
+actualFieldType f | fieldIsOptional f  = [t| Maybe $t     |]
                   | otherwise = t
                   where t = fieldType f
 
@@ -154,8 +139,6 @@ loadFn :: Field   -- ^ The field definition
        -> Q Exp   -- ^ The value of the field as existing in the JSON message
        -> Q Exp   -- ^ The entire object in JSON object format
        -> Q Exp   -- ^ Resulting expression
-loadFn (Field { fieldIsContainer = True }) expr _ =
-  [| $expr >>= readContainer |]
 loadFn (Field { fieldRead = Just readfn }) expr o = [| $expr >>= $readfn $o |]
 loadFn _ expr _ = expr
 
@@ -225,18 +208,6 @@ appFn :: Exp -> Exp -> Exp
 appFn f x | f == VarE 'id = x
           | otherwise = AppE f x
 
--- | Container loader
-readContainer :: (Monad m, JSON.JSON a) =>
-                 JSON.JSObject JSON.JSValue -> m (Container a)
-readContainer obj = do
-  let kjvlist = JSON.fromJSObject obj
-  kalist <- mapM (\(k, v) -> fromKeyValue k v >>= \a -> return (k, a)) kjvlist
-  return $ M.fromList kalist
-
--- | Container dumper
-showContainer :: (JSON.JSON a) => Container a -> JSON.JSValue
-showContainer = JSON.makeObj . map (second JSON.showJSON) . M.toList
-
 -- * Template code for simple raw type-equivalent ADTs
 
 -- | Generates a data type declaration.
@@ -639,7 +610,6 @@ genSaveObject save_fn sname fields = do
 
 saveObjectField :: Name -> Field -> Q Exp
 saveObjectField fvar field
-  | isContainer = [| [( $nameE , JSON.showJSON . showContainer $ $fvarE)] |]
   | fisOptional = [| case $(varE fvar) of
                       Nothing -> []
                       Just v -> [( $nameE, JSON.showJSON v)]
@@ -649,8 +619,7 @@ saveObjectField fvar field
       Just fn -> [| let (actual, extra) = $fn $fvarE
                     in extra ++ [( $nameE, JSON.showJSON actual)]
                   |]
-  where isContainer = fieldIsContainer field
-        fisOptional  = fieldIsOptional field
+  where fisOptional  = fieldIsOptional field
         nameE = stringE (fieldName field)
         fvarE = varE fvar