Revision 1c7bda0a htools/Ganeti/THH.hs
| b/htools/Ganeti/THH.hs | ||
|---|---|---|
| 144 | 144 |
fail $ "Default field " ++ name ++ " used in parameter declaration" |
| 145 | 145 |
checkNonOptDef _ = return () |
| 146 | 146 |
|
| 147 |
loadFn :: Field -> Q Exp -> Q Exp |
|
| 148 |
loadFn (Field { fieldIsContainer = True }) expr = [| $expr >>= readContainer |]
|
|
| 149 |
loadFn (Field { fieldRead = Just readfn }) expr = [| $expr >>= $readfn |]
|
|
| 150 |
loadFn _ expr = expr |
|
| 151 |
|
|
| 147 |
-- | Produces the expression that will de-serialise a given |
|
| 148 |
-- field. Since some custom parsing functions might need to use the |
|
| 149 |
-- entire object, we do take and pass the object to any custom read |
|
| 150 |
-- functions. |
|
| 151 |
loadFn :: Field -- ^ The field definition |
|
| 152 |
-> Q Exp -- ^ The value of the field as existing in the JSON message |
|
| 153 |
-> Q Exp -- ^ The entire object in JSON object format |
|
| 154 |
-> Q Exp -- ^ Resulting expression |
|
| 155 |
loadFn (Field { fieldIsContainer = True }) expr _ =
|
|
| 156 |
[| $expr >>= readContainer |] |
|
| 157 |
loadFn (Field { fieldRead = Just readfn }) expr o = [| $expr >>= $readfn $o |]
|
|
| 158 |
loadFn _ expr _ = expr |
|
| 152 | 159 |
|
| 153 | 160 |
-- * Common field declarations |
| 154 | 161 |
|
| ... | ... | |
| 632 | 639 |
|] |
| 633 | 640 |
| otherwise = case fieldShow field of |
| 634 | 641 |
Nothing -> [| [( $nameE, JSON.showJSON $fvarE)] |] |
| 635 |
Just fn -> [| [( $nameE, JSON.showJSON . $fn $ $fvarE)] |] |
|
| 642 |
Just fn -> [| let (actual, extra) = $fn $fvarE |
|
| 643 |
in extra ++ [( $nameE, JSON.showJSON actual)] |
|
| 644 |
|] |
|
| 636 | 645 |
where isContainer = fieldIsContainer field |
| 637 | 646 |
fisOptional = fieldIsOptional field |
| 638 | 647 |
nameE = stringE (fieldName field) |
| ... | ... | |
| 676 | 685 |
[| $(varNameE "fromObjWithDefault") $objvar |
| 677 | 686 |
$objfield $defv |] |
| 678 | 687 |
Nothing -> [| $(varNameE "fromObj") $objvar $objfield |] |
| 679 |
bexp <- loadFn field loadexp |
|
| 688 |
bexp <- loadFn field loadexp objvar
|
|
| 680 | 689 |
|
| 681 | 690 |
return (fvar, BindS (VarP fvar) bexp) |
| 682 | 691 |
|
| ... | ... | |
| 761 | 770 |
let objvar = varNameE "o" |
| 762 | 771 |
objfield = stringE name |
| 763 | 772 |
loadexp = [| $(varNameE "maybeFromObj") $objvar $objfield |] |
| 764 |
bexp <- loadFn field loadexp |
|
| 773 |
bexp <- loadFn field loadexp objvar
|
|
| 765 | 774 |
return (fvar, BindS (VarP fvar) bexp) |
| 766 | 775 |
|
| 767 | 776 |
-- | Builds a simple declaration of type @n_x = fromMaybe f_x p_x@. |
Also available in: Unified diff