f95d2fc · typeable/servant

git.iko.soy/typeable/servant

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

commitf95d2fcadcb858c7a759cc8f69fb5ba90749ceef authorMatthias Fischmann <mf@zerobuzz.net> dateSun 6 Dec 2020, 15:31 (6 years ago) parent49801db

11 files changed+67−29

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+11−2 servant-server/test/Servant/HoistSpec.hs+9−1 servant-server/test/Servant/Server/ErrorSpec.hs+3 servant-server/test/Servant/Server/UsingContextSpec.hs+8−2 servant-server/test/Servant/ServerSpec.hs+4 servant/servant.cabal+1 servant/src/Servant/API/ContentTypes.hs+2−24 servant/test/Servant/API/ContentTypesSpec.hs+19

servant-docs/example/greet.hs+3

@@ -30,6 +30,9 @@ 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+

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

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

3538-- really helpful.

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

@@ -216,3 +216,6 @@ 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,5 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

35{-# LANGUAGE OverloadedStrings #-}

46{-# LANGUAGE PolyKinds #-}

57{-# LANGUAGE TypeFamilies #-}

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

2628instance FromJSON Greet

2729instance ToJSON Greet

2830

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

32+

2933-- API specification

3034type TestApi =

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

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

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

24{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

47module Servant.ArbitraryMonadServerSpec where

69import Control.Monad.Reader

10+import Data.Aeson

11+ (encode)

712import Data.Functor.Identity

813import Data.Proxy

914import Servant.API

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

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

6166 it "allows combnation of enters" $ do

6267 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+9−1

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE OverloadedStrings #-}

25{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

37module Servant.HoistSpec where

9+import Data.Aeson

10+ (ToJSON, encode)

511import Test.Hspec

612 (Spec)

713

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

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

3238server' = hoistServer api f server

3339

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

41+

3442-------------------------------------------------------------------------------

3543-- Spec

3644-------------------------------------------------------------------------------

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

@@ -360,4 +360,7 @@ 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

363366-- }}}

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

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

34{-# LANGUAGE OverloadedStrings #-}

4−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

68module Servant.Server.UsingContextSpec where

10+import Data.Aeson

11+ (encode)

812import Network.Wai

913import Test.Hspec

1014 (Spec, describe, it)

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

2024 spec3

2125 spec4

2226

27+instance MimeRender JSON String where mimeRender _ = encode

28+

2329-- * API

2430

2531type OneEntryAPI =

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

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

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

34{-# LANGUAGE FlexibleContexts #-}

45{-# LANGUAGE FlexibleInstances #-}

56{-# LANGUAGE OverloadedStrings #-}

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

5051 BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,

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

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

54+ MimeRender (..),

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

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

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

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

106108-- * verbSpec {{{

107109------------------------------------------------------------------------------

108110

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

112+

109113type VerbApi method status

110114 = Verb method status '[JSON] Person

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

servant/servant.cabal+1

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

154154 , base-compat

155155 , aeson

156156 , bytestring

157+ , http-api-data

157158 , http-media

158159 , mtl

159160 , servant

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

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

7474import Control.DeepSeq

7575 (NFData)

7676import Data.Aeson

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

77+ (FromJSON (..))

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, ToForm, urlDecodeAsForm, urlEncodeAsForm)

105+ (FromForm, urlDecodeAsForm)

106106

107107-- * Provided content types

108108data JSON deriving Typeable

@@ -327,18 +327,6 @@ 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−

342330-- | `TextL.encodeUtf8`

343331instance MimeRender PlainText TextL.Text where

344332 mimeRender _ = TextL.encodeUtf8

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

388376 <* skipSpace

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

390378

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−

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

402380instance MimeUnrender PlainText TextL.Text where

403381 mimeUnrender _ = left show . TextL.decodeUtf8'

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

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

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE DataKinds #-}

33{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE FlexibleInstances #-}

45{-# LANGUAGE MultiParamTypeClasses #-}

56{-# LANGUAGE OverloadedStrings #-}

67{-# LANGUAGE PackageImports #-}

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

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

4041import Text.Read

4142 (readMaybe)

43+import Web.FormUrlEncoded

44+ (ToForm, urlEncodeAsForm)

4245

4346import Servant.API.ContentTypes

4447

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

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

272275 cont "" = new

273276 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