f95d2fc · servant · git.iko.soy

servant-docs/example/greet.hs+3

compare with master

unifiedsplit

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

30instance MimeRender PlainText Greet where

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

32

33+instance MimeRender JSON Greet where

34+ mimeRender Proxy = encode

35+

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

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

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

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

35-- really helpful.

38-- really helpful.

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

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

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

217golden n fp contents = TestTreeM $ tell

218 [ 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 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

3{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE PolyKinds #-}

6{-# LANGUAGE PolyKinds #-}

5{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE TypeFamilies #-}

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

26instance FromJSON Greet

28instance FromJSON Greet

27instance ToJSON Greet

29instance ToJSON Greet

28

30

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

32+

29-- API specification

33-- API specification

30type TestApi =

34type TestApi =

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

35 -- 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 #-}

2{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

4module Servant.ArbitraryMonadServerSpec where

7module Servant.ArbitraryMonadServerSpec where

5

8

6import Control.Monad.Reader

9import Control.Monad.Reader

10+import Data.Aeson

11+ (encode)

7import Data.Functor.Identity

12import Data.Functor.Identity

8import Data.Proxy

13import Data.Proxy

9import Servant.API

14import Servant.API

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

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

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

61 it "allows combnation of enters" $ do

66 it "allows combnation of enters" $ do

62 get "bool" `shouldRespondWith` "true"

67 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 #-}

2{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

3module Servant.HoistSpec where

7module Servant.HoistSpec where

4

8

9+import Data.Aeson

10+ (ToJSON, encode)

5import Test.Hspec

11import Test.Hspec

6 (Spec)

12 (Spec)

7

13

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

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

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

32server' = hoistServer api f server

38server' = hoistServer api f server

33

39

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

41+

34-------------------------------------------------------------------------------

42-------------------------------------------------------------------------------

35-- Spec

43-- Spec

36-------------------------------------------------------------------------------

44-------------------------------------------------------------------------------

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

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

360

361instance MimeRender PlainText Int where

362 mimeRender _ = BCL.pack . show

363+

364+instance MimeRender JSON Integer where mimeRender _ = encode

365+instance MimeRender JSON Int where mimeRender _ = encode

363-- }}}

366-- }}}

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

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

4−{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE TypeSynonymInstances #-}

5

7

6module Servant.Server.UsingContextSpec where

8module Servant.Server.UsingContextSpec where

7

9

10+import Data.Aeson

11+ (encode)

8import Network.Wai

12import Network.Wai

9import Test.Hspec

13import Test.Hspec

10 (Spec, describe, it)

14 (Spec, describe, it)

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

20 spec3

24 spec3

21 spec4

25 spec4

22

26

27+instance MimeRender JSON String where mimeRender _ = encode

28+

23-- * API

29-- * API

24

30

25type OneEntryAPI =

31type OneEntryAPI =

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

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

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE OverloadedStrings #-}

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

50 BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,

51 BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,

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

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

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

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

54+ MimeRender (..),

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

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

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

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

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

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

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

106-- * verbSpec {{{

108-- * verbSpec {{{

107------------------------------------------------------------------------------

109------------------------------------------------------------------------------

108

110

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

112+

109type VerbApi method status

113type VerbApi method status

110 = Verb method status '[JSON] Person

114 = Verb method status '[JSON] Person

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

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

servant/servant.cabal+1

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

154 , base-compat

155 , aeson

156 , bytestring

157+ , http-api-data

157 , http-media

158 , http-media

158 , mtl

159 , mtl

159 , servant

160 , servant

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

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

74import Control.DeepSeq

75 (NFData)

76import Data.Aeson

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

77+ (FromJSON (..))

78import Data.Aeson.Parser

79 (value)

80import Data.Aeson.Types

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

102import Prelude ()

103import Prelude.Compat

104import Web.FormUrlEncoded

105− (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)

105+ (FromForm, urlDecodeAsForm)

106

107-- * Provided content types

108data JSON deriving Typeable

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

327--------------------------------------------------------------------------

328-- * MimeRender Instances

329

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−

342-- | `TextL.encodeUtf8`

330-- | `TextL.encodeUtf8`

343instance MimeRender PlainText TextL.Text where

331instance MimeRender PlainText TextL.Text where

344 mimeRender _ = TextL.encodeUtf8

332 mimeRender _ = TextL.encodeUtf8

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

388 <* skipSpace

376 <* skipSpace

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

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

390

378

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−

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

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

402instance MimeUnrender PlainText TextL.Text where

380instance MimeUnrender PlainText TextL.Text where

403 mimeUnrender _ = left show . TextL.decodeUtf8'

381 mimeUnrender _ = left show . TextL.decodeUtf8'

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

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE PackageImports #-}

7{-# LANGUAGE PackageImports #-}

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

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

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

40import Text.Read

41import Text.Read

41 (readMaybe)

42 (readMaybe)

43+import Web.FormUrlEncoded

44+ (ToForm, urlEncodeAsForm)

42

45

43import Servant.API.ContentTypes

46import Servant.API.ContentTypes

44

47

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

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

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

272 cont "" = new

275 cont "" = new

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

276 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