eithercodec for objectcodecs, it's a bit cursed but maybe that's ok?

.hlint.yaml

@@ -1,6 +1,7 @@
 - ignore: { name: "Eta reduce" }
 - ignore: { name: "Use unless" }
 - ignore: { name: "Use fmap" }
+- ignore: { name: "Use tuple-section" }
 - ignore: { name: "Use ++" }
 - ignore: { name: "Avoid lambda using `infix`" }
 - ignore: { name: "Replace case with maybe" }

autodocodec-schema/src/Autodocodec/Schema.hs

@@ -259,8 +259,10 @@ jsonSchemaVia = (`evalState` S.empty) . go
         s <- go c
         pure $ maybe id CommentSchema mname $ ArraySchema s
       ObjectOfCodec mname oc -> do
-        s <- goObject oc
-        pure $ maybe id CommentSchema mname $ ObjectSchema s
+        alts <- goObject oc
+        case alts of
+          s :| [] -> pure $ maybe id CommentSchema mname $ ObjectSchema s
+          _ -> pure $ maybe id CommentSchema mname $ ChoiceSchema $ goChoice $ NE.map ObjectSchema alts
       HashMapCodec c -> MapSchema <$> go c
       MapCodec c -> MapSchema <$> go c
       ValueCodec -> pure AnySchema
@@ -290,21 +292,26 @@ jsonSchemaVia = (`evalState` S.empty) . go
           ChoiceSchema ss -> goChoice ss
           s' -> s' :| []
 
-    goObject :: ObjectCodec input output -> State (Set Text) [(Text, (KeyRequirement, JSONSchema, Maybe Text))]
+    -- The outer list is for alternatives, the inner list is for multiple keys
+    goObject :: ObjectCodec input output -> State (Set Text) (NonEmpty [(Text, (KeyRequirement, JSONSchema, Maybe Text))])
     goObject = \case
       RequiredKeyCodec k c mdoc -> do
         s <- go c
-        pure [(k, (Required, s, mdoc))]
+        pure $ [(k, (Required, s, mdoc))] :| []
       OptionalKeyCodec k c mdoc -> do
         s <- go c
-        pure [(k, (Optional Nothing, s, mdoc))]
+        pure $ [(k, (Optional Nothing, s, mdoc))] :| []
       OptionalKeyWithDefaultCodec k c mr mdoc -> do
         s <- go c
-        pure [(k, (Optional (Just (toJSONVia c mr)), s, mdoc))]
+        pure $ [(k, (Optional (Just (toJSONVia c mr)), s, mdoc))] :| []
       OptionalKeyWithOmittedDefaultCodec k c defaultValue mDoc -> goObject (OptionalKeyWithDefaultCodec k c defaultValue mDoc)
       BimapCodec _ _ c -> goObject c
-      PureCodec _ -> pure []
-      ApCodec oc1 oc2 -> liftA2 (++) (goObject oc1) (goObject oc2)
+      EitherCodec oc1 oc2 -> liftA2 (<>) (goObject oc1) (goObject oc2)
+      PureCodec _ -> pure $ [] :| []
+      ApCodec oc1 oc2 -> do
+        s1s <- goObject oc1
+        s2s <- goObject oc2
+        pure $ (++) <$> s1s <*> s2s
 
 uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
 uncurry3 f (a, b, c) = f a b c

autodocodec-yaml/src/Autodocodec/Yaml/Encode.hs

@@ -60,6 +60,9 @@ toYamlVia = flip go
           then []
           else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mDoc)
       BimapCodec _ g c -> goObject (g a) c
+      EitherCodec oc1 oc2 -> case (a :: Either _ _) of
+        Left a1 -> goObject a1 oc1
+        Right a2 -> goObject a2 oc2
       PureCodec _ -> []
       ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
 

autodocodec/src/Autodocodec/Aeson/Encode.hs

@@ -59,6 +59,9 @@ toJSONVia = flip go
           then mempty
           else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)
       BimapCodec _ g c -> goObject (g a) c
+      EitherCodec c1 c2 -> case (a :: Either _ _) of
+        Left a1 -> goObject a1 c1
+        Right a2 -> goObject a2 c2
       PureCodec _ -> mempty
       ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
 
@@ -99,6 +102,9 @@ 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
+        Left a1 -> goObject a1 c1
+        Right a2 -> goObject a2 c2
       ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
 
 instance HasCodec a => JSON.ToJSON (Autodocodec a) where

autodocodec/src/Autodocodec/Codec.hs

@@ -130,11 +130,11 @@ data Codec context input output where
   -- This codec is used to implement choice.
   EitherCodec ::
     -- | Codec for the 'Left' side
-    (ValueCodec input1 output1) ->
+    (Codec context input1 output1) ->
     -- | Codec for the 'Right' side
-    (ValueCodec input2 output2) ->
+    (Codec context input2 output2) ->
     -- |
-    ValueCodec (Either input1 input2) (Either output1 output2)
+    Codec context (Either input1 input2) (Either output1 output2)
   -- | A comment codec
   --
   -- This is used to add implementation-irrelevant but human-relevant information.
@@ -402,9 +402,9 @@ maybeCodec = dimapCodec f g . EitherCodec nullCodec
 -- >>> toJSONVia (eitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Right "hello")
 -- String "hello"
 eitherCodec ::
-  ValueCodec input1 output1 ->
-  ValueCodec input2 output2 ->
-  ValueCodec (Either input1 input2) (Either output1 output2)
+  Codec context input1 output1 ->
+  Codec context input2 output2 ->
+  Codec context (Either input1 input2) (Either output1 output2)
 eitherCodec = EitherCodec
 
 -- | Map a codec's input and output types.
@@ -791,6 +791,15 @@ matchChoicesCodec ((f, c) :| rest) = case NE.nonEmpty rest of
       (f, c)
       (Just, matchChoicesCodec ne)
 
+-- | Use one codec for the default way of parsing and rendering, but then also
+-- use a list of other codecs for potentially different parsing.
+--
+-- You can use this for keeping old ways of parsing intact while already rendering in the new way.
+--
+-- TODO tests
+parseAlternatives :: ValueCodec input output -> [ValueCodec input output] -> ValueCodec input output
+parseAlternatives c cRest = matchChoicesCodec $ (Just, c) :| map (\c' -> (const Nothing, c')) cRest
+
 enumCodec ::
   forall enum.
   Eq enum =>