NorfairKing/autodocodec
1
1
Fork 0
mirror of https://github.com/NorfairKing/autodocodec.git synced 2024-11-22 13:07:39 +03:00
Code Issues Projects Releases Wiki Activity

Added boundedEnumCodec

Browse Source
This commit is contained in:
Pablo Bollansée 2024-09-01 12:39:58 +01:00 committed by Tom Sydney Kerckhove
parent f19887d136
commit be4aba9ef1
32 changed files with 318 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
autodocodec-api-usage/autodocodec-api-usage.cabal
View File

@ -78,6 +78,7 @@ extra-source-files:
test_resources/json-schema/semigroup-first.json
test_resources/json-schema/semigroup-last.json
test_resources/json-schema/set-text.json
test_resources/json-schema/shape.json
test_resources/json-schema/string.json
test_resources/json-schema/text.json
test_resources/json-schema/these.json
@ -144,6 +145,7 @@ extra-source-files:
test_resources/nix/semigroup-first-type.nix
test_resources/nix/semigroup-last-type.nix
test_resources/nix/set-text-type.nix
test_resources/nix/shape-type.nix
test_resources/nix/string-type.nix
test_resources/nix/text-type.nix
test_resources/nix/these-options.nix
@ -183,6 +185,7 @@ extra-source-files:
test_resources/openapi-schema/declareSchemaRef/recursive.json
test_resources/openapi-schema/declareSchemaRef/semigroup-first.json
test_resources/openapi-schema/declareSchemaRef/semigroup-last.json
test_resources/openapi-schema/declareSchemaRef/shape.json
test_resources/openapi-schema/declareSchemaRef/these.json
test_resources/openapi-schema/declareSchemaRef/very-comment.json
test_resources/openapi-schema/declareSchemaRef/via.json
@ -227,6 +230,7 @@ extra-source-files:
test_resources/openapi-schema/semigroup-first.json
test_resources/openapi-schema/semigroup-last.json
test_resources/openapi-schema/set-text.json
test_resources/openapi-schema/shape.json
test_resources/openapi-schema/string.json
test_resources/openapi-schema/text.json
test_resources/openapi-schema/these.json
@ -285,6 +289,7 @@ extra-source-files:
test_resources/show-codec/semigroup-first.txt
test_resources/show-codec/semigroup-last.txt
test_resources/show-codec/set-text.txt
test_resources/show-codec/shape.txt
test_resources/show-codec/string.txt
test_resources/show-codec/text.txt
test_resources/show-codec/these.txt
@ -346,6 +351,7 @@ extra-source-files:
test_resources/swagger-schema/semigroup-first.json
test_resources/swagger-schema/semigroup-last.json
test_resources/swagger-schema/set-text.json
test_resources/swagger-schema/shape.json
test_resources/swagger-schema/string.json
test_resources/swagger-schema/text.json
test_resources/swagger-schema/these.json
@ -399,6 +405,7 @@ extra-source-files:
test_resources/yaml-schema/recursive.txt
test_resources/yaml-schema/scientific.txt
test_resources/yaml-schema/set-text.txt
test_resources/yaml-schema/shape.txt
test_resources/yaml-schema/string.txt
test_resources/yaml-schema/text.txt
test_resources/yaml-schema/these.txt

1
autodocodec-api-usage/bench/Main.hs
View File

@ -74,6 +74,7 @@ main =
comparisonBench @DiffTime,
comparisonBench @NominalDiffTime,
comparisonBench @Fruit,
comparisonBench @Shape,
comparisonBench @Example,
comparisonBench @Recursive,
comparisonBench @Via,

41
autodocodec-api-usage/src/Autodocodec/Usage.hs
View File

