single or list codec

This commit is contained in:
Tom Sydney Kerckhove 2021-11-18 17:05:56 +01:00
parent c1687a96fc
commit e5a54ccc0d
8 changed files with 115 additions and 1 deletions

View File

@ -86,6 +86,7 @@ data Example = Example
exampleOptionalOrNull :: !(Maybe Text),
exampleOptionalWithDefault :: !Text,
exampleOptionalWithNullDefault :: ![Text],
exampleSingleOrList :: ![Text],
exampleFruit :: !Fruit
}
deriving (Show, Eq, Generic)
@ -109,6 +110,7 @@ instance HasCodec Example where
<*> optionalFieldOrNull "optional-or-null" "an optional-or-null text" .= exampleOptionalOrNull
<*> optionalFieldWithDefault "optional-with-default" "foobar" "an optional text with a default" .= exampleOptionalWithDefault
<*> optionalFieldWithOmittedDefault "optional-with-null-default" [] "an optional list of texts with a default empty list where the empty list would be omitted" .= exampleOptionalWithNullDefault
<*> optionalFieldWithOmittedDefaultWith "single-or-list" (singleOrListCodec codec) [] "an optional list that can also be specified as a single element" .= exampleSingleOrList
<*> requiredField "fruit" "fruit!!" .= exampleFruit
instance ToJSON Example where
@ -129,6 +131,11 @@ instance ToJSON Example where
],
[ "optional-with-null-default" JSON..= exampleOptionalWithNullDefault
| not (null exampleOptionalWithNullDefault)
],
[ case exampleSingleOrList of
[e] -> "single-or-list" JSON..= e
l -> "single-or-list" JSON..= l
| not (null exampleSingleOrList)
]
]
@ -142,6 +149,9 @@ instance FromJSON Example where
<*> o JSON..:? "optional-or-null"
<*> o JSON..:? "optional-with-default" JSON..!= "foobar"
<*> o JSON..:? "optional-with-null-default" JSON..!= []
<*> ( ((: []) <$> o JSON..: "single-or-list")
<|> (o JSON..:? "single-or-list" JSON..!= [])
)
<*> o JSON..: "fruit"
-- | A simple Recursive type

View File

@ -19,6 +19,20 @@
}
]
},
"single-or-list": {
"$comment": "an optional list that can also be specified as a single element",
"anyOf": [
{
"type": "string"
},
{
"items": {
"type": "string"
},
"type": "array"
}
]
},
"text": {
"$comment": "a text",
"type": "string"

View File

@ -23,6 +23,21 @@
"additionalProperties": true,
"description": "a maybe text"
},
"single-or-list": {
"anyOf": [
{
"type": "string"
},
{
"items": {
"type": "string"
},
"type": "array"
}
],
"additionalProperties": true,
"description": "an optional list that can also be specified as a single element"
},
"text": {
"type": "string",
"description": "a text"

View File

@ -1 +1 @@
ObjectOfCodec (Just "Example") (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "text" (Just "a text") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "bool" (Just "a bool") (BoolCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "maybe" (Just "a maybe text") (BimapCodec _ _ (EitherCodec NullCodec (StringCodec Nothing)))))) (BimapCodec _ _ (OptionalKeyCodec "optional" (Just "an optional text") (StringCodec Nothing)))) (BimapCodec _ _ (OptionalKeyCodec "optional-or-null" (Just "an optional-or-null text") (BimapCodec _ _ (EitherCodec NullCodec (StringCodec Nothing)))))) (BimapCodec _ _ (OptionalKeyWithDefaultCodec "optional-with-default" (StringCodec Nothing) _ (Just "an optional text with a default")))) (BimapCodec _ _ (OptionalKeyWithOmittedDefaultCodec "optional-with-null-default" (BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing))) _ (Just "an optional list of texts with a default empty list where the empty list would be omitted")))) (BimapCodec _ _ (RequiredKeyCodec "fruit" (Just "fruit!!") (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))))))
ObjectOfCodec (Just "Example") (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "text" (Just "a text") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "bool" (Just "a bool") (BoolCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "maybe" (Just "a maybe text") (BimapCodec _ _ (EitherCodec NullCodec (StringCodec Nothing)))))) (BimapCodec _ _ (OptionalKeyCodec "optional" (Just "an optional text") (StringCodec Nothing)))) (BimapCodec _ _ (OptionalKeyCodec "optional-or-null" (Just "an optional-or-null text") (BimapCodec _ _ (EitherCodec NullCodec (StringCodec Nothing)))))) (BimapCodec _ _ (OptionalKeyWithDefaultCodec "optional-with-default" (StringCodec Nothing) _ (Just "an optional text with a default")))) (BimapCodec _ _ (OptionalKeyWithOmittedDefaultCodec "optional-with-null-default" (BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing))) _ (Just "an optional list of texts with a default empty list where the empty list would be omitted")))) (BimapCodec _ _ (OptionalKeyWithOmittedDefaultCodec "single-or-list" (BimapCodec _ _ (EitherCodec (StringCodec Nothing) (BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing))))) _ (Just "an optional list that can also be specified as a single element")))) (BimapCodec _ _ (RequiredKeyCodec "fruit" (Just "fruit!!") (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))))))

