e8db2c6 · typeable/servant

git.iko.soy/typeable/servant

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

This reverts commit f95d2fcadcb858c7a759cc8f69fb5ba90749ceef.

commite8db2c659ed284740613ad22aa6e10b5f253c722 authorMatthias Fischmann <mf@zerobuzz.net> dateSun 6 Dec 2020, 15:43 (6 years ago) parentf95d2fc

11 files changed+29−67

compare with master

unifiedsplit

servant-docs/example/greet.hs−3 servant-docs/test/Servant/DocsSpec.hs−3 servant-server/example/greet.hs−4 servant-server/test/Servant/ArbitraryMonadServerSpec.hs+2−11 servant-server/test/Servant/HoistSpec.hs+1−9 servant-server/test/Servant/Server/ErrorSpec.hs−3 servant-server/test/Servant/Server/UsingContextSpec.hs+2−8 servant-server/test/Servant/ServerSpec.hs−4 servant/servant.cabal−1 servant/src/Servant/API/ContentTypes.hs+24−2 servant/test/Servant/API/ContentTypesSpec.hs−19

servant-docs/example/greet.hs−3

@@ -30,9 +30,6 @@ instance ToJSON Greet

3030instance MimeRender PlainText Greet where

3131 mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""

3232

33−instance MimeRender JSON Greet where

34− mimeRender Proxy = encode

35−

3633-- We add some useful annotations to our captures,

3734-- query parameters and request body to make the docs

3835-- really helpful.

servant-docs/test/Servant/DocsSpec.hs−3

@@ -216,6 +216,3 @@ compareWith f msg x y = unless (f x y) $ assertFailure $

216216golden :: TestName -> FilePath -> String -> TestTreeM ()

217217golden n fp contents = TestTreeM $ tell

218218 [ goldenVsString n fp (return (cs contents)) ]

219−

220−instance ToJSON a => MimeRender JSON a where

221− mimeRender _ = encode

servant-server/example/greet.hs−4

@@ -1,7 +1,5 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE MultiParamTypeClasses #-}