@ -94,6 +94,28 @@ instance FromJSON Fruit
instance ToJSON Fruit
data Shape
= ShapeCircle
| ShapeSquare
| ShapeRectangle
deriving (Show, Eq, Generic, Enum, Bounded)
deriving (FromJSON, ToJSON) via Autodocodec Shape
deriving (OpenAPI.ToSchema) via AutodocodecOpenApi Shape
instance Validity Shape
instance NFData Shape
instance GenValid Shape where
genValid = genValidStructurallyWithoutExtraChecking
shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
instance HasCodec Shape where
codec = boundedEnumCodec $ \case
ShapeCircle -> "circle"
ShapeSquare -> "square"
ShapeRectangle -> "rectangle"
-- | A complex example type
data Example = Example
{ exampleText :: !Text,
@ -104,7 +126,8 @@ data Example = Example
exampleOptionalWithDefault :: !Text,
exampleOptionalWithNullDefault :: ![Text],
exampleSingleOrList :: ![Text],
exampleFruit :: !Fruit
exampleFruit :: !Fruit,
exampleShape :: !Shape
}
deriving (Show, Eq, Generic)
deriving (OpenAPI.ToSchema) via (AutodocodecOpenApi Example)
@ -132,6 +155,7 @@ instance HasObjectCodec Example where
<*> 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
<*> requiredField "shape" "shape!?" .= exampleShape
instance ToJSON Example where
toJSON Example {..} =
@ -141,6 +165,7 @@ instance ToJSON Example where
"bool" JSON..= exampleBool,
"maybe" JSON..= exampleRequiredMaybe,
"fruit" JSON..= exampleFruit,
"shape" JSON..= exampleShape,
"optional-with-default" JSON..= exampleOptionalWithDefault
],
[ "optional" JSON..= opt
@ -173,6 +198,7 @@ instance FromJSON Example where
<|> (o JSON..:? "single-or-list" JSON..!= [])
)
<*> o JSON..: "fruit"
<*> o JSON..: "shape"
instance FromMultipart tag Example where
fromMultipart form =
@ -203,6 +229,12 @@ instance FromMultipart tag Example where
"Melon" -> Right Melon
_ -> Left "unknown fruit"
)
<*> ( lookupInput "shape" form >>= \case
"circle" -> Right ShapeCircle
"square" -> Right ShapeSquare
"rectangle" -> Right ShapeRectangle
_ -> Left "unknown shape"
)
instance ToMultipart tag Example where
toMultipart Example {..} =
@ -217,7 +249,12 @@ instance ToMultipart tag Example where
[Input "optional-with-default" exampleOptionalWithDefault],
map (Input "optional-with-null-default") exampleOptionalWithNullDefault,
map (Input "single-or-list") exampleSingleOrList,
[Input "fruit" $ T.pack $ show exampleFruit]
[Input "fruit" $ T.pack $ show exampleFruit],
[ Input "shape" $ case exampleShape of
ShapeCircle -> "circle"
ShapeSquare -> "square"
ShapeRectangle -> "rectangle"
]
]
)
[]

1
autodocodec-api-usage/test/Autodocodec/Aeson/SchemaSpec.hs
View File

@ -85,6 +85,7 @@ spec = do
jsonSchemaSpec @NominalDiffTime "nominal-difftime"
jsonSchemaSpec @DiffTime "difftime"
jsonSchemaSpec @Fruit "fruit"
jsonSchemaSpec @Shape "shape"
jsonSchemaSpec @Example "example"
jsonSchemaSpec @Recursive "recursive"
jsonSchemaSpec @ListsExample "lists-example"

1
autodocodec-api-usage/test/Autodocodec/AesonSpec.hs
View File

@ -100,6 +100,7 @@ spec = do
aesonCodecSpec @DiffTime
aesonCodecSpec @NominalDiffTime
aesonCodecSpec @Fruit
aesonCodecSpec @Shape
aesonCodecSpec @Example
aesonCodecErrorSpec @Example "example-error-bool-number" "{\"text\": \"hello\", \"bool\": 5}"
aesonCodecErrorSpec @Example "example-error-fruit-number" "{\"text\": \"hello\", \"bool\": true, \"maybe\": null, \"fruit\": 5}"

1
autodocodec-api-usage/test/Autodocodec/NixSpec.hs
View File

@ -75,6 +75,7 @@ spec = do
nixOptionTypeSpec @NominalDiffTime "nominal-difftime"
nixOptionTypeSpec @DiffTime "difftime"
nixOptionTypeSpec @Fruit "fruit"
nixOptionTypeSpec @Shape "shape"
nixOptionTypeSpec @Example "example"
nixOptionsSpec @Example "example"
nixOptionTypeSpec @Recursive "recursive"

2
autodocodec-api-usage/test/Autodocodec/OpenAPISpec.hs
View File

@ -97,6 +97,8 @@ spec = do
openAPISchemaSpec @NominalDiffTime "nominal-difftime"
openAPISchemaSpec @Fruit "fruit"
openAPISchemaSpecViaDeclareSchemaRef @Fruit "fruit"
openAPISchemaSpec @Shape "shape"
openAPISchemaSpecViaDeclareSchemaRef @Shape "shape"
openAPISchemaSpec @Example "example"
openAPISchemaSpecViaDeclareSchemaRef @Example "example"
openAPISchemaSpec @ListsExample "lists-example"

