diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 0a196f2f..ec36c7ca 100644 --- a/servant-docs/example/greet.hs +++ b/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. diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 9d80e1ff..5da5ff4d 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/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 diff --git a/servant-server/example/greet.hs b/servant-server/example/greet.hs index 64816813..e354351f 100644 --- a/servant-server/example/greet.hs +++ b/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 diff --git a/servant-server/test/Servant/ArbitraryMonadServerSpec.hs b/servant-server/test/Servant/ArbitraryMonadServerSpec.hs index 52089feb..d492250b 100644 --- a/servant-server/test/Servant/ArbitraryMonadServerSpec.hs +++ b/servant-server/test/Servant/ArbitraryMonadServerSpec.hs @@ -1,14 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeOperators #-} 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 diff --git a/servant-server/test/Servant/HoistSpec.hs b/servant-server/test/Servant/HoistSpec.hs index 75f9bf34..e29387dc 100644 --- a/servant-server/test/Servant/HoistSpec.hs +++ b/servant-server/test/Servant/HoistSpec.hs @@ -1,13 +1,7 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} {-# 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 ------------------------------------------------------------------------------- diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/servant-server/test/Servant/Server/ErrorSpec.hs index 1809c931..72251b21 100644 --- a/servant-server/test/Servant/Server/ErrorSpec.hs +++ b/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 -- }}} diff --git a/servant-server/test/Servant/Server/UsingContextSpec.hs b/servant-server/test/Servant/Server/UsingContextSpec.hs index c174e340..5258f190 100644 --- a/servant-server/test/Servant/Server/UsingContextSpec.hs +++ b/servant-server/test/Servant/Server/UsingContextSpec.hs @@ -1,14 +1,10 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeOperators #-} 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 = diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 5d91cf8b..e3dec48e 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/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 diff --git a/servant/servant.cabal b/servant/servant.cabal index 6ffafcf5..22f9dba7 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -154,7 +154,6 @@ test-suite spec , base-compat , aeson , bytestring - , http-api-data , http-media , mtl , servant diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs index faa55cf3..d6d200ad 100644 --- a/servant/src/Servant/API/ContentTypes.hs +++ b/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' diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs index 8d554480..1a7d4d1d 100644 --- a/servant/test/Servant/API/ContentTypesSpec.hs +++ b/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