View File

@ -19,6 +19,10 @@
"additionalProperties": true,
"description": "a maybe text"
},
"single-or-list": {
"additionalProperties": true,
"description": "an optional list that can also be specified as a single element"
},
"text": {
"type": "string",
"description": "a text"

View File

@ -26,6 +26,12 @@
# default: []
# an optional list of texts with a default empty list where the empty list would be omitted
- <string>
single-or-list: # optional
# default: []
# an optional list that can also be specified as a single element
[ <string>
, - <string>
]
fruit: # required
# fruit!!
[ Apple

View File

@ -60,6 +60,9 @@ module Autodocodec
maybeCodec,
eitherCodec,
listCodec,
nonEmptyCodec,
singleOrListCodec,
singleOrNonEmptyCodec,
vectorCodec,
valueCodec,
nullCodec,

View File

@ -513,6 +513,68 @@ nonEmptyCodec = bimapCodec parseNonEmptyList NE.toList . listCodec
Nothing -> Left "Expected a nonempty list, but got an empty list."
Just ne -> Right ne
-- | Like 'listCodec', except the values may also be simplified as a single value.
--
-- During parsing, a single element may be parsed as the list of just that element.
-- During rendering, a list with only one element will be rendered as just that element.
--
-- === Example usage
--
-- >>> let c = singleOrListCodec codec :: JSONCodec [Int]
-- >>> toJSONVia c [5]
-- Number 5.0
-- >>> toJSONVia c [5,6]
-- Array [Number 5.0,Number 6.0]
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe [Int]
-- Just [5]
-- >>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe [Int]
-- Just [5,6]
--
-- === WARNING
--
-- If you use nested lists, for example when the given value codec is also a
-- 'listCodec', you may get in trouble with ambiguities during parsing.
singleOrListCodec :: ValueCodec input output -> ValueCodec [input] [output]
singleOrListCodec c = dimapCodec f g $ eitherCodec c $ listCodec c
where
f = \case
Left v -> [v]
Right vs -> vs
g = \case
[v] -> Left v
vs -> Right vs
-- | Like 'nonEmptyCodec', except the values may also be simplified as a single value.
--
-- During parsing, a single element may be parsed as the list of just that element.
-- During rendering, a list with only one element will be rendered as just that element.
--
-- === Example usage
--
-- >>> let c = singleOrNonEmptyCodec codec :: JSONCodec (NonEmpty Int)
-- >>> toJSONVia c (5 :| [])
-- Number 5.0
-- >>> toJSONVia c (5 :| [6])
-- Array [Number 5.0,Number 6.0]
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (NonEmpty Int)
-- Just (5 :| [])
-- >>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe (NonEmpty Int)
-- Just (5 :| [6])
--
-- === WARNING
--
-- If you use nested lists, for example when the given value codec is also a
-- 'nonEmptyCodec', you may get in trouble with ambiguities during parsing.
singleOrNonEmptyCodec :: ValueCodec input output -> ValueCodec (NonEmpty input) (NonEmpty output)
singleOrNonEmptyCodec c = dimapCodec f g $ eitherCodec c $ nonEmptyCodec c
where
f = \case
Left v -> v :| []
Right vs -> vs
g = \case
v :| [] -> Left v
vs -> Right vs
-- | A required field
--
-- During decoding, the field must be in the object.