Revision ba0d1405
b/src/Ganeti/THH.hs | ||
---|---|---|
47 | 47 |
, genLuxiOp |
48 | 48 |
, Field (..) |
49 | 49 |
, simpleField |
50 |
, specialNumericalField |
|
50 | 51 |
, withDoc |
51 | 52 |
, defaultField |
52 | 53 |
, optionalField |
... | ... | |
142 | 143 |
optionalNullSerField :: Field -> Field |
143 | 144 |
optionalNullSerField field = field { fieldIsOptional = OptionalSerializeNull } |
144 | 145 |
|
146 |
-- | Wrapper around a special parse function, suitable as field-parsing |
|
147 |
-- function. |
|
148 |
numericalReadFn :: JSON.JSON a => (String -> JSON.Result a) |
|
149 |
-> [(String, JSON.JSValue)] -> JSON.JSValue -> JSON.Result a |
|
150 |
numericalReadFn _ _ v@(JSON.JSRational _ _) = JSON.readJSON v |
|
151 |
numericalReadFn f _ (JSON.JSString x) = f $ JSON.fromJSString x |
|
152 |
numericalReadFn _ _ _ = JSON.Error "A numerical field has to be a number or\ |
|
153 |
\ a string." |
|
154 |
|
|
155 |
-- | Wrapper to lift a read function to optional values |
|
156 |
makeReadOptional :: ([(String, JSON.JSValue)] -> JSON.JSValue -> JSON.Result a) |
|
157 |
-> [(String, JSON.JSValue)] |
|
158 |
-> Maybe JSON.JSValue -> JSON.Result (Maybe a) |
|
159 |
makeReadOptional _ _ Nothing = JSON.Ok Nothing |
|
160 |
makeReadOptional f o (Just x) = fmap Just $ f o x |
|
161 |
|
|
162 |
-- | Sets the read function to also accept string parsable by the given |
|
163 |
-- function. |
|
164 |
specialNumericalField :: Name -> Field -> Field |
|
165 |
specialNumericalField f field = |
|
166 |
if (fieldIsOptional field == NotOptional) |
|
167 |
then field { fieldRead = Just (appE (varE 'numericalReadFn) (varE f)) } |
|
168 |
else field { fieldRead = Just (appE (varE 'makeReadOptional) |
|
169 |
(appE (varE 'numericalReadFn) |
|
170 |
(varE f))) } |
|
171 |
|
|
145 | 172 |
-- | Sets custom functions on a field. |
146 | 173 |
customField :: Name -- ^ The name of the read function |
147 | 174 |
-> Name -- ^ The name of the show function |
Also available in: Unified diff