From 52a91c79d8a39cffb734feb347b21dab4c96d0af Mon Sep 17 00:00:00 2001
From: Andres Loeh <andres@well-typed.com>
Date: Wed, 12 May 2021 14:50:37 +0200
Subject: [PATCH] Add sopSwaggerGenericToEncodingWithOpts and use it.

The ToJSON Schema instance is missing an explicit definition of
toEncoding, which this patch adds.

The reason is that this ToJSON instance makes use of a somewhat
special sopSwaggerGenericToJSONWithOpts function that is not used
anywhere else and that had no counterpart for Encoding.

Such a counterpart is added here.
---
 src/Data/OpenApi/Internal.hs            |  5 ++++-
 src/Data/OpenApi/Internal/AesonUtils.hs | 21 ++++++++++++++++++++-
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index f6ae8811..34ba2a87 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -48,6 +48,8 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Generics.SOP.TH                  (deriveGeneric)
 import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON
                                         ,sopSwaggerGenericToJSONWithOpts
+                                        ,sopSwaggerGenericToEncoding
+                                        ,sopSwaggerGenericToEncodingWithOpts
                                         ,sopSwaggerGenericParseJSON
                                         ,HasSwaggerAesonOptions(..)
                                         ,AesonDefaultValue(..)
@@ -55,7 +57,6 @@ import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON
                                         ,saoAdditionalPairs
                                         ,saoSubObject)
 import Data.OpenApi.Internal.Utils
-import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)
 
 -- $setup
 -- >>> :seti -XDataKinds
@@ -1316,6 +1317,8 @@ instance ToJSON SecurityScheme where
 instance ToJSON Schema where
   toJSON = sopSwaggerGenericToJSONWithOpts $
       mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
+  toEncoding = sopSwaggerGenericToEncodingWithOpts $
+      mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
 
 instance ToJSON Header where
   toJSON = sopSwaggerGenericToJSON
diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs
index 98e1ce06..78ccbc04 100644
--- a/src/Data/OpenApi/Internal/AesonUtils.hs
+++ b/src/Data/OpenApi/Internal/AesonUtils.hs
@@ -9,8 +9,9 @@ module Data.OpenApi.Internal.AesonUtils (
     -- * Generic functions
     AesonDefaultValue(..),
     sopSwaggerGenericToJSON,
-    sopSwaggerGenericToEncoding,
     sopSwaggerGenericToJSONWithOpts,
+    sopSwaggerGenericToEncoding,
+    sopSwaggerGenericToEncodingWithOpts,
     sopSwaggerGenericParseJSON,
     -- * Options
     HasSwaggerAesonOptions(..),
@@ -267,6 +268,24 @@ sopSwaggerGenericToEncoding x =
     proxy = Proxy :: Proxy a
     opts  = swaggerAesonOptions proxy
 
+sopSwaggerGenericToEncodingWithOpts
+    :: forall a xs.
+        ( HasDatatypeInfo a
+        , HasSwaggerAesonOptions a
+        , All2 ToJSON (Code a)
+        , All2 Eq (Code a)
+        , Code a ~ '[xs]
+        )
+    => SwaggerAesonOptions
+    -> a
+    -> Encoding
+sopSwaggerGenericToEncodingWithOpts opts x =
+    let ps = sopSwaggerGenericToEncoding' opts (from x) (datatypeInfo proxy) defs
+    in pairs (pairsToSeries (opts ^. saoAdditionalPairs) <> ps)
+  where
+    proxy = Proxy :: Proxy a
+    defs = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue
+
 pairsToSeries :: [Pair] -> Series
 pairsToSeries = foldMap (\(k, v) -> (k .= v))