As discussed offline, I agree that the original version with a new, explicit field is better for several reasons: - It's better if this feature is explicitly declared and visible as something special. - There should be at most one such field, which can only be checked if the type is explicit. So LGTM holds.
On Tue, Feb 4, 2014 at 9:52 AM, Petr Pudlák <[email protected]> wrote: > 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 >>> >>> >> >
