Commit 4b71f30c authored by Iustin Pop's avatar Iustin Pop

Remove obsolete conversion function for Luxi TH

Due to the (now removed) custom filter field, we needed a conversion
function. Since now that field is gone, we can move to a simpler Luxi
TH implementation.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent dc6a0f82
......@@ -113,69 +113,69 @@ $(makeJSONInstance ''QrViaLuxi)
-- | Currently supported Luxi operations and JSON serialization.
$(genLuxiOp "LuxiOp"
[(luxiReqQuery,
[ ("what", [t| QrViaLuxi |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("qfilter", [t| Qlang.Filter |], [| id |])
[ ("what", [t| QrViaLuxi |])
, ("fields", [t| [String] |])
, ("qfilter", [t| Qlang.Filter |])
])
, (luxiReqQueryNodes,
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
[ ("names", [t| [String] |])
, ("fields", [t| [String] |])
, ("lock", [t| Bool |])
])
, (luxiReqQueryGroups,
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
[ ("names", [t| [String] |])
, ("fields", [t| [String] |])
, ("lock", [t| Bool |])
])
, (luxiReqQueryInstances,
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
[ ("names", [t| [String] |])
, ("fields", [t| [String] |])
, ("lock", [t| Bool |])
])
, (luxiReqQueryJobs,
[ ("ids", [t| [Int] |], [| id |])
, ("fields", [t| [String] |], [| id |])
[ ("ids", [t| [Int] |])
, ("fields", [t| [String] |])
])
, (luxiReqQueryExports,
[ ("nodes", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
[ ("nodes", [t| [String] |])
, ("lock", [t| Bool |])
])
, (luxiReqQueryConfigValues,
[ ("fields", [t| [String] |], [| id |]) ]
[ ("fields", [t| [String] |]) ]
)
, (luxiReqQueryClusterInfo, [])
, (luxiReqQueryTags,
[ ("kind", [t| String |], [| id |])
, ("name", [t| String |], [| id |])
[ ("kind", [t| String |])
, ("name", [t| String |])
])
, (luxiReqSubmitJob,
[ ("job", [t| [OpCode] |], [| id |]) ]
[ ("job", [t| [OpCode] |]) ]
)
, (luxiReqSubmitManyJobs,
[ ("ops", [t| [[OpCode]] |], [| id |]) ]
[ ("ops", [t| [[OpCode]] |]) ]
)
, (luxiReqWaitForJobChange,
[ ("job", [t| Int |], [| id |])
, ("fields", [t| [String]|], [| id |])
, ("prev_job", [t| JSValue |], [| id |])
, ("prev_log", [t| JSValue |], [| id |])
, ("tmout", [t| Int |], [| id |])
[ ("job", [t| Int |])
, ("fields", [t| [String]|])
, ("prev_job", [t| JSValue |])
, ("prev_log", [t| JSValue |])
, ("tmout", [t| Int |])
])
, (luxiReqArchiveJob,
[ ("job", [t| Int |], [| id |]) ]
[ ("job", [t| Int |]) ]
)
, (luxiReqAutoArchiveJobs,
[ ("age", [t| Int |], [| id |])
, ("tmout", [t| Int |], [| id |])
[ ("age", [t| Int |])
, ("tmout", [t| Int |])
])
, (luxiReqCancelJob,
[ ("job", [t| Int |], [| id |]) ]
[ ("job", [t| Int |]) ]
)
, (luxiReqSetDrainFlag,
[ ("flag", [t| Bool |], [| id |]) ]
[ ("flag", [t| Bool |]) ]
)
, (luxiReqSetWatcherPause,
[ ("duration", [t| Double |], [| id |]) ]
[ ("duration", [t| Double |]) ]
)
])
......
......@@ -52,7 +52,7 @@ module Ganeti.THH ( declareSADT
, buildParam
) where
import Control.Monad (liftM, liftM2)
import Control.Monad (liftM)
import Data.Char
import Data.List
import qualified Data.Set as Set
......@@ -499,7 +499,7 @@ genStrOfKey :: Name -> String -> Q [Dec]
genStrOfKey = genConstrToStr ensureLower
-- | LuxiOp parameter type.
type LuxiParam = (String, Q Type, Q Exp)
type LuxiParam = (String, Q Type)
-- | Generates the LuxiOp data type.
--
......@@ -508,19 +508,16 @@ type LuxiParam = (String, Q Type, Q Exp)
-- We can't use anything less generic, because the way different
-- operations are serialized differs on both parameter- and top-level.
--
-- There are three things to be defined for each parameter:
-- There are two things to be defined for each parameter:
--
-- * name
--
-- * type
--
-- * operation; this is the operation performed on the parameter before
-- serialization
--
genLuxiOp :: String -> [(String, [LuxiParam])] -> Q [Dec]
genLuxiOp name cons = do
decl_d <- mapM (\(cname, fields) -> do
fields' <- mapM (\(_, qt, _) ->
fields' <- mapM (\(_, qt) ->
qt >>= \t -> return (NotStrict, t))
fields
return $ NormalC (mkName cname) fields')
......@@ -534,14 +531,14 @@ genLuxiOp name cons = do
-- | Generates the \"save\" expression for a single luxi parameter.
saveLuxiField :: Name -> LuxiParam -> Q Exp
saveLuxiField fvar (_, qt, fn) =
[| JSON.showJSON ( $(liftM2 appFn fn $ varE fvar) ) |]
saveLuxiField fvar (_, qt) =
[| JSON.showJSON $(varE fvar) |]
-- | Generates the \"save\" clause for entire LuxiOp constructor.
saveLuxiConstructor :: (String, [LuxiParam]) -> Q Clause
saveLuxiConstructor (sname, fields) = do
let cname = mkName sname
fnames = map (\(nm, _, _) -> mkName nm) fields
fnames = map (mkName . fst) fields
pat = conP cname (map varP fnames)
flist = map (uncurry saveLuxiField) (zip fnames fields)
finval = if null flist
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment