From c2af6e775d1d36f2011d43aff230bb502f8fba63 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 6 Dec 2021 17:31:15 +0100
Subject: [PATCH] better MimeRender/Unrender instances

---
 servant/src/Servant/API/UVerb.hs | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/servant/src/Servant/API/UVerb.hs b/servant/src/Servant/API/UVerb.hs
index ed59eded..1d1fb132 100644
--- a/servant/src/Servant/API/UVerb.hs
+++ b/servant/src/Servant/API/UVerb.hs
@@ -33,12 +33,14 @@ module Servant.API.UVerb
   )
 where
 
+import Data.Aeson
 import Data.Proxy (Proxy (Proxy))
 import GHC.TypeLits (Nat)
 import Network.HTTP.Types (Status, StdMethod)
 import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
 import Servant.API.Status (KnownStatus, statusVal)
 import Servant.API.UVerb.Union
+import Web.FormUrlEncoded
 
 class KnownStatus (StatusOf a) => HasStatus (a :: *) where
   type StatusOf (a :: *) :: Nat
@@ -99,26 +101,26 @@ instance KnownStatus n => HasStatus (WithStatus n a) where
 -- use 'respond' instead of 'pure' or 'return', so all old handlers would have to be rewritten.
 data UVerb (method :: StdMethod) (contentTypes :: [*]) (as :: [*])
 
-instance {-# OVERLAPPING #-} MimeRender JSON a => MimeRender JSON (WithStatus _status a) where
-  mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
+instance ToJSON a => ToJSON (WithStatus _status a) where
+  toJSON (WithStatus a) = toJSON a
 
 instance {-# OVERLAPPING #-} MimeRender PlainText a => MimeRender PlainText (WithStatus _status a) where
   mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
 
-instance {-# OVERLAPPING #-} MimeRender FormUrlEncoded a => MimeRender FormUrlEncoded (WithStatus _status a) where
-  mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
+instance ToForm a => ToForm (WithStatus _status a) where
+  toForm (WithStatus a) = toForm a
 
 instance {-# OVERLAPPING #-} MimeRender OctetStream a => MimeRender OctetStream (WithStatus _status a) where
   mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a
 
-instance {-# OVERLAPPING #-} MimeUnrender JSON a => MimeUnrender JSON (WithStatus _status a) where
-  mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
+instance FromJSON a => FromJSON (WithStatus _status a) where
+  parseJSON v = WithStatus <$> parseJSON v
 
 instance {-# OVERLAPPING #-} MimeUnrender PlainText a => MimeUnrender PlainText (WithStatus _status a) where
   mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
 
-instance {-# OVERLAPPING #-} MimeUnrender FormUrlEncoded a => MimeUnrender FormUrlEncoded (WithStatus _status a) where
-  mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input
+instance FromForm a => FromForm (WithStatus _status a) where
+  fromForm v = WithStatus <$> fromForm v
 
 instance {-# OVERLAPPING #-} MimeUnrender OctetStream a => MimeUnrender OctetStream (WithStatus _status a) where
   mimeUnrender contentTypeProxy input = WithStatus <$> mimeUnrender contentTypeProxy input