Support disjoint unions

2024-10-27 08:10:10 +03:00 · 2021-12-23 14:35:35 +01:00 · 2021-12-23 14:35:35 +01:00 · 45a112f16e
commit 45a112f16e
parent d269215812
66 changed files with 740 additions and 180 deletions
--- a/autodocodec-api-usage/src/Autodocodec/Usage.hs
+++ b/autodocodec-api-usage/src/Autodocodec/Usage.hs
@ -28,6 +28,7 @@ import Data.Maybe
 import qualified Data.OpenApi as OpenAPI
 import qualified Data.Swagger as Swagger
 import Data.Text (Text)
+import Data.Word
 import GHC.Generics (Generic)
 import Test.QuickCheck

@ -341,3 +342,75 @@ instance HasCodec LegacyObject where
            requiredField "oldest" "oldest key"
          ]
          .= legacyObjectWithHistory
+
+data Ainur
+  = Valar !Text !Text
+  | Maiar !Text
+  deriving stock (Show, Eq, Generic)
+  deriving
+    ( FromJSON,
+      ToJSON,
+      Swagger.ToSchema,
+      OpenAPI.ToSchema
+    )
+    via (Autodocodec Ainur)
+
+instance Validity Ainur
+
+instance NFData Ainur
+
+instance GenValid Ainur where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance HasCodec Ainur where
+  codec =
+    dimapCodec f g $
+      possiblyJointEitherCodec
+        ( object "Valar" $
+            (,)
+              <$> requiredField "domain" "Domain which the Valar rules over" .= fst
+              <*> requiredField "name" "Name of the Valar" .= snd
+        )
+        (object "Maiar" $ requiredField "name" "Name of the Maiar")
+    where
+      f = \case
+        Left (domain, name) -> Valar domain name
+        Right name -> Maiar name
+      g = \case
+        Valar domain name -> Left (domain, name)
+        Maiar name -> Right name
+
+data War
+  = WorldWar !Word8
+  | OtherWar !Text
+  deriving stock (Show, Eq, Generic)
+  deriving
+    ( FromJSON,
+      ToJSON,
+      Swagger.ToSchema,
+      OpenAPI.ToSchema
+    )
+    via (Autodocodec War)
+
+instance Validity War
+
+instance NFData War
+
+instance GenValid War where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance HasCodec War where
+  codec =
+    dimapCodec f g $
+      disjointEitherCodec
+        (codec :: JSONCodec Word8)
+        (codec :: JSONCodec Text)
+    where
+      f = \case
+        Left w -> WorldWar w
+        Right t -> OtherWar t
+      g = \case
+        WorldWar w -> Left w
+        OtherWar t -> Right t
--- a/autodocodec-api-usage/test/Autodocodec/Aeson/SchemaSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/Aeson/SchemaSpec.hs
@ -75,20 +75,23 @@ spec = do
  jsonSchemaSpec @VeryComment "very-comment"
  jsonSchemaSpec @LegacyValue "legacy-value"
  jsonSchemaSpec @LegacyObject "legacy-object"
+  jsonSchemaSpec @Ainur "ainur"
+  jsonSchemaSpec @War "war"
  describe "JSONSchema" $ do
    genValidSpec @JSONSchema
-    it "roundtrips through json and back" $
-      forAllValid $ \jsonSchema ->
-        -- We use the reencode version to survive the ordering change through map
-        let encoded = JSON.encode (jsonSchema :: JSONSchema)
-            encodedCtx = unwords ["encoded: ", show encoded]
-         in context encodedCtx $ case JSON.eitherDecode encoded of
-              Left err -> expectationFailure err
-              Right decoded ->
-                let decodedCtx = unwords ["decoded: ", show decoded]
-                 in context decodedCtx $
-                      let encodedAgain = JSON.encode (decoded :: JSONSchema)
-                       in encodedAgain `shouldBe` encoded
+    xdescribe "does not hold because this property does not hold for Scientific values like -7.85483897507979979e17" $
+      it "roundtrips through json and back" $
+        forAllValid $ \jsonSchema ->
+          -- We use the reencode version to survive the ordering change through map
+          let encoded = JSON.encode (jsonSchema :: JSONSchema)
+              encodedCtx = unwords ["encoded: ", show encoded]
+           in context encodedCtx $ case JSON.eitherDecode encoded of
+                Left err -> expectationFailure err
+                Right decoded ->
+                  let decodedCtx = unwords ["decoded: ", show decoded]
+                   in context decodedCtx $
+                        let encodedAgain = JSON.encode (decoded :: JSONSchema)
+                         in encodedAgain `shouldBe` encoded
  describe "ObjectSchema" $ do
    genValidSpec @ObjectSchema
    it "roundtrips through object and back" $
@ -115,9 +118,10 @@ instance GenValid JSONSchema where
    ArraySchema s -> AnySchema : s : (ArraySchema <$> shrinkValid s)
    ObjectSchema os -> AnySchema : (ObjectSchema <$> shrinkValid os)
    ValueSchema v -> AnySchema : (ValueSchema <$> shrinkValid v)
-    ChoiceSchema ss -> case ss of
-      s :| [] -> [s]
-      _ -> ChoiceSchema <$> shrinkValid ss
+    AnyOfSchema ss -> case ss of
+      s :| _ -> s : filter isValid (AnyOfSchema <$> shrinkValid ss)
+    OneOfSchema ss -> case ss of
+      s :| _ -> s : filter isValid (OneOfSchema <$> shrinkValid ss)
    CommentSchema k s -> (s :) $ do
      (k', s') <- shrinkValid (k, s)
      pure $ CommentSchema k' s'
@ -141,7 +145,15 @@ instance GenValid JSONSchema where
              choice2 <- resize b genValid
              rest <- resize c genValid
              pure $
-                ChoiceSchema $
+                AnyOfSchema $
+                  choice1 :| (choice2 : rest),
+            do
+              (a, b, c) <- genSplit3 (n -1)
+              choice1 <- resize a genValid
+              choice2 <- resize b genValid
+              rest <- resize c genValid
+              pure $
+                OneOfSchema $
                  choice1 :| (choice2 : rest),
            do
              (a, b) <- genSplit (n -1)
@ -155,7 +167,8 @@ instance GenValid JSONSchema where
 instance GenValid ObjectSchema where
  shrinkValid os = case os of
    ObjectAnySchema -> []
-    ObjectChoiceSchema ne@(s :| _) -> s : (ObjectChoiceSchema <$> shrinkValid ne)
+    ObjectAnyOfSchema ne@(s :| _) -> s : (ObjectAnyOfSchema <$> shrinkValid ne)
+    ObjectOneOfSchema ne@(s :| _) -> s : (ObjectOneOfSchema <$> shrinkValid ne)
    ObjectAllOfSchema ne@(s :| _) -> s : (ObjectAllOfSchema <$> shrinkValid ne)
    _ -> shrinkValidStructurallyWithoutExtraFiltering os
  genValid = oneof [pure ObjectAnySchema, go]
@ -163,7 +176,8 @@ instance GenValid ObjectSchema where
      go =
        oneof
          [ ObjectKeySchema <$> genValid <*> genValid <*> genValid <*> genValid,
-            ObjectChoiceSchema <$> genValid,
+            ObjectAnyOfSchema <$> genValid,
+            ObjectOneOfSchema <$> genValid,
            ObjectAllOfSchema <$> genValid
          ]

--- a/autodocodec-api-usage/test/Autodocodec/AesonSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/AesonSpec.hs
@ -92,6 +92,8 @@ spec = do
  aesonCodecSpec @VeryComment
  aesonCodecSpec @LegacyValue
  aesonCodecSpec @LegacyObject
+  aesonCodecSpec @Ainur
+  aesonCodecSpec @War

 aesonCodecErrorSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, HasCodec a) => FilePath -> LB.ByteString -> Spec
 aesonCodecErrorSpec filePath encoded =
--- a/autodocodec-api-usage/test/Autodocodec/OpenAPISpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/OpenAPISpec.hs
@ -80,6 +80,8 @@ spec = do
  openAPISchemaSpec @VeryComment "very-comment"
  openAPISchemaSpec @LegacyValue "legacy-value"
  openAPISchemaSpec @LegacyObject "legacy-object"
