| 42 |
42 |
, defaultField
|
| 43 |
43 |
, optionalField
|
| 44 |
44 |
, renameField
|
| 45 |
|
, containerField
|
| 46 |
45 |
, customField
|
| 47 |
46 |
, timeStampFields
|
| 48 |
47 |
, uuidFields
|
| ... | ... | |
| 51 |
50 |
, buildObject
|
| 52 |
51 |
, buildObjectSerialisation
|
| 53 |
52 |
, buildParam
|
| 54 |
|
, Container
|
| 55 |
53 |
) where
|
| 56 |
54 |
|
| 57 |
55 |
import Control.Monad (liftM, liftM2)
|
| ... | ... | |
| 62 |
60 |
|
| 63 |
61 |
import qualified Text.JSON as JSON
|
| 64 |
62 |
|
| 65 |
|
import Ganeti.HTools.JSON
|
| 66 |
|
|
| 67 |
63 |
-- * Exported types
|
| 68 |
64 |
|
| 69 |
65 |
-- | Serialised field data type.
|
| ... | ... | |
| 73 |
69 |
, fieldShow :: Maybe (Q Exp)
|
| 74 |
70 |
, fieldDefault :: Maybe (Q Exp)
|
| 75 |
71 |
, fieldConstr :: Maybe String
|
| 76 |
|
, fieldIsContainer :: Bool
|
| 77 |
72 |
, fieldIsOptional :: Bool
|
| 78 |
73 |
}
|
| 79 |
74 |
|
| ... | ... | |
| 86 |
81 |
, fieldShow = Nothing
|
| 87 |
82 |
, fieldDefault = Nothing
|
| 88 |
83 |
, fieldConstr = Nothing
|
| 89 |
|
, fieldIsContainer = False
|
| 90 |
84 |
, fieldIsOptional = False
|
| 91 |
85 |
}
|
| 92 |
86 |
|
| ... | ... | |
| 103 |
97 |
optionalField :: Field -> Field
|
| 104 |
98 |
optionalField field = field { fieldIsOptional = True }
|
| 105 |
99 |
|
| 106 |
|
-- | Marks a field as a container.
|
| 107 |
|
containerField :: Field -> Field
|
| 108 |
|
containerField field = field { fieldIsContainer = True }
|
| 109 |
|
|
| 110 |
100 |
-- | Sets custom functions on a field.
|
| 111 |
101 |
customField :: Name -- ^ The name of the read function
|
| 112 |
102 |
-> Name -- ^ The name of the show function
|
| ... | ... | |
| 130 |
120 |
_ -> map (\c -> if c == '-' then '_' else c) $ fieldName f
|
| 131 |
121 |
|
| 132 |
122 |
actualFieldType :: Field -> Q Type
|
| 133 |
|
actualFieldType f | fieldIsContainer f = [t| Container $t |]
|
| 134 |
|
| fieldIsOptional f = [t| Maybe $t |]
|
|
123 |
actualFieldType f | fieldIsOptional f = [t| Maybe $t |]
|
| 135 |
124 |
| otherwise = t
|
| 136 |
125 |
where t = fieldType f
|
| 137 |
126 |
|
| ... | ... | |
| 150 |
139 |
-> Q Exp -- ^ The value of the field as existing in the JSON message
|
| 151 |
140 |
-> Q Exp -- ^ The entire object in JSON object format
|
| 152 |
141 |
-> Q Exp -- ^ Resulting expression
|
| 153 |
|
loadFn (Field { fieldIsContainer = True }) expr _ =
|
| 154 |
|
[| $expr |]
|
| 155 |
142 |
loadFn (Field { fieldRead = Just readfn }) expr o = [| $expr >>= $readfn $o |]
|
| 156 |
143 |
loadFn _ expr _ = expr
|
| 157 |
144 |
|
| ... | ... | |
| 623 |
610 |
|
| 624 |
611 |
saveObjectField :: Name -> Field -> Q Exp
|
| 625 |
612 |
saveObjectField fvar field
|
| 626 |
|
| isContainer = [| [( $nameE , JSON.showJSON $fvarE)] |]
|
| 627 |
613 |
| fisOptional = [| case $(varE fvar) of
|
| 628 |
614 |
Nothing -> []
|
| 629 |
615 |
Just v -> [( $nameE, JSON.showJSON v)]
|
| ... | ... | |
| 633 |
619 |
Just fn -> [| let (actual, extra) = $fn $fvarE
|
| 634 |
620 |
in extra ++ [( $nameE, JSON.showJSON actual)]
|
| 635 |
621 |
|]
|
| 636 |
|
where isContainer = fieldIsContainer field
|
| 637 |
|
fisOptional = fieldIsOptional field
|
|
622 |
where fisOptional = fieldIsOptional field
|
| 638 |
623 |
nameE = stringE (fieldName field)
|
| 639 |
624 |
fvarE = varE fvar
|
| 640 |
625 |
|