From d61887924e2baab0664eddaf723af5cbef5b331f Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Sun, 31 Oct 2021 23:15:58 +0100
Subject: [PATCH] object codec for json objects

---
 autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs   | 1 +
 autodocodec-aeson/src/Autodocodec/Aeson/Document.hs | 1 +
 autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs   | 1 +
 autodocodec/src/Autodocodec/Codec.hs                | 5 +++++
 4 files changed, 8 insertions(+)

diff --git a/autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs b/autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs
index 05c2abe..0b1d517 100644
--- a/autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs
+++ b/autodocodec-aeson/src/Autodocodec/Aeson/Decode.hs
@@ -45,6 +45,7 @@ parseContextVia = flip go
           Nothing -> parseJSON value
           Just name -> withObject (T.unpack name) pure value
         (`go` c) object_
+      ObjectCodec -> parseJSON value
       ValueCodec -> pure value
       EqCodec expected c -> do
         actual <- go value c
diff --git a/autodocodec-aeson/src/Autodocodec/Aeson/Document.hs b/autodocodec-aeson/src/Autodocodec/Aeson/Document.hs
index 55880d7..a86287c 100644
--- a/autodocodec-aeson/src/Autodocodec/Aeson/Document.hs
+++ b/autodocodec-aeson/src/Autodocodec/Aeson/Document.hs
@@ -279,6 +279,7 @@ jsonSchemaVia = go
       NumberCodec mname -> maybe id CommentSchema mname NumberSchema
       ArrayOfCodec mname c -> maybe id CommentSchema mname $ ArraySchema (go c)
       ObjectOfCodec mname oc -> maybe id CommentSchema mname $ ObjectSchema (goObject oc)
+      ObjectCodec -> ObjectSchema []
       ValueCodec -> AnySchema
       EqCodec value c -> ValueSchema (toJSONVia c value)
       EitherCodec c1 c2 -> ChoiceSchema (goChoice (go c1 :| [go c2]))
diff --git a/autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs b/autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs
index 22cfd26..28df38f 100644
--- a/autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs
+++ b/autodocodec-aeson/src/Autodocodec/Aeson/Encode.hs
@@ -26,6 +26,7 @@ toContextVia = flip go
       NumberCodec _ -> toJSON (a :: Scientific)
       ArrayOfCodec _ c -> toJSON (fmap (`go` c) a)
       ObjectOfCodec _ oc -> JSON.Object (go a oc)
+      ObjectCodec -> JSON.Object a
       ValueCodec -> a
       EqCodec value c -> go value c
       MapCodec _ g c -> go (g a) c
diff --git a/autodocodec/src/Autodocodec/Codec.hs b/autodocodec/src/Autodocodec/Codec.hs
index d9fc8eb..e210a54 100644
--- a/autodocodec/src/Autodocodec/Codec.hs
+++ b/autodocodec/src/Autodocodec/Codec.hs
@@ -75,6 +75,10 @@ data Codec context input output where
     !(ObjectCodec input output) ->
     -- |
     ValueCodec input output
+  -- | Encode a 'JSON.Object', and decode any 'JSON.Object'.
+  ObjectCodec ::
+    -- |
+    ValueCodec JSON.Object JSON.Object
   -- | Encode a 'JSON.Value', and decode any 'JSON.Value'.
   ValueCodec ::
     -- |
@@ -230,6 +234,7 @@ showCodecABit = ($ "") . (`evalState` S.empty) . go 0
       ArrayOfCodec mname c -> (\s -> showParen (d > 10) $ showString "ArrayOfCodec " . showsPrec d mname . showString " " . s) <$> go 11 c
       ObjectOfCodec mname oc -> (\s -> showParen (d > 10) $ showString "ObjectOfCodec " . showsPrec d mname . showString " " . s) <$> go 11 oc
       ValueCodec -> pure $ showString "ValueCodec"
+      ObjectCodec -> pure $ showString "ObjectCodec"
       EqCodec value c -> (\s -> showParen (d > 10) $ showString "EqCodec " . showsPrec d value . showString " " . s) <$> go 11 c
       MapCodec _ _ c -> (\s -> showParen (d > 10) $ showString "MapCodec " . s) <$> go 11 c
       EitherCodec c1 c2 -> (\s1 s2 -> showParen (d > 10) $ showString "EitherCodec " . s1 . showString " " . s2) <$> go 11 c1 <*> go 11 c2