As Jose suggested now, maybe it'd be possible to implement it without adding a new type of optional field. As I understand it, it'd be possible to parse these extra arguments with custom fieldRead. The only problem is that it doesn't know which other fields are defined and which are "rest arguments". So what about instead of adding a new optional field, we just pass the list of field names to 'loadFn' and 'fieldRead'?
On Tue, Feb 4, 2014 at 9:12 AM, Petr Pudlák <[email protected]> wrote: > LGTM, thanks. > > > On Mon, Feb 3, 2014 at 8:56 PM, Klaus Aehlig <[email protected]> wrote: > >> A field of this type will capture all the remaining fields >> of an object as JSValues. Obviously, the intended use is >> to have precisely one such field. This mechanism will allow >> to pass opaque values trough, as it is, e.g., required for >> the disk parameters for external storage. >> >> Signed-off-by: Klaus Aehlig <[email protected]> >> --- >> src/Ganeti/THH.hs | 34 ++++++++++++++++++++++------------ >> 1 file changed, 22 insertions(+), 12 deletions(-) >> >> diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs >> index 30a3d71..5346a8d 100644 >> --- a/src/Ganeti/THH.hs >> +++ b/src/Ganeti/THH.hs >> @@ -73,6 +73,7 @@ import Control.Monad >> import Data.Char >> import Data.List >> import Data.Maybe >> +import qualified Data.Map as M >> import qualified Data.Set as Set >> import Language.Haskell.TH >> >> @@ -96,6 +97,8 @@ data OptionalType >> = NotOptional -- ^ Field is not optional >> | OptionalOmitNull -- ^ Field is optional, null is not serialised >> | OptionalSerializeNull -- ^ Field is optional, null is serialised >> + | AndRestArguments -- ^ Special field capturing all the remaining >> fields >> + -- as plain JSON values >> deriving (Show, Eq) >> >> -- | Serialised field data type. >> @@ -202,8 +205,8 @@ fieldVariable f = >> -- | Compute the actual field type (taking into account possible >> -- optional status). >> actualFieldType :: Field -> Q Type >> -actualFieldType f | fieldIsOptional f /= NotOptional = [t| Maybe $t |] >> - | otherwise = t >> +actualFieldType f | fieldIsOptional f `elem` [NotOptional, >> AndRestArguments] = t >> + | otherwise = [t| Maybe $t |] >> where t = fieldType f >> >> -- | Checks that a given field is not optional (for object types or >> @@ -763,7 +766,7 @@ genSaveOpCode tname jvalstr tdstr opdefs fn >> gen_object = do >> loadConstructor :: OpCodeConstructor -> Q Exp >> loadConstructor (sname, _, _, fields, _) = do >> let name = mkName sname >> - fbinds <- mapM loadObjectField fields >> + fbinds <- mapM (loadObjectField fields) fields >> let (fnames, fstmts) = unzip fbinds >> let cval = foldl (\accu fn -> AppE accu (VarE fn)) (ConE name) fnames >> fstmts' = fstmts ++ [NoBindS (AppE (VarE 'return) cval)] >> @@ -866,7 +869,7 @@ buildObjectSerialisation :: String -> [Field] -> Q >> [Dec] >> buildObjectSerialisation sname fields = do >> let name = mkName sname >> savedecls <- genSaveObject saveObjectField sname fields >> - (loadsig, loadfn) <- genLoadObject loadObjectField sname fields >> + (loadsig, loadfn) <- genLoadObject (loadObjectField fields) sname >> fields >> shjson <- objectShowJSON sname >> rdjson <- objectReadJSON sname >> let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) >> @@ -921,6 +924,7 @@ saveObjectField fvar field = >> Just fn -> [| let (actual, extra) = $fn $fvarE >> in ($nameE, JSON.showJSON actual):extra >> |] >> + AndRestArguments -> [| M.toList $(varE fvar) |] >> where nameE = stringE (fieldName field) >> fvarE = varE fvar >> >> @@ -955,24 +959,30 @@ genLoadObject load_fn sname fields = do >> FunD funname [Clause [VarP arg1] (NormalB (DoE fstmts')) []]) >> >> -- | Generates code for loading an object's field. >> -loadObjectField :: Field -> Q (Name, Stmt) >> -loadObjectField field = do >> +loadObjectField :: [Field] -> Field -> Q (Name, Stmt) >> +loadObjectField allFields field = do >> let name = fieldVariable field >> + names = map fieldVariable allFields >> + otherNames = listE . map stringE $ names \\ [name] >> fvar <- newName name >> -- these are used in all patterns below >> let objvar = varNameE "o" >> objfield = stringE (fieldName field) >> loadexp = >> - if fieldIsOptional field /= NotOptional >> - -- we treat both optional types the same, since >> - -- 'maybeFromObj' can deal with both missing and null values >> - -- appropriately (the same) >> - then [| $(varE 'maybeFromObj) $objvar $objfield |] >> - else case fieldDefault field of >> + case fieldIsOptional field of >> + NotOptional -> >> + case fieldDefault field of >> Just defv -> >> [| $(varE 'fromObjWithDefault) $objvar >> $objfield $defv |] >> Nothing -> [| $fromObjE $objvar $objfield |] >> + AndRestArguments -> [| return . M.fromList >> + $ filter (not . (`elem` $otherNames) >> . fst) >> + $objvar |] >> + _ -> [| $(varE 'maybeFromObj) $objvar $objfield |] >> + -- we treat both optional types the same, since >> + -- 'maybeFromObj' can deal with both missing and null values >> + -- appropriately (the same) >> bexp <- loadFn field loadexp objvar >> >> return (fvar, BindS (VarP fvar) bexp) >> -- >> 1.9.0.rc1.175.g0b1dcb5 >> >> >