+  openAPISchemaSpec @Ainur "ainur"
+  openAPISchemaSpec @War "war"

 openAPISchemaSpec :: forall a. (Show a, Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 openAPISchemaSpec filePath =
--- a/autodocodec-api-usage/test/Autodocodec/ShowSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/ShowSpec.hs
@ -68,6 +68,8 @@ spec = do
  showCodecSpec @VeryComment "very-comment"
  showCodecSpec @LegacyValue "legacy-value"
  showCodecSpec @LegacyObject "legacy-object"
+  showCodecSpec @Ainur "ainur"
+  showCodecSpec @War "war"

 showCodecSpec :: forall a. (Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 showCodecSpec filePath =
--- a/autodocodec-api-usage/test/Autodocodec/SwaggerSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/SwaggerSpec.hs
@ -80,6 +80,8 @@ spec = do
  swaggerSchemaSpec @VeryComment "very-comment"
  swaggerSchemaSpec @LegacyValue "legacy-value"
  swaggerSchemaSpec @LegacyObject "legacy-object"
+  swaggerSchemaSpec @Ainur "ainur"
+  swaggerSchemaSpec @War "war"

 swaggerSchemaSpec :: forall a. (Show a, Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 swaggerSchemaSpec filePath =
--- a/autodocodec-api-usage/test/Autodocodec/Yaml/SchemaSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/Yaml/SchemaSpec.hs
@ -72,6 +72,8 @@ spec = do
  yamlSchemaSpec @VeryComment "very-comment"
  yamlSchemaSpec @LegacyValue "legacy-value"
  yamlSchemaSpec @LegacyObject "legacy-object"
+  yamlSchemaSpec @Ainur "ainur"
+  yamlSchemaSpec @War "war"

 yamlSchemaSpec :: forall a. (Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 yamlSchemaSpec filePath = do
--- a/autodocodec-api-usage/test/Autodocodec/YamlSpec.hs
+++ b/autodocodec-api-usage/test/Autodocodec/YamlSpec.hs
@ -73,6 +73,8 @@ spec = do
  yamlCodecSpec @VeryComment
  yamlCodecSpec @LegacyValue
  yamlCodecSpec @LegacyObject
+  yamlCodecSpec @Ainur
+  yamlCodecSpec @War

 yamlCodecSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, ToJSON a, FromJSON a, HasCodec a) => Spec
 yamlCodecSpec = describe (nameOf @a) $ do
--- a/autodocodec-api-usage/test_resources/error/either-bool-text-error-array.txt
+++ b/autodocodec-api-usage/test_resources/error/either-bool-text-error-array.txt
@ -1,3 +1,4 @@
 Error in $: 
-  Previous branch failure: Error in $: parsing HashMap ~Text failed, expected Object, but encountered Array
-parsing HashMap ~Text failed, expected Object, but encountered Array
+Both branches of a disjoint union failed: 
+Left:   Error in $: parsing HashMap ~Text failed, expected Object, but encountered Array
+Right:  Error in $: parsing HashMap ~Text failed, expected Object, but encountered Array
--- a/autodocodec-api-usage/test_resources/json-schema/ainur.json
+++ b/autodocodec-api-usage/test_resources/json-schema/ainur.json
@ -0,0 +1,35 @@
+{
+    "anyOf": [
+        {
+            "$comment": "Valar",
+            "required": [
+                "name",
+                "domain"
+            ],
+            "type": "object",
+            "properties": {
+                "domain": {
+                    "$comment": "Domain which the Valar rules over",
+                    "type": "string"
+                },
+                "name": {
+                    "$comment": "Name of the Valar",
+                    "type": "string"
+                }
+            }
+        },
+        {
+            "$comment": "Maiar",
+            "required": [
+                "name"
+            ],
+            "type": "object",
+            "properties": {
+                "name": {
+                    "$comment": "Name of the Maiar",
+                    "type": "string"
+                }
+            }
+        }
+    ]
+}
--- a/autodocodec-api-usage/test_resources/json-schema/either-bool-text.json
+++ b/autodocodec-api-usage/test_resources/json-schema/either-bool-text.json
@ -1,5 +1,5 @@
 {
-    "anyOf": [
+    "oneOf": [
        {
            "required": [
                "Left"
--- a/autodocodec-api-usage/test_resources/json-schema/either-either-bool-scientific-text.json
+++ b/autodocodec-api-usage/test_resources/json-schema/either-either-bool-scientific-text.json
@ -1,5 +1,5 @@
 {
-    "anyOf": [
+    "oneOf": [
        {
            "required": [
                "Left"
@ -7,7 +7,7 @@
            "type": "object",
            "properties": {
                "Left": {
-                    "anyOf": [
+                    "oneOf": [
                        {
                            "required": [
                                "Left"
--- a/autodocodec-api-usage/test_resources/json-schema/war.json
+++ b/autodocodec-api-usage/test_resources/json-schema/war.json
@ -0,0 +1,12 @@
+{
+    "oneOf": [
+        {
+            "maximum": 255,
+            "minimum": 0,
+            "type": "number"
+        },
+        {
+            "type": "string"
+        }
+    ]
+}
--- a/autodocodec-api-usage/test_resources/openapi-schema/ainur.json
+++ b/autodocodec-api-usage/test_resources/openapi-schema/ainur.json
@ -0,0 +1,52 @@
+{
+    "components": {
+        "schemas": {
+            "Ainur": {
+                "anyOf": [
+                    {
+                        "$ref": "#/components/schemas/Valar"
+                    },
+                    {
+                        "$ref": "#/components/schemas/Maiar"
+                    }
+                ],
+                "additionalProperties": true
+            },
+            "Valar": {
+                "required": [
+                    "domain",
+                    "name"
+                ],
+                "type": "object",
+                "properties": {
+                    "domain": {
+                        "type": "string",
+                        "description": "Domain which the Valar rules over"
+                    },
+                    "name": {
+                        "type": "string",
+                        "description": "Name of the Valar"
+                    }
+                }
+            },
+            "Maiar": {
+                "required": [
+                    "name"
+                ],
+                "type": "object",
+                "properties": {
+                    "name": {
+                        "type": "string",
+                        "description": "Name of the Maiar"
+                    }
+                }
+            }
+        }
+    },
+    "openapi": "3.0.0",
+    "info": {
+        "version": "",
+        "title": ""
+    },
+    "paths": {}
+}
--- a/autodocodec-api-usage/test_resources/openapi-schema/either-bool-text.json
+++ b/autodocodec-api-usage/test_resources/openapi-schema/either-bool-text.json
@ -2,7 +2,7 @@
    "components": {
        "schemas": {
            "(Either Bool Text)": {
-                "anyOf": [
+                "oneOf": [
                    {
                        "required": [
                            "Left"
@ -25,8 +25,7 @@
                            }
                        }
                    }
-                ],
-                "additionalProperties": true
+                ]
            }
        }
    },
--- a/autodocodec-api-usage/test_resources/openapi-schema/either-either-bool-scientific-text.json
+++ b/autodocodec-api-usage/test_resources/openapi-schema/either-either-bool-scientific-text.json
@ -2,7 +2,7 @@
    "components": {
        "schemas": {
            "(Either (Either Bool Scientific) Text)": {
-                "anyOf": [
+                "oneOf": [
                    {
                        "required": [
                            "Left"
@ -10,7 +10,7 @@
                        "type": "object",
                        "properties": {
                            "Left": {
-                                "anyOf": [
+                                "oneOf": [
                                    {
                                        "required": [
                                            "Left"
@ -33,8 +33,7 @@
                                            }
                                        }
                                    }
-                                ],
-                                "additionalProperties": true
+                                ]
                            }
                        }
                    },
@ -49,8 +48,7 @@
                            }
                        }
                    }
-                ],
-                "additionalProperties": true
+                ]
            }
        }
    },
--- a/autodocodec-api-usage/test_resources/openapi-schema/war.json
+++ b/autodocodec-api-usage/test_resources/openapi-schema/war.json
@ -0,0 +1,24 @@
+{
+    "components": {
+        "schemas": {
+            "War": {
+                "oneOf": [
+                    {
+                        "maximum": 255,
+                        "minimum": 0,
+                        "type": "number"
+                    },
+                    {
+                        "type": "string"
+                    }
+                ]
+            }
+        }
+    },
+    "openapi": "3.0.0",
+    "info": {
+        "version": "",
+        "title": ""
+    },
+    "paths": {}
+}
--- a/autodocodec-api-usage/test_resources/show-codec/ainur.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/ainur.txt
@ -0,0 +1 @@
+BimapCodec _ _ (EitherCodec PossiblyJointUnion (ObjectOfCodec (Just "Valar") (ApCodec (BimapCodec _ _ (RequiredKeyCodec "domain" (Just "Domain which the Valar rules over") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "name" (Just "Name of the Valar") (StringCodec Nothing))))) (ObjectOfCodec (Just "Maiar") (RequiredKeyCodec "name" (Just "Name of the Maiar") (StringCodec Nothing))))
--- a/autodocodec-api-usage/test_resources/show-codec/either-bool-text.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/either-bool-text.txt
@ -1 +1 @@
-EitherCodec (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (BoolCodec Nothing))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (StringCodec Nothing)))
+EitherCodec DisjointUnion (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (BoolCodec Nothing))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (StringCodec Nothing)))
--- a/autodocodec-api-usage/test_resources/show-codec/either-either-bool-scientific-text.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/either-either-bool-scientific-text.txt
@ -1 +1 @@
-EitherCodec (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (EitherCodec (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (BoolCodec Nothing))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (NumberCodec Nothing Nothing)))))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (StringCodec Nothing)))
+EitherCodec DisjointUnion (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (EitherCodec DisjointUnion (ObjectOfCodec Nothing (RequiredKeyCodec "Left" Nothing (BoolCodec Nothing))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (NumberCodec Nothing Nothing)))))) (ObjectOfCodec Nothing (RequiredKeyCodec "Right" Nothing (StringCodec Nothing)))
--- a/autodocodec-api-usage/test_resources/show-codec/example.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/example.txt
@ -1 +1 @@
-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))))))))))))
+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 PossiblyJointUnion 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 PossiblyJointUnion 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 PossiblyJointUnion (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 PossiblyJointUnion (BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))))))
--- a/autodocodec-api-usage/test_resources/show-codec/fruit.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/fruit.txt
@ -1 +1 @@
-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))))))))
+BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "Apple" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "Orange" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "Banana" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "Melon" (StringCodec Nothing))))))))
--- a/autodocodec-api-usage/test_resources/show-codec/legacy-object.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/legacy-object.txt
@ -1 +1 @@
-ObjectOfCodec (Just "LegacyObject") (ApCodec (ApCodec (ApCodec (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "1" (Just "text 1") (StringCodec Nothing)) (RequiredKeyCodec "1old" (Just "text 1") (StringCodec Nothing)))) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "2" (Just "text 2") (StringCodec Nothing)) (RequiredKeyCodec "2old" (Just "text 2") (StringCodec Nothing))))) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "3" (Just "text 3") (StringCodec Nothing)) (RequiredKeyCodec "3old" (Just "text 3") (StringCodec Nothing))))) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "newest" (Just "newest key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "newer" (Just "newer key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "new" (Just "new key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "old" (Just "old key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec (RequiredKeyCodec "older" (Just "older key") (StringCodec Nothing)) (RequiredKeyCodec "oldest" (Just "oldest key") (StringCodec Nothing)))))))))))))
+ObjectOfCodec (Just "LegacyObject") (ApCodec (ApCodec (ApCodec (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "1" (Just "text 1") (StringCodec Nothing)) (RequiredKeyCodec "1old" (Just "text 1") (StringCodec Nothing)))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "2" (Just "text 2") (StringCodec Nothing)) (RequiredKeyCodec "2old" (Just "text 2") (StringCodec Nothing))))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "3" (Just "text 3") (StringCodec Nothing)) (RequiredKeyCodec "3old" (Just "text 3") (StringCodec Nothing))))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "newest" (Just "newest key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "newer" (Just "newer key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "new" (Just "new key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "old" (Just "old key") (StringCodec Nothing)) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (RequiredKeyCodec "older" (Just "older key") (StringCodec Nothing)) (RequiredKeyCodec "oldest" (Just "oldest key") (StringCodec Nothing)))))))))))))
--- a/autodocodec-api-usage/test_resources/show-codec/legacy-value.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/legacy-value.txt
@ -1 +1 @@
-BimapCodec _ _ (EitherCodec (ObjectOfCodec (Just "LegacyValue") (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "1" (Just "text 1") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "2" (Just "text 2") (StringCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "3" (Just "text 3") (StringCodec Nothing))))) (ObjectOfCodec (Just "LegacyValue") (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "1old" (Just "text 1") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "2old" (Just "text 2") (StringCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "3old" (Just "text 3") (StringCodec Nothing))))))
+BimapCodec _ _ (EitherCodec PossiblyJointUnion (ObjectOfCodec (Just "LegacyValue") (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "1" (Just "text 1") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "2" (Just "text 2") (StringCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "3" (Just "text 3") (StringCodec Nothing))))) (ObjectOfCodec (Just "LegacyValue") (ApCodec (ApCodec (BimapCodec _ _ (RequiredKeyCodec "1old" (Just "text 1") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "2old" (Just "text 2") (StringCodec Nothing)))) (BimapCodec _ _ (RequiredKeyCodec "3old" (Just "text 3") (StringCodec Nothing))))))
--- a/autodocodec-api-usage/test_resources/show-codec/maybe-text.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/maybe-text.txt
@ -1 +1 @@
-BimapCodec _ _ (EitherCodec NullCodec (StringCodec Nothing))
+BimapCodec _ _ (EitherCodec PossiblyJointUnion NullCodec (StringCodec Nothing))
--- a/autodocodec-api-usage/test_resources/show-codec/ordering.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/ordering.txt
@ -1 +1 @@
-BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "LT" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec (BimapCodec _ _ (EqCodec "EQ" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "GT" (StringCodec Nothing))))))
+BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "LT" (StringCodec Nothing))) (BimapCodec _ _ (EitherCodec PossiblyJointUnion (BimapCodec _ _ (EqCodec "EQ" (StringCodec Nothing))) (BimapCodec _ _ (EqCodec "GT" (StringCodec Nothing))))))
--- a/autodocodec-api-usage/test_resources/show-codec/recursive.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/recursive.txt
@ -1 +1 @@
-ReferenceCodec "recursive" (BimapCodec _ _ (EitherCodec (CommentCodec "base case" (BimapCodec _ _ (NumberCodec Nothing (Just (NumberBounds {numberBoundsLower = -9.223372036854775808e18, numberBoundsUpper = 9.223372036854775807e18}))))) (ObjectOfCodec (Just "Recurse") (RequiredKeyCodec "recurse" (Just "recursive case") (ReferenceCodec "recursive")))))
+ReferenceCodec "recursive" (BimapCodec _ _ (EitherCodec PossiblyJointUnion (CommentCodec "base case" (BimapCodec _ _ (NumberCodec Nothing (Just (NumberBounds {numberBoundsLower = -9.223372036854775808e18, numberBoundsUpper = 9.223372036854775807e18}))))) (ObjectOfCodec (Just "Recurse") (RequiredKeyCodec "recurse" (Just "recursive case") (ReferenceCodec "recursive")))))
--- a/autodocodec-api-usage/test_resources/show-codec/war.txt
+++ b/autodocodec-api-usage/test_resources/show-codec/war.txt
@ -0,0 +1 @@
+BimapCodec _ _ (EitherCodec DisjointUnion (BimapCodec _ _ (NumberCodec Nothing (Just (NumberBounds {numberBoundsLower = 0.0, numberBoundsUpper = 255.0})))) (StringCodec Nothing))
--- a/autodocodec-api-usage/test_resources/swagger-schema/ainur.json
+++ b/autodocodec-api-usage/test_resources/swagger-schema/ainur.json
@ -0,0 +1,25 @@
+{
+    "swagger": "2.0",
+    "info": {
+        "version": "",
+        "title": ""
+    },
+    "definitions": {
+        "Ainur": {
+            "required": [
+                "name"
+            ],
+            "type": "object",
+            "properties": {
+                "domain": {
+                    "type": "string",
+                    "description": "Domain which the Valar rules over"
+                },
+                "name": {
+                    "type": "string",
+                    "description": "Name of the Valar"
+                }
+            }
+        }
+    }
+}
--- a/autodocodec-api-usage/test_resources/swagger-schema/war.json
+++ b/autodocodec-api-usage/test_resources/swagger-schema/war.json
@ -0,0 +1,10 @@
+{
+    "swagger": "2.0",
+    "info": {
+        "version": "",
+        "title": ""
+    },
+    "definitions": {
+        "War": {}
+    }
+}
--- a/autodocodec-api-usage/test_resources/yaml-schema/ainur.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/ainur.txt
@ -0,0 +1,13 @@
+# [32many of[m
+[ # Valar
+  [37mdomain[m: # [31mrequired[m
+    # Domain which the Valar rules over
+    [33m<string>[m
+  [37mname[m: # [31mrequired[m
+    # Name of the Valar
+    [33m<string>[m
+, # Maiar
+  [37mname[m: # [31mrequired[m
+    # Name of the Maiar
+    [33m<string>[m
+]
--- a/autodocodec-api-usage/test_resources/yaml-schema/either-bool-text.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/either-bool-text.txt
@ -1,3 +1,4 @@
+# [32mone of[m
 [ [37mLeft[m: # [31mrequired[m
    [33m<boolean>[m
 , [37mRight[m: # [31mrequired[m
--- a/autodocodec-api-usage/test_resources/yaml-schema/either-either-bool-scientific-text.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/either-either-bool-scientific-text.txt
@ -1,4 +1,6 @@
+# [32mone of[m
 [ [37mLeft[m: # [31mrequired[m
+    # [32mone of[m
    [ [37mLeft[m: # [31mrequired[m
        [33m<boolean>[m
    , [37mRight[m: # [31mrequired[m
--- a/autodocodec-api-usage/test_resources/yaml-schema/example.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/example.txt
@ -7,6 +7,7 @@
  [33m<boolean>[m
 [37mmaybe[m: # [31mrequired[m
  # a maybe text
+  # [32many of[m
  [ [33mnull[m
  , [33m<string>[m
  ]
@ -15,6 +16,7 @@
  [33m<string>[m
 [37moptional-or-null[m: # [34moptional[m
  # an optional-or-null text
+  # [32many of[m
  [ [33mnull[m
  , [33m<string>[m
  ]
@ -29,11 +31,13 @@
 [37msingle-or-list[m: # [34moptional[m
  # default: [35m[][m
  # an optional list that can also be specified as a single element
+  # [32many of[m
  [ [33m<string>[m
  , - [33m<string>[m
  ]
 [37mfruit[m: # [31mrequired[m
  # fruit!!
+  # [32many of[m
  [ Apple
  , Orange
  , Banana
--- a/autodocodec-api-usage/test_resources/yaml-schema/fruit.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/fruit.txt
@ -1,3 +1,4 @@
+# [32many of[m
 [ Apple
 , Orange
 , Banana
--- a/autodocodec-api-usage/test_resources/yaml-schema/legacy-object.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/legacy-object.txt
@ -1,4 +1,5 @@
 # LegacyObject
+# [32many of[m
 [ [37m1[m: # [31mrequired[m
    # text 1
    [33m<string>[m
@ -6,6 +7,7 @@
    # text 1
    [33m<string>[m
 ]
+# [32many of[m
 [ [37m2[m: # [31mrequired[m
    # text 2
    [33m<string>[m
@ -13,6 +15,7 @@
    # text 2
    [33m<string>[m
 ]
+# [32many of[m
 [ [37m3[m: # [31mrequired[m
    # text 3
    [33m<string>[m
@ -20,6 +23,7 @@
    # text 3
    [33m<string>[m
 ]
+# [32many of[m
 [ [37mnewest[m: # [31mrequired[m
    # newest key
    [33m<string>[m
--- a/autodocodec-api-usage/test_resources/yaml-schema/legacy-value.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/legacy-value.txt
@ -1,3 +1,4 @@
+# [32many of[m
 [ # LegacyValue
  [37m1[m: # [31mrequired[m
    # text 1
--- a/autodocodec-api-usage/test_resources/yaml-schema/maybe-text.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/maybe-text.txt
@ -1,3 +1,4 @@
+# [32many of[m
 [ [33mnull[m
 , [33m<string>[m
 ]
--- a/autodocodec-api-usage/test_resources/yaml-schema/ordering.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/ordering.txt
@ -1,3 +1,4 @@
+# [32many of[m
 [ LT
 , EQ
 , GT
--- a/autodocodec-api-usage/test_resources/yaml-schema/recursive.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/recursive.txt
@ -1,4 +1,5 @@
 [36mdef: recursive[m
+# [32many of[m
 [ # base case
  [33m<number>[m # between [32m-9223372036854775808[m and [32m9223372036854775807[m
 , # Recurse
--- a/autodocodec-api-usage/test_resources/yaml-schema/war.txt
+++ b/autodocodec-api-usage/test_resources/yaml-schema/war.txt
@ -0,0 +1,4 @@
+# [32mone of[m
+[ [33m<number>[m # between [32m0[m and [32m255[m
+, [33m<string>[m
+]
--- a/autodocodec-openapi3/CHANGELOG.md
+++ b/autodocodec-openapi3/CHANGELOG.md
@ -1,5 +1,11 @@
 # Changelog

+## [0.0.1.0] - 2021-12-23
+
+### Added
+
+* `disjointEitherCodec` now no longer generates `additionalProperties = true` and uses `oneOf` instead of `anyOf`.
+
 ## [0.0.0.0] - 2021-11-19

 First release.
--- a/autodocodec-openapi3/autodocodec-openapi3.cabal
+++ b/autodocodec-openapi3/autodocodec-openapi3.cabal
@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.34.5.
 --
 -- see: https://github.com/sol/hpack

 name:           autodocodec-openapi3
-version:        0.0.0.0
+version:        0.0.1.0
 synopsis:       Autodocodec interpreters for openapi3
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues
@ -37,6 +37,7 @@ library
    , autodocodec
    , base >=4.7 && <5
    , insert-ordered-containers
+    , lens
    , openapi3
    , scientific
    , text
--- a/autodocodec-openapi3/package.yaml
+++ b/autodocodec-openapi3/package.yaml
@ -1,5 +1,5 @@
 name: autodocodec-openapi3
-version: 0.0.0.0
+version: 0.0.1.0
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"
@ -20,6 +20,7 @@ library:
  - aeson
  - autodocodec
  - insert-ordered-containers
-  - scientific
+  - lens
  - openapi3
+  - scientific
  - text
--- a/autodocodec-openapi3/src/Autodocodec/OpenAPI/Schema.hs
+++ b/autodocodec-openapi3/src/Autodocodec/OpenAPI/Schema.hs
@ -10,6 +10,7 @@
 module Autodocodec.OpenAPI.Schema where

 import Autodocodec
+import Control.Lens (Lens', (&), (?~), (^.))
 import Control.Monad
 import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Data.OpenApi as OpenAPI
@ -86,10 +87,10 @@ declareNamedSchemaVia c' Proxy = go c'
      ObjectOfCodec mname oc -> do
        ss <- goObject oc
        pure $ NamedSchema mname $ combineObjectSchemas ss
-      EitherCodec c1 c2 -> do
+      EitherCodec u c1 c2 -> do
        ns1 <- go c1
        ns2 <- go c2
-        combineSchemasOr ns1 ns2
+        combineSchemasOr u ns1 ns2
      CommentCodec t c -> do
        NamedSchema mName s <- go c
        pure $ NamedSchema mName $ addDoc t s
@ -137,11 +138,12 @@ declareNamedSchemaVia c' Proxy = go c'
          ]
      OptionalKeyWithOmittedDefaultCodec key vs defaultValue mDoc -> goObject (OptionalKeyWithDefaultCodec key vs defaultValue mDoc)
      PureCodec _ -> pure []
-      EitherCodec oc1 oc2 -> do
+      EitherCodec u oc1 oc2 -> do
        s1s <- goObject oc1
        s2s <- goObject oc2
        (: []) . _namedSchemaSchema
          <$> combineSchemasOr
+            u
            (NamedSchema Nothing (combineObjectSchemas s1s))
            (NamedSchema Nothing (combineObjectSchemas s2s))
      ApCodec oc1 oc2 -> do
@ -160,19 +162,28 @@ declareNamedSchemaVia c' Proxy = go c'
        }
    combineObjectSchemas :: [Schema] -> Schema
    combineObjectSchemas = mconcat
-    combineSchemasOr :: NamedSchema -> NamedSchema -> Declare (Definitions Schema) NamedSchema
-    combineSchemasOr ns1 ns2 = do
+    combineSchemasOr :: Union -> NamedSchema -> NamedSchema -> Declare (Definitions Schema) NamedSchema
+    combineSchemasOr u ns1 ns2 = do
      let s1 = _namedSchemaSchema ns1
      let s2 = _namedSchemaSchema ns2
      s1Ref <- fmap _namedSchemaSchema <$> declareSpecificNamedSchemaRef ns1
      s2Ref <- fmap _namedSchemaSchema <$> declareSpecificNamedSchemaRef ns2
-      let prototype = mempty {_schemaAdditionalProperties = Just $ AdditionalPropertiesAllowed True}
+      let orLens :: Lens' Schema (Maybe [Referenced Schema])
+          orLens = case u of
+            PossiblyJointUnion -> anyOf
+            DisjointUnion -> oneOf
+      let prototype =
+            mempty
+              { _schemaAdditionalProperties = case u of
+                  PossiblyJointUnion -> Just $ AdditionalPropertiesAllowed True
+                  DisjointUnion -> Nothing
+              }
      pure $
-        NamedSchema Nothing $ case (_schemaAnyOf s1, _schemaAnyOf s2) of
-          (Just s1s, Just s2s) -> prototype {_schemaAnyOf = Just $ s1s ++ s2s}
-          (Just s1s, Nothing) -> prototype {_schemaAnyOf = Just $ s1s ++ [s2Ref]}
-          (Nothing, Just s2s) -> prototype {_schemaAnyOf = Just $ s1Ref : s2s}
-          (Nothing, Nothing) -> prototype {_schemaAnyOf = Just [s1Ref, s2Ref]}
+        NamedSchema Nothing $ case (s1 ^. orLens, s2 ^. orLens) of
+          (Just s1s, Just s2s) -> prototype & orLens ?~ (s1s ++ s2s)
+          (Just s1s, Nothing) -> prototype & orLens ?~ (s1s ++ [s2Ref])
+          (Nothing, Just s2s) -> prototype & orLens ?~ (s1Ref : s2s)
+          (Nothing, Nothing) -> prototype & orLens ?~ [s1Ref, s2Ref]

 declareSpecificNamedSchemaRef :: OpenAPI.NamedSchema -> Declare (Definitions Schema) (Referenced NamedSchema)
 declareSpecificNamedSchemaRef namedSchema =
--- a/autodocodec-schema/CHANGELOG.md
+++ b/autodocodec-schema/CHANGELOG.md
@ -1,5 +1,15 @@
 # Changelog

+## [0.1.0.0] - 2021-12-21
+
+### Added
+
+* Support for `autodocodec-0.0.1.0`.
+
+### Changed
+
+* `ChoiceSchema` has been split into `OneOfSchema` and `AnyOfSchema`
+
 ## [0.0.0.0] - 2021-11-19

 First release.
--- a/autodocodec-schema/autodocodec-schema.cabal
+++ b/autodocodec-schema/autodocodec-schema.cabal
@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.34.5.
 --
 -- see: https://github.com/sol/hpack

 name:           autodocodec-schema
-version:        0.0.0.0
+version:        0.1.0.0
 synopsis:       Autodocodec interpreters for JSON Schema
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues
@ -32,7 +32,7 @@ library
      src
  build-depends:
      aeson
-    , autodocodec
+    , autodocodec >=0.0.1.0
    , base >=4.7 && <5
    , containers
    , mtl
--- a/autodocodec-schema/package.yaml
+++ b/autodocodec-schema/package.yaml
@ -1,5 +1,5 @@
 name: autodocodec-schema
-version: 0.0.0.0
+version: 0.1.0.0
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"
@ -18,7 +18,7 @@ library:
  source-dirs: src
  dependencies:
  - aeson
-  - autodocodec
+  - autodocodec >=0.0.1.0
  - containers
  - mtl
  - text
--- a/autodocodec-schema/src/Autodocodec/Schema.hs
+++ b/autodocodec-schema/src/Autodocodec/Schema.hs
@ -48,7 +48,8 @@ data JSONSchema
  | -- | This needs to be a list because keys should stay in their original ordering.
    ObjectSchema ObjectSchema
  | ValueSchema !JSON.Value
-  | ChoiceSchema !(NonEmpty JSONSchema)
+  | AnyOfSchema !(NonEmpty JSONSchema)
+  | OneOfSchema !(NonEmpty JSONSchema)
  | CommentSchema !Text !JSONSchema
  | RefSchema !Text
  | WithDefSchema !(Map Text JSONSchema) !JSONSchema
@ -62,7 +63,8 @@ instance Validity JSONSchema where
          CommentSchema _ (CommentSchema _ _) -> False
          _ -> True,
        case js of
-          ChoiceSchema cs -> declare "there are 2 of more choices" $ length cs >= 2
+          AnyOfSchema cs -> declare "there are 2 of more choices" $ length cs >= 2
+          OneOfSchema cs -> declare "there are 2 of more choices" $ length cs >= 2
          _ -> valid
      ]

@ -90,12 +92,18 @@ instance ToJSON JSONSchema where
          case toJSON os of
            JSON.Object o -> HM.toList o
            _ -> [] -- Should not happen.
-        ChoiceSchema jcs ->
+        AnyOfSchema jcs ->
          let svals :: [JSON.Value]
              svals = map (JSON.object . go) (NE.toList jcs)
              val :: JSON.Value
              val = (JSON.toJSON :: [JSON.Value] -> JSON.Value) svals
           in [("anyOf", val)]
+        OneOfSchema jcs ->
+          let svals :: [JSON.Value]
+              svals = map (JSON.object . go) (NE.toList jcs)
+              val :: JSON.Value
+              val = (JSON.toJSON :: [JSON.Value] -> JSON.Value) svals
+           in [("oneOf", val)]
        (CommentSchema outerComment (CommentSchema innerComment s)) ->
          go (CommentSchema (outerComment <> "\n" <> innerComment) s)
        CommentSchema comment s -> ("$comment" JSON..= comment) : go s
@ -133,25 +141,30 @@ instance FromJSON JSONSchema where
      Nothing -> do
        mAny <- o JSON..:? "anyOf"
        case mAny of
-          Just anies -> pure $ ChoiceSchema anies
+          Just anies -> pure $ AnyOfSchema anies
          Nothing -> do
-            let mConst = HM.lookup "const" o
-            case mConst of
-              Just constant -> pure $ ValueSchema constant
+            mOne <- o JSON..:? "oneOf"
+            case mOne of
+              Just ones -> pure $ OneOfSchema ones
              Nothing -> do
-                mRef <- o JSON..:? "$ref"
-                pure $ case mRef of
-                  Just ref -> case T.stripPrefix defsPrefix ref of
-                    Just name -> RefSchema name
-                    Nothing -> AnySchema
-                  Nothing -> AnySchema
+                let mConst = HM.lookup "const" o
+                case mConst of
+                  Just constant -> pure $ ValueSchema constant
+                  Nothing -> do
+                    mRef <- o JSON..:? "$ref"
+                    pure $ case mRef of
+                      Just ref -> case T.stripPrefix defsPrefix ref of
+                        Just name -> RefSchema name
+                        Nothing -> AnySchema
+                      Nothing -> AnySchema
      t -> fail $ "unknown schema type:" <> show t

 data ObjectSchema
-  = ObjectKeySchema Text KeyRequirement JSONSchema (Maybe Text)
+  = ObjectKeySchema !Text !KeyRequirement !JSONSchema !(Maybe Text)
  | ObjectAnySchema -- For 'pure'
-  | ObjectChoiceSchema (NonEmpty ObjectSchema)
-  | ObjectAllOfSchema (NonEmpty ObjectSchema)
+  | ObjectAnyOfSchema !(NonEmpty ObjectSchema)
+  | ObjectOneOfSchema !(NonEmpty ObjectSchema)
+  | ObjectAllOfSchema !(NonEmpty ObjectSchema)
  deriving (Show, Eq, Generic)

 instance Validity ObjectSchema
@ -171,26 +184,32 @@ instance FromJSON ObjectSchema where
          Nothing -> do
            mAnyOf <- o JSON..:? "anyOf"
            case mAnyOf of
-              Just ao -> do
-                ne <- parseJSON ao
-                ObjectChoiceSchema <$> mapM go ne
+              Just anies -> do
+                ne <- parseJSON anies
+                ObjectAnyOfSchema <$> mapM go ne
              Nothing -> do
-                props <- o JSON..:? "properties" JSON..!= HM.empty
-                reqs <- o JSON..:? "required" JSON..!= []
-                let keySchemaFor k v = do
-                      ks <- parseJSON v
-                      let (mDoc, ks') = case ks of
-                            CommentSchema doc ks'' -> (Just doc, ks'')
-                            _ -> (Nothing, ks)
-                      pure $
-                        if k `elem` reqs
-                          then ObjectKeySchema k Required ks' mDoc
-                          else ObjectKeySchema k (Optional Nothing) ks' mDoc
-                keySchemas <- mapM (uncurry keySchemaFor) (HM.toList props)
-                pure $ case NE.nonEmpty keySchemas of
-                  Nothing -> ObjectAnySchema
-                  Just (el :| []) -> el
-                  Just ne -> ObjectAllOfSchema ne
+                mOneOf <- o JSON..:? "oneOf"
+                case mOneOf of
+                  Just ones -> do
+                    ne <- parseJSON ones
+                    ObjectOneOfSchema <$> mapM go ne
+                  Nothing -> do
+                    props <- o JSON..:? "properties" JSON..!= HM.empty
+                    reqs <- o JSON..:? "required" JSON..!= []
+                    let keySchemaFor k v = do
+                          ks <- parseJSON v
+                          let (mDoc, ks') = case ks of
+                                CommentSchema doc ks'' -> (Just doc, ks'')
+                                _ -> (Nothing, ks)
+                          pure $
+                            if k `elem` reqs
+                              then ObjectKeySchema k Required ks' mDoc
+                              else ObjectKeySchema k (Optional Nothing) ks' mDoc
+                    keySchemas <- mapM (uncurry keySchemaFor) (HM.toList props)
+                    pure $ case NE.nonEmpty keySchemas of
+                      Nothing -> ObjectAnySchema
+                      Just (el :| []) -> el
+                      Just ne -> ObjectAllOfSchema ne

 instance ToJSON ObjectSchema where
  toJSON = JSON.object . (("type" JSON..= ("object" :: Text)) :) . go
@ -202,7 +221,8 @@ instance ToJSON ObjectSchema where
          let (propVal, req) = keySchemaToPieces (k, kr, ks, mDoc)
           in -- TODO deal with the default value somehow.
              concat [["properties" JSON..= JSON.object [k JSON..= propVal]], ["required" JSON..= [k] | req]]
-        ObjectChoiceSchema ne -> ["anyOf" JSON..= NE.map toJSON ne]
+        ObjectAnyOfSchema ne -> ["anyOf" JSON..= NE.map toJSON ne]
+        ObjectOneOfSchema ne -> ["oneOf" JSON..= NE.map toJSON ne]
        ObjectAllOfSchema ne ->
          case mapM parseAndObjectKeySchema (NE.toList ne) of
            Nothing -> ["allOf" JSON..= NE.map toJSON ne]
@ -239,7 +259,8 @@ validateAccordingTo val schema = (`evalState` M.empty) $ go val schema
          Optional _ -> pure True
        Just value' -> go value' ks
      ObjectAllOfSchema ne -> and <$> mapM (goObject obj) ne
-      ObjectChoiceSchema ne -> or <$> mapM (goObject obj) ne
+      ObjectAnyOfSchema ne -> or <$> mapM (goObject obj) ne
+      ObjectOneOfSchema ne -> (== 1) . length . NE.filter id <$> mapM (goObject obj) ne

    go :: JSON.Value -> JSONSchema -> State (Map Text JSONSchema) Bool
    go value = \case
@ -266,7 +287,8 @@ validateAccordingTo val schema = (`evalState` M.empty) $ go val schema
        JSON.Object obj -> goObject obj os
        _ -> pure False
      ValueSchema v -> pure $ v == value
-      ChoiceSchema ss -> or <$> mapM (go value) ss
+      AnyOfSchema ss -> or <$> mapM (go value) ss
+      OneOfSchema ss -> (== 1) . length . NE.filter id <$> mapM (go value) ss
      CommentSchema _ s -> go value s
      RefSchema name -> do
        mSchema <- gets (M.lookup name)
@ -279,7 +301,7 @@ validateAccordingTo val schema = (`evalState` M.empty) $ go val schema

 data KeyRequirement
  = Required
-  | Optional (Maybe JSON.Value) -- Default value
+  | Optional !(Maybe JSON.Value) -- Default value
  deriving (Show, Eq, Generic)

 instance Validity KeyRequirement
@ -306,10 +328,12 @@ jsonSchemaVia = (`evalState` S.empty) . go
      MapCodec c -> MapSchema <$> go c
      ValueCodec -> pure AnySchema
      EqCodec value c -> pure $ ValueSchema (toJSONVia c value)
-      EitherCodec c1 c2 -> do
+      EitherCodec u c1 c2 -> do
        s1 <- go c1
        s2 <- go c2
-        pure $ ChoiceSchema (goChoice (s1 :| [s2]))
+        pure $ case u of
+          DisjointUnion -> OneOfSchema (goOneOf (s1 :| [s2]))
+          PossiblyJointUnion -> AnyOfSchema (goAnyOf (s1 :| [s2]))
      BimapCodec _ _ c -> go c
      CommentCodec t c -> CommentSchema t <$> go c
      ReferenceCodec name c -> do
@ -321,14 +345,23 @@ jsonSchemaVia = (`evalState` S.empty) . go
            s <- go c
            pure $ WithDefSchema (M.singleton name s) (RefSchema name)

-    goChoice :: NonEmpty JSONSchema -> NonEmpty JSONSchema
-    goChoice (s :| rest) = case NE.nonEmpty rest of
+    goAnyOf :: NonEmpty JSONSchema -> NonEmpty JSONSchema
+    goAnyOf (s :| rest) = case NE.nonEmpty rest of
      Nothing -> goSingle s
-      Just ne -> goSingle s <> goChoice ne
+      Just ne -> goSingle s <> goAnyOf ne
      where
        goSingle :: JSONSchema -> NonEmpty JSONSchema
        goSingle = \case
-          ChoiceSchema ss -> goChoice ss
+          AnyOfSchema ss -> goAnyOf ss
+          s' -> s' :| []
+    goOneOf :: NonEmpty JSONSchema -> NonEmpty JSONSchema
+    goOneOf (s :| rest) = case NE.nonEmpty rest of
+      Nothing -> goSingle s
+      Just ne -> goSingle s <> goOneOf ne
+      where
+        goSingle :: JSONSchema -> NonEmpty JSONSchema
+        goSingle = \case
+          OneOfSchema ss -> goOneOf ss
          s' -> s' :| []

    goObject :: ObjectCodec input output -> State (Set Text) ObjectSchema
@ -344,24 +377,36 @@ jsonSchemaVia = (`evalState` S.empty) . go
        pure $ ObjectKeySchema k (Optional (Just (toJSONVia c mr))) s mdoc
      OptionalKeyWithOmittedDefaultCodec k c defaultValue mDoc -> goObject (OptionalKeyWithDefaultCodec k c defaultValue mDoc)
      BimapCodec _ _ c -> goObject c
-      EitherCodec oc1 oc2 -> do
+      EitherCodec u oc1 oc2 -> do
        os1 <- goObject oc1
        os2 <- goObject oc2
-        pure $ ObjectChoiceSchema (goObjectChoice (os1 :| [os2]))
+        pure $ case u of
+          DisjointUnion -> ObjectOneOfSchema (goObjectOneOf (os1 :| [os2]))
+          PossiblyJointUnion -> ObjectAnyOfSchema (goObjectAnyOf (os1 :| [os2]))
      PureCodec _ -> pure ObjectAnySchema
      ApCodec oc1 oc2 -> do
        os1 <- goObject oc1
        os2 <- goObject oc2
        pure $ ObjectAllOfSchema (goObjectAllOf (os1 :| [os2]))

-    goObjectChoice :: NonEmpty ObjectSchema -> NonEmpty ObjectSchema
-    goObjectChoice (s :| rest) = case NE.nonEmpty rest of
+    goObjectAnyOf :: NonEmpty ObjectSchema -> NonEmpty ObjectSchema
+    goObjectAnyOf (s :| rest) = case NE.nonEmpty rest of
      Nothing -> goSingle s
-      Just ne -> goSingle s <> goObjectChoice ne
+      Just ne -> goSingle s <> goObjectAnyOf ne
      where
        goSingle :: ObjectSchema -> NonEmpty ObjectSchema
        goSingle = \case
-          ObjectChoiceSchema ss -> goObjectChoice ss
+          ObjectAnyOfSchema ss -> goObjectAnyOf ss
+          s' -> s' :| []
+
+    goObjectOneOf :: NonEmpty ObjectSchema -> NonEmpty ObjectSchema
+    goObjectOneOf (s :| rest) = case NE.nonEmpty rest of
+      Nothing -> goSingle s
+      Just ne -> goSingle s <> goObjectOneOf ne
+      where
+        goSingle :: ObjectSchema -> NonEmpty ObjectSchema
+        goSingle = \case
+          ObjectOneOfSchema ss -> goObjectOneOf ss
          s' -> s' :| []

    goObjectAllOf :: NonEmpty ObjectSchema -> NonEmpty ObjectSchema
--- a/autodocodec-swagger2/CHANGELOG.md
+++ b/autodocodec-swagger2/CHANGELOG.md
@ -1,5 +1,11 @@
 # Changelog

+## [0.0.1.0] - 2021-11-19
+
+### Added
+
+* `disjointEitherCodec` now does not generate `additionalProperties = true`.
+
 ## [0.0.0.0] - 2021-11-19

 First release.
--- a/autodocodec-swagger2/autodocodec-swagger2.cabal
+++ b/autodocodec-swagger2/autodocodec-swagger2.cabal
@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.34.5.
 --
 -- see: https://github.com/sol/hpack

 name:           autodocodec-swagger2
-version:        0.0.0.0
+version:        0.0.1.0
 synopsis:       Autodocodec interpreters for swagger2
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues
@ -34,7 +34,7 @@ library
      src
  build-depends:
      aeson
-    , autodocodec
+    , autodocodec >=0.0.1.0
    , base >=4.7 && <5
    , insert-ordered-containers
    , scientific
--- a/autodocodec-swagger2/package.yaml
+++ b/autodocodec-swagger2/package.yaml
@ -1,5 +1,5 @@
 name: autodocodec-swagger2
-version: 0.0.0.0
+version: 0.0.1.0
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"
@ -18,7 +18,7 @@ library:
  source-dirs: src
  dependencies:
  - aeson
-  - autodocodec
+  - autodocodec >=0.0.1.0
  - insert-ordered-containers
  - scientific
  - swagger2
--- a/autodocodec-swagger2/src/Autodocodec/Swagger/Schema.hs
+++ b/autodocodec-swagger2/src/Autodocodec/Swagger/Schema.hs
@ -104,12 +104,12 @@ declareNamedSchemaVia c' Proxy = go c'
              { _schemaParamSchema = mempty {_paramSchemaEnum = Just [toJSONVia valCodec val]}
              }
      BimapCodec _ _ c -> go c
-      EitherCodec c1 c2 -> do
+      EitherCodec u c1 c2 -> do
        ns1 <- go c1
        let s1 = _namedSchemaSchema ns1
        ns2 <- go c2
        let s2 = _namedSchemaSchema ns2
-        pure $ NamedSchema Nothing $ combineSchemaOr s1 s2
+        pure $ NamedSchema Nothing $ combineSchemaOr u s1 s2
      CommentCodec t c -> do
        NamedSchema mName s <- go c
        pure $ NamedSchema mName $ addDoc t s
@ -160,10 +160,10 @@ declareNamedSchemaVia c' Proxy = go c'
          ]
      OptionalKeyWithOmittedDefaultCodec key vs defaultValue mDoc -> goObject (OptionalKeyWithDefaultCodec key vs defaultValue mDoc)
      PureCodec _ -> pure []
-      EitherCodec oc1 oc2 -> do
+      EitherCodec u oc1 oc2 -> do
        ss1 <- goObject oc1
        ss2 <- goObject oc2
-        pure [combineSchemaOr (combineObjectSchemas ss1) (combineObjectSchemas ss2)]
+        pure [combineSchemaOr u (combineObjectSchemas ss1) (combineObjectSchemas ss2)]
      ApCodec oc1 oc2 -> do
        ss1 <- goObject oc1
        ss2 <- goObject oc2
@ -180,8 +180,8 @@ declareNamedSchemaVia c' Proxy = go c'
        }
    combineObjectSchemas :: [Schema] -> Schema
    combineObjectSchemas = mconcat
-    combineSchemaOr :: Schema -> Schema -> Schema
-    combineSchemaOr s1 s2 =
+    combineSchemaOr :: Union -> Schema -> Schema -> Schema
+    combineSchemaOr u s1 s2 =
      let ps1 = _schemaParamSchema s1
          ps2 = _schemaParamSchema s2
          -- Swagger 2 doesn't support sum types so we have to work around that here.
@ -195,7 +195,9 @@ declareNamedSchemaVia c' Proxy = go c'
          -- the schema: one which lets any value through.
          overApproximation =
            mempty
-              { _schemaAdditionalProperties = Just $ AdditionalPropertiesAllowed True
+              { _schemaAdditionalProperties = case u of
+                  PossiblyJointUnion -> Just $ AdditionalPropertiesAllowed True
+                  DisjointUnion -> Nothing
              }
       in case (,) <$> _paramSchemaEnum ps1 <*> _paramSchemaEnum ps2 of
            (Just (es1, es2)) ->
--- a/autodocodec-yaml/CHANGELOG.md
+++ b/autodocodec-yaml/CHANGELOG.md
@ -1,5 +1,11 @@
 # Changelog

+## [0.1.0.0] - 2021-12-23
+
+### Changed
+
+* Support for `autodocodec-schema >=0.1.0.0` with comments for `anyOf` and `oneOf`.
+
 ## [0.0.0.0] - 2021-11-19

 First release.
--- a/autodocodec-yaml/autodocodec-yaml.cabal
+++ b/autodocodec-yaml/autodocodec-yaml.cabal
@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.34.5.
 --
 -- see: https://github.com/sol/hpack

 name:           autodocodec-yaml
-version:        0.0.0.0
+version:        0.0.1.0
 synopsis:       Autodocodec interpreters for yaml
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues
@ -35,7 +35,7 @@ library
      src
  build-depends:
      autodocodec
-    , autodocodec-schema
+    , autodocodec-schema >=0.1.0.0
    , base >=4.7 && <5
    , bytestring
    , containers
--- a/autodocodec-yaml/package.yaml
+++ b/autodocodec-yaml/package.yaml
@ -1,5 +1,5 @@
 name: autodocodec-yaml
-version: 0.0.0.0
+version: 0.0.1.0
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"
@ -18,7 +18,7 @@ library:
  source-dirs: src
  dependencies:
  - autodocodec
-  - autodocodec-schema
+  - autodocodec-schema >=0.1.0.0
  - bytestring
  - containers
  - path
--- a/autodocodec-yaml/src/Autodocodec/Yaml/Encode.hs
+++ b/autodocodec-yaml/src/Autodocodec/Yaml/Encode.hs
@ -42,7 +42,7 @@ toYamlVia = flip go
      ValueCodec -> yamlValue (a :: JSON.Value)
      EqCodec value c -> go value c
      BimapCodec _ g c -> go (g a) c
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> go a1 c1
        Right a2 -> go a2 c2
      CommentCodec _ c -> go a c
@ -60,7 +60,7 @@ toYamlVia = flip go
          then []
          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mDoc)
      BimapCodec _ g c -> goObject (g a) c
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> goObject a1 c1
        Right a2 -> goObject a2 c2
      PureCodec _ -> []
--- a/autodocodec-yaml/src/Autodocodec/Yaml/Schema.hs
+++ b/autodocodec-yaml/src/Autodocodec/Yaml/Schema.hs
@ -63,6 +63,20 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
    docToLines :: Text -> [[Chunk]]
    docToLines doc = map (\line -> [chunk "# ", chunk line]) (T.lines doc)

+    choiceChunks :: NonEmpty [[Chunk]] -> [[Chunk]]
+    choiceChunks = \case
+      chunks :| [] -> addInFrontOfFirstInList ["[ "] chunks ++ [["]"]]
+      (chunks :| restChunks) ->
+        concat $
+          addInFrontOfFirstInList ["[ "] chunks :
+          map (addInFrontOfFirstInList [", "]) restChunks ++ [[["]"]]]
+
+    anyOfChunks :: NonEmpty [[Chunk]] -> [[Chunk]]
+    anyOfChunks = (["# ", fore green "any of"] :) . choiceChunks
+
+    oneOfChunks :: NonEmpty [[Chunk]] -> [[Chunk]]
+    oneOfChunks = (["# ", fore green "one of"] :) . choiceChunks
+
    go :: JSONSchema -> [[Chunk]]
    go = \case
      AnySchema -> [[fore yellow "<any>"]]
@ -90,20 +104,13 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
        addInFrontOfFirstInList [fore white "<key>", ": "] $ [] : go s
      ObjectSchema os -> goObject os
      ValueSchema v -> [[jsonValueChunk v]]
-      ChoiceSchema ne -> choiceChunks $ NE.map go ne
+      AnyOfSchema ne -> anyOfChunks $ NE.map go ne
+      OneOfSchema ne -> oneOfChunks $ NE.map go ne
      CommentSchema comment s -> docToLines comment ++ go s
      RefSchema name -> [[fore cyan $ chunk $ "ref: " <> name]]
      WithDefSchema defs (RefSchema _) -> concatMap (\(name, s') -> [fore cyan $ chunk $ "def: " <> name] : go s') (M.toList defs)
      WithDefSchema defs s -> concatMap (\(name, s') -> [fore cyan $ chunk $ "def: " <> name] : go s') (M.toList defs) ++ go s

-    choiceChunks :: NonEmpty [[Chunk]] -> [[Chunk]]
-    choiceChunks = \case
-      chunks :| [] -> addInFrontOfFirstInList ["[ "] chunks ++ [["]"]]
-      (chunks :| restChunks) ->
-        concat $
-          addInFrontOfFirstInList ["[ "] chunks :
-          map (addInFrontOfFirstInList [", "]) restChunks ++ [[["]"]]]
-
    goObject :: ObjectSchema -> [[Chunk]]
    goObject = \case
      ObjectAnySchema -> [["<object>"]]
@ -121,4 +128,5 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
                prefixLines = ["# ", requirementComment kr] : defaultValueLine ++ maybe [] docToLines mdoc
             in addInFrontOfFirstInList [fore white $ chunk k, ": "] (prefixLines ++ keySchemaChunks)
      ObjectAllOfSchema ne -> concatMap goObject $ NE.toList ne
-      ObjectChoiceSchema ne -> choiceChunks $ NE.map goObject ne
+      ObjectAnyOfSchema ne -> anyOfChunks $ NE.map goObject ne
+      ObjectOneOfSchema ne -> oneOfChunks $ NE.map goObject ne
--- a/autodocodec/CHANGELOG.md
+++ b/autodocodec/CHANGELOG.md
@ -1,5 +1,15 @@
 # Changelog

+## [0.0.1.0] - 2021-12-23
+
+### Changed
+
+* `EitherCodec` now takes a `Union` to specify whether the union is disjoint or not.
+
+### Added
+
+* `disjointEitherCodec` and `possiblyJointEitherCodec`.
+
 ## [0.0.0.0] - 2021-11-19

 First release.
--- a/autodocodec/autodocodec.cabal
+++ b/autodocodec/autodocodec.cabal
@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.34.5.
 --
 -- see: https://github.com/sol/hpack

 name:           autodocodec
-version:        0.0.0.0
+version:        0.0.1.0
 synopsis:       Self-documenting encoder and decoder
 homepage:       https://github.com/NorfairKing/autodocodec#readme
 bug-reports:    https://github.com/NorfairKing/autodocodec/issues
--- a/autodocodec/package.yaml
+++ b/autodocodec/package.yaml
@ -1,5 +1,5 @@
 name: autodocodec
-version: 0.0.0.0
+version: 0.0.1.0
 github: "NorfairKing/autodocodec"
 license: MIT
 author: "Tom Sydney Kerckhove"
--- a/autodocodec/src/Autodocodec.hs
+++ b/autodocodec/src/Autodocodec.hs
@ -57,25 +57,32 @@ module Autodocodec
    optionalFieldOrNullWithOmittedDefaultWith',

    -- ** Writing your own value codecs.
-    maybeCodec,
-    eitherCodec,
-    listCodec,
-    nonEmptyCodec,
-    singleOrListCodec,
-    singleOrNonEmptyCodec,
-    vectorCodec,
-    valueCodec,
+
+    -- *** Primitive codecs
    nullCodec,
    boolCodec,
    textCodec,
    stringCodec,
    scientificCodec,
+    valueCodec,
+
+    -- *** Integral codecs
    boundedIntegralCodec,
    boundedIntegralNumberBounds,
+
+    -- *** Literal value codecs
    literalTextCodec,
    literalTextValueCodec,
-    (<?>),
-    (<??>),
+
+    -- *** Enums
+    shownBoundedEnumCodec,
+    stringConstCodec,
+    enumCodec,
+
+    -- *** Sum type codecs
+    eitherCodec,
+    disjointEitherCodec,
+    possiblyJointEitherCodec,

    -- *** Mapping
    dimapCodec,
@ -83,10 +90,13 @@ module Autodocodec
    rmapCodec,
    lmapCodec,

-    -- *** Enums
-    shownBoundedEnumCodec,
-    stringConstCodec,
-    enumCodec,
+    -- *** Composing codecs
+    maybeCodec,
+    listCodec,
+    nonEmptyCodec,
+    singleOrListCodec,
+    singleOrNonEmptyCodec,
+    vectorCodec,

    -- *** Alternative parsing
    parseAlternative,
@ -96,6 +106,10 @@ module Autodocodec
    matchChoiceCodec,
    matchChoicesCodec,

+    -- *** Adding documentation to a codec
+    (<?>),
+    (<??>),
+
    -- * Bare codec
    Codec (..),
    ValueCodec,
--- a/autodocodec/src/Autodocodec/Aeson/Decode.hs
+++ b/autodocodec/src/Autodocodec/Aeson/Decode.hs
@ -88,12 +88,26 @@ parseJSONContextVia codec_ context_ =
        case f old of
          Left err -> fail err
          Right new -> pure new
-      EitherCodec c1 c2 ->
+      EitherCodec u c1 c2 ->
        let leftParser = (\v -> Left <$> go v c1)
-            rightParser = Right <$> go value c2
-         in case parseEither leftParser value of
-              Right l -> pure l
-              Left err -> prependFailure ("  Previous branch failure: " <> err <> "\n") rightParser
+            rightParser = (\v -> Right <$> go v c2)
+         in case u of
+              PossiblyJointUnion ->
+                case parseEither leftParser value of
+                  Right l -> pure l
+                  Left err -> prependFailure ("  Previous branch failure: " <> err <> "\n") (rightParser value)
+              DisjointUnion ->
+                case (parseEither leftParser value, parseEither rightParser value) of
+                  (Left _, Right r) -> pure r
+                  (Right l, Left _) -> pure l
+                  (Right _, Right _) -> fail "Both branches of a disjoint union succeeded."
+                  (Left lErr, Left rErr) ->
+                    fail $
+                      unlines
+                        [ "Both branches of a disjoint union failed: ",
+                          unwords ["Left:  ", lErr],
+                          unwords ["Right: ", rErr]
+                        ]
      CommentCodec _ c -> go value c
      ReferenceCodec _ c -> go value c
      RequiredKeyCodec k c _ -> do
--- a/autodocodec/src/Autodocodec/Aeson/Encode.hs
+++ b/autodocodec/src/Autodocodec/Aeson/Encode.hs
@ -41,7 +41,7 @@ toJSONVia = flip go
      ValueCodec -> (a :: JSON.Value)
      EqCodec value c -> go value c
      BimapCodec _ g c -> go (g a) c
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> go a1 c1
        Right a2 -> go a2 c2
      CommentCodec _ c -> go a c
@ -60,7 +60,7 @@ toJSONVia = flip go
          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)
      BimapCodec _ g c -> goObject (g a) c
      PureCodec _ -> mempty
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> goObject a1 c1
        Right a2 -> goObject a2 c2
      ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
@ -86,7 +86,7 @@ toEncodingVia = flip go
      ValueCodec -> JSON.value (a :: JSON.Value)
      EqCodec value c -> go value c
      BimapCodec _ g c -> go (g a) c
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> go a1 c1
        Right a2 -> go a2 c2
      CommentCodec _ c -> go a c
@ -104,7 +104,7 @@ toEncodingVia = flip go
          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)
      PureCodec _ -> mempty :: JSON.Series
      BimapCodec _ g c -> goObject (g a) c
-      EitherCodec c1 c2 -> case (a :: Either _ _) of
+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of
        Left a1 -> goObject a1 c1
        Right a2 -> goObject a2 c2
      ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
--- a/autodocodec/src/Autodocodec/Class.hs
+++ b/autodocodec/src/Autodocodec/Class.hs
@ -103,7 +103,7 @@ instance HasCodec a => HasCodec (Maybe a) where

 instance (HasCodec l, HasCodec r) => HasCodec (Either l r) where
  codec =
-    eitherCodec
+    disjointEitherCodec
      (ObjectOfCodec Nothing (requiredField' "Left"))
      (ObjectOfCodec Nothing (requiredField' "Right"))

--- a/autodocodec/src/Autodocodec/Codec.hs
+++ b/autodocodec/src/Autodocodec/Codec.hs
@ -33,9 +33,10 @@ import qualified Data.Vector as V
 import GHC.Generics (Generic)

 -- $setup
-- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, parseJSONVia)
-- >>> import Autodocodec.Class (HasCodec(codec))
+-- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, parseJSONVia, parseJSONViaCodec)
+-- >>> import Autodocodec.Class (HasCodec(codec), requiredField)
 -- >>> import qualified Data.Aeson as JSON
+-- >>> import qualified Data.HashMap.Strict as HM
 -- >>> import Data.Aeson (Value(..))
 -- >>> import qualified Data.Vector as Vector
 -- >>> import Data.Int
@ -159,6 +160,8 @@ data Codec context input output where
  -- In particular, you should prefer using it for values rather than objects,
  -- because those docs are easier to generate.
  EitherCodec ::
+    -- | What type of union we encode and decode
+    !Union ->
    -- | Codec for the 'Left' side
    (Codec context input1 output1) ->
    -- | Codec for the 'Right' side
@ -257,6 +260,7 @@ data NumberBounds = NumberBounds

 instance Validity NumberBounds

+-- | Check if a number falls within given 'NumberBounds'.
 checkNumberBounds :: NumberBounds -> Scientific -> Either String Scientific
 checkNumberBounds NumberBounds {..} s =
  if numberBoundsLower <= s
@ -266,6 +270,16 @@ checkNumberBounds NumberBounds {..} s =
        else Left $ unwords ["Number", show s, "is bigger than the upper bound", show numberBoundsUpper]
    else Left $ unwords ["Number", show s, "is smaller than the lower bound", show numberBoundsUpper]

+-- | What type of union the encoding uses
+data Union
+  = -- | Not disjoint, see 'possiblyJointEitherCodec'.
+    PossiblyJointUnion
+  | -- | Disjoint, see 'disjointEitherCodec'.
+    DisjointUnion
+  deriving (Show, Eq, Generic)
+
+instance Validity Union
+
 -- | A codec within the 'JSON.Value' context.
 --
 -- An 'ValueCodec' can be used to turn a Haskell value into a 'JSON.Value' or to parse a 'JSON.Value' into a haskell value.
@ -316,7 +330,7 @@ showCodecABit = ($ "") . (`evalState` S.empty) . go 0
      HashMapCodec c -> (\s -> showParen (d > 10) $ showString "HashMapCodec" . s) <$> go 11 c
      EqCodec value c -> (\s -> showParen (d > 10) $ showString "EqCodec " . showsPrec 11 value . showString " " . s) <$> go 11 c
      BimapCodec _ _ c -> (\s -> showParen (d > 10) $ showString "BimapCodec _ _ " . s) <$> go 11 c
-      EitherCodec c1 c2 -> (\s1 s2 -> showParen (d > 10) $ showString "EitherCodec " . s1 . showString " " . s2) <$> go 11 c1 <*> go 11 c2
+      EitherCodec u c1 c2 -> (\s1 s2 -> showParen (d > 10) $ showString "EitherCodec " . showsPrec 11 u . showString " " . s1 . showString " " . s2) <$> go 11 c1 <*> go 11 c2
      CommentCodec comment c -> (\s -> showParen (d > 10) $ showString "CommentCodec " . showsPrec 11 comment . showString " " . s) <$> go 11 c
      ReferenceCodec name c -> do
        alreadySeen <- gets (S.member name)
@ -438,7 +452,11 @@ instance Applicative (ObjectCodec input) where
 -- >>> toJSONVia (maybeCodec codec) (Nothing :: Maybe Char)
 -- Null
 maybeCodec :: ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
-maybeCodec = dimapCodec f g . EitherCodec nullCodec
+maybeCodec =
+  -- We must use 'possiblyJointEitherCodec' here, otherwise a codec for (Maybe
+  -- (Maybe Text)) will fail to parse.
+  dimapCodec f g
+    . possiblyJointEitherCodec nullCodec
  where
    f = \case
      Left () -> Nothing
@ -449,19 +467,113 @@ maybeCodec = dimapCodec f g . EitherCodec nullCodec

 -- | Forward-compatible version of 'EitherCodec'
 --
-- > eitherCodec = EitherCodec
+-- > eitherCodec = EitherCodec PossiblyJointUnion
 --
 -- === 'HasCodec' instance for sum types
 --
-- The 'eitherCodec' can be used to implement 'HasCodec' instances for newtypes.
+-- To write a 'HasCodec' instance for sum types, you will need to decide whether encoding is disjoint or not.
+-- The default, so also the implementation of this function, is 'possiblyJointEitherCodec', but you may want to use 'disjointEitherCodec' instead.
+--
+-- Ask yourself: Can the encoding of a 'Left' value be decoded as 'Right' value (or vice versa)?
+--
+-- @Yes ->@ use 'possiblyJointEitherCodec'.
+--
+-- @No  ->@ use 'disjointEitherCodec'.
+--
+-- === Example usage
+--
+-- >>> let c = eitherCodec codec codec :: JSONCodec (Either Int String)
+-- >>> toJSONVia c (Left 5)
+-- Number 5.0
+-- >>> toJSONVia c (Right "hello")
+-- String "hello"
+-- >>> JSON.parseMaybe (parseJSONVia c) (String "world") :: Maybe (Either Int String)
+-- Just (Right "world")
+eitherCodec ::
+  -- |
+  Codec context input1 output1 ->
+  -- |
+  Codec context input2 output2 ->
+  -- |
+  Codec context (Either input1 input2) (Either output1 output2)
+eitherCodec = possiblyJointEitherCodec
+
+-- | Forward-compatible version of 'EitherCodec PossiblyJointUnion'
+--
+-- > possiblyJointEitherCodec = EitherCodec PossiblyJointUnion
+--
+-- === 'HasCodec' instance for sum types with an encoding that is not disjoint.
+--
+-- The 'eitherCodec' can be used to implement 'HasCodec' instances for sum types.
 -- If you just have two codecs that you want to try in order, while parsing, you can do this:
 --
-- >>> data War = WorldWar Word8 | OtherWar Text
+-- >>> :{
+--   data Ainur
+--     = Valar Text Text
+--     | Maiar Text
+--     deriving (Show, Eq)
+-- :}
+--
+-- >>> :{
+--   instance HasCodec Ainur where
+--     codec =
+--       dimapCodec f g $
+--         possiblyJointEitherCodec
+--           (object "Valar" $
+--             (,)
+--              <$> requiredField "domain" "Domain which the Valar rules over" .= fst
+--              <*> requiredField "name" "Name of the Valar" .= snd)
+--           (object "Maiar" $ requiredField "name" "Name of the Maiar")
+--       where
+--         f = \case
+--           Left (domain, name) -> Valar domain name
+--           Right name -> Maiar name
+--         g = \case
+--           Valar domain name -> Left (domain, name)
+--           Maiar name -> Right name
+-- :}
+--
+-- Note that this encoding is indeed not disjoint, because a @Valar@ object can
+-- parse as a @Maiar@ value.
+--
+-- >>> toJSONViaCodec (Valar "Stars" "Varda")
+-- Object (fromList [("domain",String "Stars"),("name",String "Varda")])
+-- >>> toJSONViaCodec (Maiar "Sauron")
+-- Object (fromList [("name",String "Sauron")])
+-- >>> JSON.parseMaybe parseJSONViaCodec (Object (HM.fromList [("name",String "Olorin")])) :: Maybe Ainur
+-- Just (Maiar "Olorin")
+--
+-- === WARNING
+--
+-- The order of the codecs in a 'possiblyJointEitherCodec' matters.
+--
+-- In the above example, decoding works as expected because the @Valar@ case is parsed first.
+-- If the @Maiar@ case were first in the 'possiblyJointEitherCodec', then
+-- @Valar@ could never be parsed.
+possiblyJointEitherCodec ::
+  -- |
+  Codec context input1 output1 ->
+  -- |
+  Codec context input2 output2 ->
+  -- |
+  Codec context (Either input1 input2) (Either output1 output2)
+possiblyJointEitherCodec = EitherCodec PossiblyJointUnion
+
+-- | Forward-compatible version of 'EitherCodec DisjointUnion'
+--
+-- > disjointEitherCodec = EitherCodec DisjointUnion
+--
+-- === 'HasCodec' instance for sum types with an encoding that is definitely disjoint.
+--
+-- The 'eitherCodec' can be used to implement 'HasCodec' instances sum types
+-- for which the encoding is definitely disjoint.
+--
+-- >>> data War = WorldWar Word8 | OtherWar Text deriving (Show, Eq)
 -- >>> :{
 --   instance HasCodec War where
 --    codec =
 --      dimapCodec f g $
--        eitherCodec
+--        disjointEitherCodec
 --          (codec :: JSONCodec Word8)
 --          (codec :: JSONCodec Text)
 --      where
@ -473,22 +585,46 @@ maybeCodec = dimapCodec f g . EitherCodec nullCodec
 --          OtherWar t -> Right t
 -- :}
 --
+-- Note that this incoding is indeed disjoint because an encoded 'String' can
+-- never be parsed as an 'Word8' and vice versa.
+--
 -- >>> toJSONViaCodec (WorldWar 2)
 -- Number 2.0
 -- >>> toJSONViaCodec (OtherWar "OnDrugs")
 -- String "OnDrugs"
+-- >>> JSON.parseMaybe parseJSONViaCodec (String "of the roses") :: Maybe War
+-- Just (OtherWar "of the roses")
+--
+-- === WARNING
+--
+-- If it turns out that the encoding of a value is not disjoint, decoding may
+-- fail and documentation may be wrong.
+--
+-- >>> let c = disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec Int)
+-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (Either Int Int)
+-- Nothing
+--
+-- Encoding still works as expected, however:
+--
+-- >>> toJSONVia c (Left 5)
+-- Number 5.0
+-- >>> toJSONVia c (Right 6)
+-- Number 6.0
 --
 -- === Example usage
 --
-- >>> toJSONVia (eitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Left 5)
+-- >>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Left 5)
 -- Number 5.0
-- >>> toJSONVia (eitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Right "hello")
+-- >>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Right "hello")
 -- String "hello"
-eitherCodec ::
+disjointEitherCodec ::
+  -- |
  Codec context input1 output1 ->
+  -- |
  Codec context input2 output2 ->
+  -- |
  Codec context (Either input1 input2) (Either output1 output2)
-eitherCodec = EitherCodec
+disjointEitherCodec = EitherCodec DisjointUnion

 -- | Map a codec's input and output types.
 --
				`@ -0,0 +1 @@`
				`BimapCodec _ _ (EitherCodec PossiblyJointUnion (ObjectOfCodec (Just "Valar") (ApCodec (BimapCodec _ _ (RequiredKeyCodec "domain" (Just "Domain which the Valar rules over") (StringCodec Nothing))) (BimapCodec _ _ (RequiredKeyCodec "name" (Just "Name of the Valar") (StringCodec Nothing))))) (ObjectOfCodec (Just "Maiar") (RequiredKeyCodec "name" (Just "Name of the Maiar") (StringCodec Nothing))))`
				`@ -0,0 +1 @@`
				`BimapCodec _ _ (EitherCodec DisjointUnion (BimapCodec _ _ (NumberCodec Nothing (Just (NumberBounds {numberBoundsLower = 0.0, numberBoundsUpper = 255.0})))) (StringCodec Nothing))`