Revert "Drop Mime{,Un}Render instances that do not shrink head."

This reverts commit f95d2fcadc.

servant-docs/example/greet.hs

@@ -30,9 +30,6 @@ instance ToJSON Greet
 instance MimeRender PlainText Greet where
     mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""
 
-instance MimeRender JSON Greet where
-    mimeRender Proxy = encode
-
 -- We add some useful annotations to our captures,
 -- query parameters and request body to make the docs
 -- really helpful.

servant-docs/test/Servant/DocsSpec.hs

@@ -216,6 +216,3 @@ compareWith f msg x y = unless (f x y) $ assertFailure $
 golden :: TestName -> FilePath -> String -> TestTreeM ()
 golden n fp contents = TestTreeM $ tell
     [ goldenVsString n fp (return (cs contents)) ]
-
-instance ToJSON a => MimeRender JSON a where
-  mimeRender _ = encode

servant-server/example/greet.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds         #-}
 {-# LANGUAGE TypeFamilies      #-}
@@ -28,8 +26,6 @@ newtype Greet = Greet { _msg :: Text }
 instance FromJSON Greet
 instance ToJSON Greet
 
-instance ToJSON a => MimeRender JSON a where mimeRender _ = encode
-
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON

servant-server/test/Servant/ArbitraryMonadServerSpec.hs

@@ -1,14 +1,9 @@
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 module Servant.ArbitraryMonadServerSpec where
 
 import           Control.Monad.Reader
-import           Data.Aeson
-                 (encode)
 import           Data.Functor.Identity
 import           Data.Proxy
 import           Servant.API
@@ -65,7 +60,3 @@ enterSpec = describe "Enter" $ do
   with (return (serve combinedAPI combinedReaderServer)) $ do
     it "allows combnation of enters" $ do
       get "bool" `shouldRespondWith` "true"
-
-instance MimeRender JSON Bool where mimeRender _ = encode
-instance MimeRender JSON Int where mimeRender _ = encode
-instance MimeRender JSON String where mimeRender _ = encode

servant-server/test/Servant/HoistSpec.hs

@@ -1,13 +1,7 @@
 {-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 module Servant.HoistSpec where
 
-import           Data.Aeson
-                 (ToJSON, encode)
 import           Test.Hspec
                  (Spec)
 
@@ -37,8 +31,6 @@ f = id
 server' :: App Int :<|> (String -> App Bool)
 server' = hoistServer api f server
 
-instance ToJSON a => MimeRender JSON a where mimeRender _ = encode
-
 -------------------------------------------------------------------------------
 -- Spec
 -------------------------------------------------------------------------------

servant-server/test/Servant/Server/ErrorSpec.hs

@@ -360,7 +360,4 @@ instance MimeUnrender PlainText Int where
 
 instance MimeRender PlainText Int where
     mimeRender _ = BCL.pack . show
-
-instance MimeRender JSON Integer where mimeRender _ = encode
-instance MimeRender JSON Int where mimeRender _ = encode
 -- }}}

servant-server/test/Servant/Server/UsingContextSpec.hs

@@ -1,14 +1,10 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 module Servant.Server.UsingContextSpec where
 
-import           Data.Aeson
-                 (encode)
 import           Network.Wai
 import           Test.Hspec
                  (Spec, describe, it)
@@ -24,8 +20,6 @@ spec = do
   spec3
   spec4
 
-instance MimeRender JSON String where mimeRender _ = encode
-
 -- * API
 
 type OneEntryAPI =

servant-server/test/Servant/ServerSpec.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE OverloadedStrings   #-}
@@ -51,7 +50,6 @@ import           Servant.API
                  BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
                  Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,
                  Headers, HttpVersion, IsSecure (..), JSON, Lenient,
-                 MimeRender (..),
                  NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,
                  PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
                  RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,
@@ -108,8 +106,6 @@ spec = do
 -- * verbSpec {{{
 ------------------------------------------------------------------------------
 
-instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender JSON a where mimeRender _ = encode
-
 type VerbApi method status
     =                Verb method status '[JSON] Person
  :<|> "noContent" :> NoContentVerb method

servant/servant.cabal

@@ -154,7 +154,6 @@ test-suite spec
     , base-compat
     , aeson
     , bytestring
-    , http-api-data
     , http-media
     , mtl
     , servant

servant/src/Servant/API/ContentTypes.hs

@@ -74,7 +74,7 @@ import           Control.Monad.Compat
 import           Control.DeepSeq
                  (NFData)
 import           Data.Aeson
-                 (FromJSON (..))
+                 (FromJSON (..), ToJSON (..), encode)
 import           Data.Aeson.Parser
                  (value)
 import           Data.Aeson.Types
@@ -102,7 +102,7 @@ import qualified Network.HTTP.Media               as M
 import           Prelude ()
 import           Prelude.Compat
 import           Web.FormUrlEncoded
-                 (FromForm, urlDecodeAsForm)
+                 (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)
 
 -- * Provided content types
 data JSON deriving Typeable
@@ -327,6 +327,18 @@ instance ( MimeUnrender ctyp a
 --------------------------------------------------------------------------
 -- * MimeRender Instances
 
+-- | `encode`
+instance {-# OVERLAPPABLE #-}
+         ToJSON a => MimeRender JSON a where
+    mimeRender _ = encode
+
+-- | @urlEncodeAsForm@
+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
+-- holds if every element of x is non-null (i.e., not @("", "")@)
+instance {-# OVERLAPPABLE #-}
+         ToForm a => MimeRender FormUrlEncoded a where
+    mimeRender _ = urlEncodeAsForm
+
 -- | `TextL.encodeUtf8`
 instance MimeRender PlainText TextL.Text where
     mimeRender _ = TextL.encodeUtf8
@@ -376,6 +388,16 @@ eitherDecodeLenient input =
           <* skipSpace
           <* (endOfInput <?> "trailing junk after valid JSON")
 
+-- | `eitherDecode`
+instance FromJSON a => MimeUnrender JSON a where
+    mimeUnrender _ = eitherDecodeLenient
+
+-- | @urlDecodeAsForm@
+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
+-- holds if every element of x is non-null (i.e., not @("", "")@)
+instance FromForm a => MimeUnrender FormUrlEncoded a where
+    mimeUnrender _ = left TextS.unpack . urlDecodeAsForm
+
 -- | @left show . TextL.decodeUtf8'@
 instance MimeUnrender PlainText TextL.Text where
     mimeUnrender _ = left show . TextL.decodeUtf8'

servant/test/Servant/API/ContentTypesSpec.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PackageImports        #-}
@@ -40,8 +39,6 @@ import           Test.QuickCheck
 import           "quickcheck-instances" Test.QuickCheck.Instances ()
 import           Text.Read
                  (readMaybe)
-import           Web.FormUrlEncoded
-                 (ToForm, urlEncodeAsForm)
 
 import           Servant.API.ContentTypes
 
@@ -274,19 +271,3 @@ addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
     where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
           cont "" = new
           cont old = old `append` ", " `append` new
-
--- | `encode`
---
--- This instance is not provided with the library to avoid unsolvable ambiguous instance
--- problems.  Example: @instance MimeRender a => MimeRender (WithStatus n a)@
-instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender JSON a where
-  mimeRender _ = encode
-
--- | @urlEncodeAsForm@
--- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
--- holds if every element of x is non-null (i.e., not @("", "")@)
---
--- This instance is not provided with the library to avoid unsolvable ambiguous instance
--- problems.
-instance {-# OVERLAPPABLE #-} ToForm a => MimeRender FormUrlEncoded a where
-  mimeRender _ = urlEncodeAsForm