1
autodocodec-api-usage/test/Autodocodec/ShowSpec.hs
View File

@ -74,6 +74,7 @@ spec = do
showCodecSpec @TimeOfDay "time-of-day"
showCodecSpec @ZonedTime "zoned-time"
showCodecSpec @Fruit "fruit"
showCodecSpec @Shape "shape"
showCodecSpec @Example "example"
showCodecSpec @Recursive "recursive"
showCodecSpec @ListsExample "lists-example"

1
autodocodec-api-usage/test/Autodocodec/SwaggerSpec.hs
View File

@ -92,6 +92,7 @@ spec = do
swaggerSchemaSpec @DiffTime "difftime"
swaggerSchemaSpec @NominalDiffTime "nominal-difftime"
swaggerSchemaSpec @Fruit "fruit"
swaggerSchemaSpec @Shape "shape"
swaggerSchemaSpec @Example "example"
swaggerSchemaSpec @Recursive "recursive"
swaggerSchemaSpec @ListsExample "lists-example"

1
autodocodec-api-usage/test/Autodocodec/Yaml/SchemaSpec.hs
View File

@ -66,6 +66,7 @@ spec = do
yamlSchemaSpec @DiffTime "difftime"
yamlSchemaSpec @NominalDiffTime "nominal-difftime"
yamlSchemaSpec @Fruit "fruit"
yamlSchemaSpec @Shape "shape"
yamlSchemaSpec @Example "example"
yamlSchemaSpec @Recursive "recursive"
yamlSchemaSpec @ListsExample "lists-example"

1
autodocodec-api-usage/test/Autodocodec/YamlSpec.hs
View File

@ -84,6 +84,7 @@ spec = do
yamlCodecSpec @DiffTime
yamlCodecSpec @NominalDiffTime
yamlCodecSpec @Fruit
yamlCodecSpec @Shape
yamlCodecSpec @Example
yamlCodecSpec @Recursive
yamlCodecSpec @MutuallyRecursiveA

15
autodocodec-api-usage/test_resources/json-schema/example.json
View File

@ -59,6 +59,20 @@
},
"type": "array"
},
"shape": {
"$comment": "shape!?",
"oneOf": [
{
"const": "circle"
},
{
"const": "square"
},
{
"const": "rectangle"
}
]
},
"single-or-list": {
"$comment": "an optional list that can also be specified as a single element",
"anyOf": [
@ -79,6 +93,7 @@
}
},
"required": [
"shape",
"fruit",
"maybe",
"bool",

13
autodocodec-api-usage/test_resources/json-schema/shape.json Normal file
View File

@ -0,0 +1,13 @@
{
"oneOf": [
{
"const": "circle"
},
{
"const": "square"
},
{
"const": "rectangle"
}
]
}

8
autodocodec-api-usage/test_resources/nix/example-options.nix
View File

@ -37,6 +37,14 @@
description = "an optional list of texts with a default empty list where the empty list would be omitted";
type = lib.types.listOf lib.types.str;
};
shape = lib.mkOption {
description = "shape!?";
type = lib.types.enum [
"circle"
"square"
"rectangle"
];
};
single-or-list = lib.mkOption {
default = [];
description = "an optional list that can also be specified as a single element";

8
autodocodec-api-usage/test_resources/nix/example-type.nix
View File

@ -38,6 +38,14 @@ lib.types.submodule {
description = "an optional list of texts with a default empty list where the empty list would be omitted";
type = lib.types.listOf lib.types.str;
};
shape = lib.mkOption {
description = "shape!?";
type = lib.types.enum [
"circle"
"square"
"rectangle"
];
};
single-or-list = lib.mkOption {
default = [];
description = "an optional list that can also be specified as a single element";

6
autodocodec-api-usage/test_resources/nix/shape-type.nix Normal file
View File

@ -0,0 +1,6 @@
{ lib }:
lib.types.enum [
"circle"
"square"
"rectangle"
]

12
autodocodec-api-usage/test_resources/openapi-schema/declareSchemaRef/example.json
View File

@ -43,6 +43,15 @@
},
"type": "array"
},
"shape": {
"description": "shape!?",
"enum": [
"circle",
"square",
"rectangle"
],
"type": "string"
},
"single-or-list": {
"additionalProperties": true,
"anyOf": [
@ -68,7 +77,8 @@
"text",
"bool",
"maybe",
"fruit"
"fruit",
"shape"
],
"type": "object"
}

