e8db2c6 · typeable/servant

servant-docs/example/greet.hs−3

compare with master

unifiedsplit

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

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

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

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

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

38-- really helpful.

35-- really helpful.

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

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

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE PolyKinds #-}

4{-# LANGUAGE PolyKinds #-}

7{-# LANGUAGE TypeFamilies #-}

5{-# LANGUAGE TypeFamilies #-}

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

28instance FromJSON Greet

26instance FromJSON Greet

29instance ToJSON Greet

27instance ToJSON Greet

30

28

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

32−

33-- API specification

29-- API specification

34type TestApi =

30type TestApi =

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

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

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

3+{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

7module Servant.ArbitraryMonadServerSpec where

4module Servant.ArbitraryMonadServerSpec where

8

5

9import Control.Monad.Reader

6import Control.Monad.Reader

10−import Data.Aeson

11− (encode)

12import Data.Functor.Identity

7import Data.Functor.Identity

13import Data.Proxy

8import Data.Proxy

14import Servant.API

9import Servant.API

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

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

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

66 it "allows combnation of enters" $ do

61 it "allows combnation of enters" $ do

67 get "bool" `shouldRespondWith` "true"

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

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE TypeOperators #-}

2{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

7module Servant.HoistSpec where

3module Servant.HoistSpec where

8

4

9−import Data.Aeson

10− (ToJSON, encode)

11import Test.Hspec

5import Test.Hspec

12 (Spec)

6 (Spec)

13

7

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

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

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

38server' = hoistServer api f server

32server' = hoistServer api f server

39

33

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

41−

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

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

43-- Spec

35-- Spec

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

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

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

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

366-- }}}

363-- }}}

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

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

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeOperators #-}

4+{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeSynonymInstances #-}

7

5

8module Servant.Server.UsingContextSpec where

6module Servant.Server.UsingContextSpec where

9

7

10−import Data.Aeson

11− (encode)

12import Network.Wai

8import Network.Wai

13import Test.Hspec

9import Test.Hspec

14 (Spec, describe, it)

10 (Spec, describe, it)

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

24 spec3

20 spec3

25 spec4

21 spec4

26

22

27−instance MimeRender JSON String where mimeRender _ = encode

28−

29-- * API

23-- * API

30

24

31type OneEntryAPI =

25type OneEntryAPI =

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

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

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

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

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

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

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

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

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

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

54− MimeRender (..),

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

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

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

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

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

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

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

108-- * verbSpec {{{

106-- * verbSpec {{{

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

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

110

108

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

112−

113type VerbApi method status

109type VerbApi method status

114 = Verb method status '[JSON] Person

110 = Verb method status '[JSON] Person

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

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

servant/servant.cabal−1

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

154 , base-compat

155 , aeson

156 , bytestring

157− , http-api-data

158 , http-media

157 , http-media

159 , mtl

158 , mtl

160 , servant

159 , servant

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

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

74import Control.DeepSeq

75 (NFData)

76import Data.Aeson

77− (FromJSON (..))

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

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

105+ (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)

106

107-- * Provided content types

108data JSON deriving Typeable

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

330-- | `TextL.encodeUtf8`

342-- | `TextL.encodeUtf8`

331instance MimeRender PlainText TextL.Text where

343instance MimeRender PlainText TextL.Text where

332 mimeRender _ = TextL.encodeUtf8

344 mimeRender _ = TextL.encodeUtf8

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

376 <* skipSpace

388 <* skipSpace

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

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

378

390

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+

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

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

380instance MimeUnrender PlainText TextL.Text where

402instance MimeUnrender PlainText TextL.Text where

381 mimeUnrender _ = left show . TextL.decodeUtf8'

403 mimeUnrender _ = left show . TextL.decodeUtf8'

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

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

7{-# LANGUAGE PackageImports #-}

6{-# LANGUAGE PackageImports #-}

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

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

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

41import Text.Read

40import Text.Read

42 (readMaybe)

41 (readMaybe)

43−import Web.FormUrlEncoded

44− (ToForm, urlEncodeAsForm)

45

42

46import Servant.API.ContentTypes

43import Servant.API.ContentTypes

47

44

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

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

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

275 cont "" = new

272 cont "" = new

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

273 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