diff --git a/composite-aeson/src/Composite/Aeson/Record.hs b/composite-aeson/src/Composite/Aeson/Record.hs index 69f05aa..597e5ce 100644 --- a/composite-aeson/src/Composite/Aeson/Record.hs +++ b/composite-aeson/src/Composite/Aeson/Record.hs @@ -2,6 +2,7 @@ module Composite.Aeson.Record ( ToJsonField(..), FromJsonField(..), JsonField(..) , field, valField, field', fromField, valFromField, fromField', toField, toField' + , defaultField, valDefaultField, defaultField' , optionalField, valOptionalField, optionalField', fromOptionalField, valFromOptionalField, fromOptionalField', toOptionalField, toOptionalField', defaultValFromOptionalField , JsonFormatRecord, ToJsonFormatRecord, FromJsonFormatRecord, zipJsonFormatRecord, toJsonFormatRecord, fromJsonFormatRecord , DefaultJsonFormatRecord, defaultJsonFormatRecord @@ -67,6 +68,26 @@ valField = field field' :: JsonFormat e a -> JsonField e a field' (JsonFormat (JsonProfunctor o i)) = JsonField (Just . o) (`ABE.key` i) +-- | Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @a@ which substitutes a default value if the field is missing +-- and never elides the field. +defaultField :: (Wrapped a', Unwrapped a' ~ a) => a -> JsonFormat e a -> JsonField e a' +defaultField default_ (JsonFormat (JsonProfunctor o i)) = + JsonField + (Just . o . view _Wrapped') + (\k -> view (from _Wrapped') . fromMaybe default_ . join <$> ABE.keyMay k (ABE.perhaps i)) + +-- | Specialized type for 'defaultField' so we can specify the 'Val' symbol. +valDefaultField :: forall s a e. a -> JsonFormat e a -> JsonField e (s :-> a) +valDefaultField = defaultField + +-- | Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @a@ which substitutes a default value if the field is missing +-- and never elides the field. +defaultField' :: a -> JsonFormat e a -> JsonField e a +defaultField' default_ (JsonFormat (JsonProfunctor o i)) = + JsonField + (Just . o) + (\k -> fromMaybe default_ . join <$> ABE.keyMay k (ABE.perhaps i)) + -- |Given a parser for @'Unwrapped' a@, produce a @'FromField' e a@. fromField :: Wrapped a => ABE.Parse e (Unwrapped a) -> FromJsonField e a fromField = FromJsonField . flip ABE.key . fmap (review _Wrapped')