11
autodocodec-api-usage/test_resources/openapi-schema/declareSchemaRef/shape.json Normal file
View File

@ -0,0 +1,11 @@
{
"definitions": {},
"reference": {
"enum": [
"circle",
"square",
"rectangle"
],
"type": "string"
}
}

12
autodocodec-api-usage/test_resources/openapi-schema/example.json
View File

@ -44,6 +44,15 @@
},
"type": "array"
},
"shape": {
"description": "shape!?",
"enum": [
"circle",
"square",
"rectangle"
],
"type": "string"
},
"single-or-list": {
"additionalProperties": true,
"anyOf": [
@ -69,7 +78,8 @@
"text",
"bool",
"maybe",
"fruit"
"fruit",
"shape"
],
"type": "object"
}

20
autodocodec-api-usage/test_resources/openapi-schema/shape.json Normal file
View File

@ -0,0 +1,20 @@
{
"components": {
"schemas": {
"Shape": {
"enum": [
"circle",
"square",
"rectangle"
],
"type": "string"
}
}
},
"info": {
"title": "",
"version": ""
},
"openapi": "3.0.0",
"paths": {}
}

118
autodocodec-api-usage/test_resources/show-codec/example.txt
View File

@ -8,93 +8,113 @@ ObjectOfCodec
(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")
(ApCodec
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion NullCodec (StringCodec Nothing))))))
(RequiredKeyCodec "text" (Just "a text") (StringCodec Nothing)))
(BimapCodec
_ _ (RequiredKeyCodec "bool" (Just "a bool") (BoolCodec Nothing))))
(BimapCodec
_
_
(RequiredKeyCodec
"maybe"
(Just "a maybe text")
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion NullCodec (StringCodec Nothing))))))
(BimapCodec
_
_
(OptionalKeyCodec
"optional" (Just "an optional text") (StringCodec Nothing))))
(BimapCodec
_
_
(OptionalKeyCodec
"optional" (Just "an optional text") (StringCodec Nothing))))
"optional-or-null"
(Just "an optional-or-null text")
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion NullCodec (StringCodec Nothing))))))
(BimapCodec
_
_
(OptionalKeyCodec
"optional-or-null"
(Just "an optional-or-null text")
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion NullCodec (StringCodec Nothing))))))
(OptionalKeyWithDefaultCodec
"optional-with-default"
(StringCodec Nothing)
_
(Just "an optional text with a default"))))
(BimapCodec
_
_
(OptionalKeyWithDefaultCodec
"optional-with-default"
(StringCodec Nothing)
(OptionalKeyWithOmittedDefaultCodec
"optional-with-null-default"
(BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing)))
_
(Just "an optional text with a default"))))
(Just
"an optional list of texts with a default empty list where the empty list would be omitted"))))
(BimapCodec
_
_
(OptionalKeyWithOmittedDefaultCodec
"optional-with-null-default"
(BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing)))
"single-or-list"
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion
(StringCodec Nothing)
(BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing)))))
_
(Just
"an optional list of texts with a default empty list where the empty list would be omitted"))))
"an optional list that can also be specified as a single element"))))
(BimapCodec
_
_
(OptionalKeyWithOmittedDefaultCodec
"single-or-list"
(RequiredKeyCodec
"fruit"
(Just "fruit!!")
(BimapCodec
_
_
(EitherCodec
PossiblyJointUnion
(StringCodec Nothing)
(BimapCodec _ _ (ArrayOfCodec Nothing (StringCodec Nothing)))))
_
(Just
"an optional list that can also be specified as a single element"))))
DisjointUnion
(BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing)))
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing)))
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing)))
(BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))))))
(BimapCodec
_
_
(RequiredKeyCodec
"fruit"
(Just "fruit!!")
"shape"
(Just "shape!?")
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing)))
(BimapCodec _ _ (EqCodec "circle" (StringCodec Nothing)))
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing)))
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing)))
(BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))))))
(BimapCodec _ _ (EqCodec "square" (StringCodec Nothing)))
(BimapCodec _ _ (EqCodec "rectangle" (StringCodec Nothing))))))))))

13
autodocodec-api-usage/test_resources/show-codec/shape.txt Normal file
View File