53{-# LANGUAGE OverloadedStrings #-}

64{-# LANGUAGE PolyKinds #-}

75{-# LANGUAGE TypeFamilies #-}

@@ -28,8 +26,6 @@ newtype Greet = Greet { _msg :: Text }

2826instance FromJSON Greet

2927instance ToJSON Greet

3028

31−instance ToJSON a => MimeRender JSON a where mimeRender _ = encode

32−

3329-- API specification

3430type TestApi =

3531 -- GET /hello/:name?capital={true, false} returns a Greet as JSON

servant-server/test/Servant/ArbitraryMonadServerSpec.hs+2−11

@@ -1,14 +1,9 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

1+{-# LANGUAGE DataKinds #-}

42{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

3+{-# LANGUAGE TypeOperators #-}

74module Servant.ArbitraryMonadServerSpec where

96import Control.Monad.Reader

10−import Data.Aeson

11− (encode)

127import Data.Functor.Identity

138import Data.Proxy

149import Servant.API

@@ -65,7 +60,3 @@ enterSpec = describe "Enter" $ do

6560 with (return (serve combinedAPI combinedReaderServer)) $ do

6661 it "allows combnation of enters" $ do

6762 get "bool" `shouldRespondWith` "true"

68−

69−instance MimeRender JSON Bool where mimeRender _ = encode

70−instance MimeRender JSON Int where mimeRender _ = encode

71−instance MimeRender JSON String where mimeRender _ = encode

servant-server/test/Servant/HoistSpec.hs+1−9

@@ -1,13 +1,7 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DataKinds #-}

52{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

73module Servant.HoistSpec where

9−import Data.Aeson

10− (ToJSON, encode)

115import Test.Hspec

126 (Spec)

137

@@ -37,8 +31,6 @@ f = id

3731server' :: App Int :<|> (String -> App Bool)

3832server' = hoistServer api f server

3933

40−instance ToJSON a => MimeRender JSON a where mimeRender _ = encode

41−

4234-------------------------------------------------------------------------------

4335-- Spec

4436-------------------------------------------------------------------------------

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

@@ -360,7 +360,4 @@ instance MimeUnrender PlainText Int where

360360

361361instance MimeRender PlainText Int where

362362 mimeRender _ = BCL.pack . show

363−

364−instance MimeRender JSON Integer where mimeRender _ = encode

365−instance MimeRender JSON Int where mimeRender _ = encode

366363-- }}}

servant-server/test/Servant/Server/UsingContextSpec.hs+2−8

@@ -1,14 +1,10 @@

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

43{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

4+{-# LANGUAGE TypeOperators #-}

86module Servant.Server.UsingContextSpec where

10−import Data.Aeson

11− (encode)

128import Network.Wai

139import Test.Hspec

1410 (Spec, describe, it)

@@ -24,8 +20,6 @@ spec = do

2420 spec3

2521 spec4

2622

27−instance MimeRender JSON String where mimeRender _ = encode

28−

2923-- * API

3024

3125type OneEntryAPI =

servant-server/test/Servant/ServerSpec.hs−4

@@ -1,6 +1,5 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

43{-# LANGUAGE FlexibleContexts #-}

54{-# LANGUAGE FlexibleInstances #-}

65{-# LANGUAGE OverloadedStrings #-}

@@ -51,7 +50,6 @@ import Servant.API

5150 BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,

5251 Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,

5352 Headers, HttpVersion, IsSecure (..), JSON, Lenient,

54− MimeRender (..),

5553 NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,

5654 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,

5755 RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,

@@ -108,8 +106,6 @@ spec = do

108106-- * verbSpec {{{

109107------------------------------------------------------------------------------

110108

111−instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender JSON a where mimeRender _ = encode

112−

113109type VerbApi method status

114110 = Verb method status '[JSON] Person

115111 :<|> "noContent" :> NoContentVerb method

servant/servant.cabal−1

@@ -154,7 +154,6 @@ test-suite spec

154154 , base-compat

155155 , aeson

156156 , bytestring

157− , http-api-data

158157 , http-media

159158 , mtl

160159 , servant

servant/src/Servant/API/ContentTypes.hs+24−2

@@ -74,7 +74,7 @@ import Control.Monad.Compat

7474import Control.DeepSeq

7575 (NFData)

7676import Data.Aeson

77− (FromJSON (..))

77+ (FromJSON (..), ToJSON (..), encode)

7878import Data.Aeson.Parser

7979 (value)

8080import Data.Aeson.Types

@@ -102,7 +102,7 @@ import qualified Network.HTTP.Media as M

102102import Prelude ()

103103import Prelude.Compat

104104import Web.FormUrlEncoded

105− (FromForm, urlDecodeAsForm)

105+ (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)

106106

107107-- * Provided content types

108108data JSON deriving Typeable

@@ -327,6 +327,18 @@ instance ( MimeUnrender ctyp a

327327--------------------------------------------------------------------------

328328-- * MimeRender Instances

329329

330+-- | `encode`

331+instance {-# OVERLAPPABLE #-}

332+ ToJSON a => MimeRender JSON a where

333+ mimeRender _ = encode

334+

335+-- | @urlEncodeAsForm@

336+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

337+-- holds if every element of x is non-null (i.e., not @("", "")@)

338+instance {-# OVERLAPPABLE #-}

339+ ToForm a => MimeRender FormUrlEncoded a where

340+ mimeRender _ = urlEncodeAsForm

341+

330342-- | `TextL.encodeUtf8`

331343instance MimeRender PlainText TextL.Text where

332344 mimeRender _ = TextL.encodeUtf8

@@ -376,6 +388,16 @@ eitherDecodeLenient input =

376388 <* skipSpace

377389 <* (endOfInput <?> "trailing junk after valid JSON")

378390

391+-- | `eitherDecode`

392+instance FromJSON a => MimeUnrender JSON a where

393+ mimeUnrender _ = eitherDecodeLenient

394+

395+-- | @urlDecodeAsForm@

396+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

397+-- holds if every element of x is non-null (i.e., not @("", "")@)

398+instance FromForm a => MimeUnrender FormUrlEncoded a where

399+ mimeUnrender _ = left TextS.unpack . urlDecodeAsForm

400+

379401-- | @left show . TextL.decodeUtf8'@

380402instance MimeUnrender PlainText TextL.Text where

381403 mimeUnrender _ = left show . TextL.decodeUtf8'

servant/test/Servant/API/ContentTypesSpec.hs−19

@@ -1,7 +1,6 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE DataKinds #-}

33{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE FlexibleInstances #-}

54{-# LANGUAGE MultiParamTypeClasses #-}

65{-# LANGUAGE OverloadedStrings #-}

76{-# LANGUAGE PackageImports #-}

@@ -40,8 +39,6 @@ import Test.QuickCheck

4039import "quickcheck-instances" Test.QuickCheck.Instances ()

4140import Text.Read

4241 (readMaybe)

43−import Web.FormUrlEncoded

44− (ToForm, urlEncodeAsForm)

4542

4643import Servant.API.ContentTypes

4744

@@ -274,19 +271,3 @@ addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)

274271 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)

275272 cont "" = new

276273 cont old = old `append` ", " `append` new

277−

278−-- | `encode`

279−--

280−-- This instance is not provided with the library to avoid unsolvable ambiguous instance

281−-- problems. Example: @instance MimeRender a => MimeRender (WithStatus n a)@

282−instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender JSON a where

283− mimeRender _ = encode

284−

285−-- | @urlEncodeAsForm@

286−-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

287−-- holds if every element of x is non-null (i.e., not @("", "")@)

288−--

289−-- This instance is not provided with the library to avoid unsolvable ambiguous instance

290−-- problems.

291−instance {-# OVERLAPPABLE #-} ToForm a => MimeRender FormUrlEncoded a where

292− mimeRender _ = urlEncodeAsForm