@ -0,0 +1,13 @@
BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "circle" (StringCodec Nothing)))
(BimapCodec
_
_
(EitherCodec
DisjointUnion
(BimapCodec _ _ (EqCodec "square" (StringCodec Nothing)))
(BimapCodec _ _ (EqCodec "rectangle" (StringCodec Nothing))))))

11
autodocodec-api-usage/test_resources/swagger-schema/example.json
View File

@ -39,6 +39,14 @@
},
"type": "array"
},
"shape": {
"description": "shape!?",
"enum": [
"circle",
"square",
"rectangle"
]
},
"single-or-list": {
"additionalProperties": true,
"description": "an optional list that can also be specified as a single element"
@ -52,7 +60,8 @@
"text",
"bool",
"maybe",
"fruit"
"fruit",
"shape"
],
"type": "object"
}

17
autodocodec-api-usage/test_resources/swagger-schema/shape.json Normal file
View File

@ -0,0 +1,17 @@
{
"definitions": {
"Shape": {
"enum": [
"circle",
"square",
"rectangle"
]
}
},
"info": {
"title": "",
"version": ""
},
"paths": {},
"swagger": "2.0"
}

7
autodocodec-api-usage/test_resources/yaml-schema/example.txt
View File

@ -39,3 +39,10 @@
, Banana
, Melon
]
shape: # required
# shape!?
# one of
[ circle
, square
, rectangle
]

5
autodocodec-api-usage/test_resources/yaml-schema/shape.txt Normal file
View File

@ -0,0 +1,5 @@
# one of
[ circle
, square
, rectangle
]

6
autodocodec/CHANGELOG.md
View File

@ -1,5 +1,11 @@
# Changelog
## [0.4.2.2] - 2024-09-01
### Added
* `boundedEnumCodec`
## [0.4.2.1] - 2024-08-21
### Added

2
autodocodec/autodocodec.cabal
View File

@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: autodocodec
version: 0.4.2.1
version: 0.4.2.2
synopsis: Self-documenting encoder and decoder
homepage: https://github.com/NorfairKing/autodocodec#readme
bug-reports: https://github.com/NorfairKing/autodocodec/issues

2
autodocodec/default.nix
View File

@ -4,7 +4,7 @@
}:
mkDerivation {
pname = "autodocodec";
version = "0.4.2.1";
version = "0.4.2.2";
src = ./.;
libraryHaskellDepends = [
aeson base bytestring containers dlist hashable mtl scientific text

2
autodocodec/package.yaml
View File

@ -1,5 +1,5 @@
name: autodocodec
version: 0.4.2.1
version: 0.4.2.2
github: "NorfairKing/autodocodec"
license: MIT
author: "Tom Sydney Kerckhove"

1
autodocodec/src/Autodocodec.hs
View File

@ -102,6 +102,7 @@ module Autodocodec
-- *** Enums
shownBoundedEnumCodec,
boundedEnumCodec,
stringConstCodec,
enumCodec,

33
autodocodec/src/Autodocodec/Codec.hs
View File

@ -1907,6 +1907,33 @@ stringConstCodec =
)
)
-- | A codec for a 'Bounded' 'Enum' that uses the provided function to have the values correspond to literal 'Text' values.
--
--
-- === Example usage
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Enum, Bounded)
-- >>> :{
-- let c = boundedEnumCodec $ \case
-- Apple -> "foo"
-- Orange -> "bar"
-- :}
--
-- >>> toJSONVia c Apple
-- String "foo"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "bar") :: Maybe Fruit
-- Just Orange
boundedEnumCodec ::
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> T.Text) ->
JSONCodec enum
boundedEnumCodec showFunc =
let ls = [minBound .. maxBound]
in case NE.nonEmpty ls of
Nothing -> error "0 enum values ?!"
Just ne -> stringConstCodec (NE.map (\v -> (v, showFunc v)) ne)
-- | A codec for a 'Bounded' 'Enum' that uses its 'Show' instance to have the values correspond to literal 'Text' values.
--
--
@ -1922,11 +1949,7 @@ shownBoundedEnumCodec ::
forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec =
let ls = [minBound .. maxBound]
in case NE.nonEmpty ls of
Nothing -> error "0 enum values ?!"
Just ne -> stringConstCodec (NE.map (\v -> (v, T.pack (show v))) ne)
shownBoundedEnumCodec = boundedEnumCodec (T.pack . show)
-- | Helper function for 'optionalFieldOrNullWith' and 'optionalFieldOrNull'.
--