d1496c9 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge pull request #228 from fizruk/generic-to-sample-#151

d1496c9Julian Arni11 years ago

servant-docs/CHANGELOG.md+5

compare with master

unifiedsplit

@@ -2,6 +2,11 @@ HEAD

2----

4* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

5+* Support maximum samples setting with new `DocOptions` type (used by `docsWithOptions` and `docsWith`)

6+* Add Generic-based default implementation for `ToSample` class

7+* Add more `ToSamples` instances: `Bool`, `Ordering`, tuples (up to 7), `[]`, `Maybe`, `Either`, `Const`, `ZipList` and some monoids

8+* Move `toSample` out of `ToSample` class

9+* Add a few helper functions to define `toSamples`

60.4

110.4

7---

12---

servant-docs/example/greet.hs+2−7

@@ -53,19 +53,14 @@ instance ToParam (MatrixParam "lang" String) where

53 "Get the greeting message selected language. Default is en."

54 Normal

56−instance ToSample () () where

57− toSample _ = Just ()

58−

59instance ToSample Greet Greet where

56instance ToSample Greet Greet where

60− toSample _ = Just $ Greet "Hello, haskeller!"

61−

62 toSamples _ =

57 toSamples _ =

63 [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")

58 [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")

64 , ("If you use ?capital=false", Greet "Hello, haskeller")

59 , ("If you use ?capital=false", Greet "Hello, haskeller")

65 ]

60 ]

67instance ToSample Int Int where

62instance ToSample Int Int where

68− toSample _ = Just 1729

63+ toSamples _ = singleSample 1729

70-- We define some introductory sections, these will appear at the top of the

65-- We define some introductory sections, these will appear at the top of the

71-- documentation.

66-- documentation.

@@ -117,7 +112,7 @@ extra =

117--

112--

118-- > docs testAPI :: API

113-- > docs testAPI :: API

119docsGreet :: API

114docsGreet :: API

120−docsGreet = docsWith [intro1, intro2] extra testApi

115+docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi

121

116

122main :: IO ()

117main :: IO ()

123main = putStrLn $ markdown docsGreet

118main = putStrLn $ markdown docsGreet

servant-docs/servant-docs.cabal+1

@@ -42,6 +42,7 @@ library

42 , string-conversions

43 , text

44 , unordered-containers

45+ , control-monad-omega == 0.3.*

45 hs-source-dirs: src

46 hs-source-dirs: src

46 default-language: Haskell2010

47 default-language: Haskell2010

47 ghc-options: -Wall

48 ghc-options: -Wall

servant-docs/src/Servant/Docs.hs+7−1

@@ -144,10 +144,16 @@ module Servant.Docs

144 ( -- * 'HasDocs' class and key functions

145 HasDocs(..), docs, markdown

146 -- * Generating docs with extra information

147− , ExtraInfo(..), docsWith, docsWithIntros, extraInfo

147+ , docsWith, docsWithIntros, docsWithOptions

148+ , ExtraInfo(..), extraInfo

149+ , DocOptions(..) , defaultDocOptions, maxSamples

148

150

149 , -- * Classes you need to implement for your types

151 , -- * Classes you need to implement for your types

150 ToSample(..)

152 ToSample(..)

153+ , toSample

154+ , noSamples

155+ , singleSample

156+ , samples

151 , sampleByteString

157 , sampleByteString

152 , sampleByteStrings

158 , sampleByteStrings

153 , ToParam(..)

159 , ToParam(..)

servant-docs/src/Servant/Docs/Internal.hs+133−188

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE DefaultSignatures #-}

4{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

@@ -8,6 +9,7 @@

8{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE PolyKinds #-}

11{-# LANGUAGE PolyKinds #-}

12+{-# LANGUAGE RecordWildCards #-}

11{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TemplateHaskell #-}

14{-# LANGUAGE TemplateHaskell #-}

13{-# LANGUAGE TupleSections #-}

15{-# LANGUAGE TupleSections #-}

@@ -19,10 +21,10 @@

19#endif

21#endif

20module Servant.Docs.Internal where

22module Servant.Docs.Internal where

22−#if !MIN_VERSION_base(4,8,0)

23import Control.Applicative

24import Control.Applicative

24−#endif

25+import Control.Arrow (second)

25−import Control.Lens hiding (List)

26+import Control.Lens hiding (List, to, from)

27+import qualified Control.Monad.Omega as Omega

26import Data.ByteString.Conversion (ToByteString, toByteString)

28import Data.ByteString.Conversion (ToByteString, toByteString)

27import Data.ByteString.Lazy.Char8 (ByteString)

29import Data.ByteString.Lazy.Char8 (ByteString)

28import qualified Data.CaseInsensitive as CI

30import qualified Data.CaseInsensitive as CI

@@ -175,6 +177,16 @@ instance Monoid (ExtraInfo a) where

175 ExtraInfo a `mappend` ExtraInfo b =

177 ExtraInfo a `mappend` ExtraInfo b =

176 ExtraInfo $ HM.unionWith combineAction a b

178 ExtraInfo $ HM.unionWith combineAction a b

177

179

180+-- | Documentation options.

181+data DocOptions = DocOptions

182+ { _maxSamples :: Int -- ^ Maximum samples allowed.

183+ } deriving (Show)

184+

185+-- | Default documentation options.

186+defaultDocOptions :: DocOptions

187+defaultDocOptions = DocOptions

188+ { _maxSamples = 5 }

189+

178-- | Type of GET parameter:

190-- | Type of GET parameter:

179--

191--

180-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter

192-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter

@@ -279,6 +291,7 @@ single :: Endpoint -> Action -> API

279single e a = API mempty (HM.singleton e a)

291single e a = API mempty (HM.singleton e a)

280

292

281-- gimme some lenses

293-- gimme some lenses

294+makeLenses ''DocOptions

282makeLenses ''API

295makeLenses ''API

283makeLenses ''Endpoint

296makeLenses ''Endpoint

284makeLenses ''DocCapture

297makeLenses ''DocCapture

@@ -290,8 +303,14 @@ makeLenses ''Action

290

303

291-- | Generate the docs for a given API that implements 'HasDocs'. This is the

304-- | Generate the docs for a given API that implements 'HasDocs'. This is the

292-- default way to create documentation.

305-- default way to create documentation.

306+--

307+-- prop> docs == docsWithOptions defaultDocOptions

293docs :: HasDocs layout => Proxy layout -> API

308docs :: HasDocs layout => Proxy layout -> API

309+docs p = docsWithOptions p defaultDocOptions

310+

311+-- | Generate the docs for a given API that implements 'HasDocs'.

312+docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API

294−docs p = docsFor p (defEndpoint, defAction)

313+docsWithOptions p = docsFor p (defEndpoint, defAction)

295

314

296-- | Closed type family, check if endpoint is exactly within API.

315-- | Closed type family, check if endpoint is exactly within API.

297

316

@@ -318,7 +337,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where

318extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)

337extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)

319 => Proxy endpoint -> Action -> ExtraInfo layout

338 => Proxy endpoint -> Action -> ExtraInfo layout

320extraInfo p action =

339extraInfo p action =

321− let api = docsFor p (defEndpoint, defAction)

340+ let api = docsFor p (defEndpoint, defAction) defaultDocOptions

322 -- Assume one endpoint, HasLink constraint means that we should only ever

341 -- Assume one endpoint, HasLink constraint means that we should only ever

323 -- point at one endpoint.

342 -- point at one endpoint.

324 in ExtraInfo $ api ^. apiEndpoints & traversed .~ action

343 in ExtraInfo $ api ^. apiEndpoints & traversed .~ action

@@ -335,21 +354,22 @@ extraInfo p action =

335-- 'extraInfo'.

354-- 'extraInfo'.

336--

355--

337-- If you only want to add an introduction, use 'docsWithIntros'.

356-- If you only want to add an introduction, use 'docsWithIntros'.

338−docsWith :: HasDocs layout => [DocIntro] -> ExtraInfo layout -> Proxy layout -> API

357+docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API

339−docsWith intros (ExtraInfo endpoints) p =

358+docsWith opts intros (ExtraInfo endpoints) p =

359+ docsWithOptions p opts

340− docs p & apiIntros <>~ intros

360+ & apiIntros <>~ intros

341− & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints

361+ & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints

342

362

343

363

344-- | Generate the docs for a given API that implements 'HasDocs' with with any

364-- | Generate the docs for a given API that implements 'HasDocs' with with any

345-- number of introduction(s)

365-- number of introduction(s)

346docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API

366docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API

347−docsWithIntros intros = docsWith intros mempty

367+docsWithIntros intros = docsWith defaultDocOptions intros mempty

348

368

349-- | The class that abstracts away the impact of API combinators

369-- | The class that abstracts away the impact of API combinators

350-- on documentation generation.

370-- on documentation generation.

351class HasDocs layout where

371class HasDocs layout where

352− docsFor :: Proxy layout -> (Endpoint, Action) -> API

372+ docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API

353

373

354-- | The class that lets us display a sample input or output in the supported

374-- | The class that lets us display a sample input or output in the supported

355-- content-types when generating documentation for endpoints that either:

375-- content-types when generating documentation for endpoints that either:

@@ -373,7 +393,7 @@ class HasDocs layout where

373-- > instance ToJSON Greet

393-- > instance ToJSON Greet

374-- >

394-- >

375-- > instance ToSample Greet Greet where

395-- > instance ToSample Greet Greet where

376−-- > toSample _ = Just g

396+-- > toSamples _ = singleSample g

377-- >

397-- >

378-- > where g = Greet "Hello, haskeller!"

398-- > where g = Greet "Hello, haskeller!"

379--

399--

@@ -382,17 +402,64 @@ class HasDocs layout where

382-- some context (as 'Text') that explains when you're supposed to

402-- some context (as 'Text') that explains when you're supposed to

383-- get the corresponding response.

403-- get the corresponding response.

384class ToSample a b | a -> b where

404class ToSample a b | a -> b where

385− {-# MINIMAL (toSample | toSamples) #-}

386− toSample :: Proxy a -> Maybe b

387− toSample _ = snd <$> listToMaybe samples

388− where samples = toSamples (Proxy :: Proxy a)

389−

390 toSamples :: Proxy a -> [(Text, b)]

405 toSamples :: Proxy a -> [(Text, b)]

391− toSamples _ = maybe [] (return . ("",)) s

406+ default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]

407+ toSamples = defaultSamples

408+

409+-- | Sample input or output (if there is at least one).

410+toSample :: forall a b. ToSample a b => Proxy a -> Maybe b

411+toSample _ = snd <$> listToMaybe (toSamples (Proxy :: Proxy a))

412+

413+-- | No samples.

414+noSamples :: [(Text, a)]

415+noSamples = empty

416+

417+-- | Single sample without description.

418+singleSample :: a -> [(Text, a)]

419+singleSample x = [("", x)]

420+

421+-- | Samples without documentation.

422+samples :: [a] -> [(Text, a)]

423+samples = map ("",)

424+

425+-- | Default sample Generic-based inputs/outputs.

426+defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]

427+defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))

428+

429+-- | @'ToSample'@ for Generics.

430+--

431+-- The use of @'Omega'@ allows for more productive sample generation.

432+class GToSample t s where

433+ gtoSamples :: proxy t -> Omega.Omega (Text, s x)

434+

435+instance GToSample U1 U1 where

436+ gtoSamples _ = Omega.each (singleSample U1)

437+

438+instance GToSample V1 V1 where

439+ gtoSamples _ = empty

440+

441+instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where

442+ gtoSamples _ = render <$> ps <*> qs

443+ where

444+ ps = gtoSamples (Proxy :: Proxy p)

392− where s = toSample (Proxy :: Proxy a)

445+ qs = gtoSamples (Proxy :: Proxy q)

446+ render (ta, a) (tb, b)

447+ | T.null ta || T.null tb = (ta <> tb, a :*: b)

448+ | otherwise = (ta <> ", " <> tb, a :*: b)

449+

450+instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') where

451+ gtoSamples _ = lefts <|> rights

452+ where

453+ lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)

454+ rights = second R1 <$> gtoSamples (Proxy :: Proxy q)

455+

456+instance ToSample a b => GToSample (K1 i a) (K1 i b) where

457+ gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))

458+

459+instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where

460+ gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)

393

461

394instance ToSample a b => ToSample (Headers ls a) b where

462instance ToSample a b => ToSample (Headers ls a) b where

395− toSample _ = toSample (Proxy :: Proxy a)

396 toSamples _ = toSamples (Proxy :: Proxy a)

463 toSamples _ = toSamples (Proxy :: Proxy a)

397

464

398

465

@@ -661,11 +728,11 @@ instance

661#endif

728#endif

662 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

729 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

663 => HasDocs (Delete cts a) where

730 => HasDocs (Delete cts a) where

664− docsFor Proxy (endpoint, action) =

731+ docsFor Proxy (endpoint, action) DocOptions{..} =

665 single endpoint' action'

732 single endpoint' action'

666

733

667 where endpoint' = endpoint & method .~ DocDELETE

734 where endpoint' = endpoint & method .~ DocDELETE

668− action' = action & response.respBody .~ sampleByteStrings t p

735+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

669 & response.respTypes .~ supportedTypes t

736 & response.respTypes .~ supportedTypes t

670 t = Proxy :: Proxy cts

737 t = Proxy :: Proxy cts

671 p = Proxy :: Proxy a

738 p = Proxy :: Proxy a

@@ -677,12 +744,12 @@ instance

677 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

744 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

678 , AllHeaderSamples ls , GetHeaders (HList ls) )

745 , AllHeaderSamples ls , GetHeaders (HList ls) )

679 => HasDocs (Delete cts (Headers ls a)) where

746 => HasDocs (Delete cts (Headers ls a)) where

680− docsFor Proxy (endpoint, action) =

747+ docsFor Proxy (endpoint, action) DocOptions{..} =

681 single endpoint' action'

748 single endpoint' action'

682

749

683 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

750 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

684 endpoint' = endpoint & method .~ DocDELETE

751 endpoint' = endpoint & method .~ DocDELETE

685− action' = action & response.respBody .~ sampleByteStrings t p

752+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

686 & response.respTypes .~ supportedTypes t

753 & response.respTypes .~ supportedTypes t

687 & response.respHeaders .~ hdrs

754 & response.respHeaders .~ hdrs

688 t = Proxy :: Proxy cts

755 t = Proxy :: Proxy cts

@@ -694,11 +761,11 @@ instance

694#endif

761#endif

695 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

762 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

696 => HasDocs (Get cts a) where

763 => HasDocs (Get cts a) where

697− docsFor Proxy (endpoint, action) =

764+ docsFor Proxy (endpoint, action) DocOptions{..} =

698 single endpoint' action'

765 single endpoint' action'

699

766

700 where endpoint' = endpoint & method .~ DocGET

767 where endpoint' = endpoint & method .~ DocGET

701− action' = action & response.respBody .~ sampleByteStrings t p

768+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

702 & response.respTypes .~ supportedTypes t

769 & response.respTypes .~ supportedTypes t

703 t = Proxy :: Proxy cts

770 t = Proxy :: Proxy cts

704 p = Proxy :: Proxy a

771 p = Proxy :: Proxy a

@@ -710,12 +777,12 @@ instance

710 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

777 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

711 , AllHeaderSamples ls , GetHeaders (HList ls) )

778 , AllHeaderSamples ls , GetHeaders (HList ls) )

712 => HasDocs (Get cts (Headers ls a)) where

779 => HasDocs (Get cts (Headers ls a)) where

713− docsFor Proxy (endpoint, action) =

780+ docsFor Proxy (endpoint, action) DocOptions{..} =

714 single endpoint' action'

781 single endpoint' action'

715

782

716 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

783 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

717 endpoint' = endpoint & method .~ DocGET

784 endpoint' = endpoint & method .~ DocGET

718− action' = action & response.respBody .~ sampleByteStrings t p

785+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

719 & response.respTypes .~ supportedTypes t

786 & response.respTypes .~ supportedTypes t

720 & response.respHeaders .~ hdrs

787 & response.respHeaders .~ hdrs

721 t = Proxy :: Proxy cts

788 t = Proxy :: Proxy cts

@@ -736,11 +803,11 @@ instance

736#endif

803#endif

737 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

804 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

738 => HasDocs (Post cts a) where

805 => HasDocs (Post cts a) where

739− docsFor Proxy (endpoint, action) =

806+ docsFor Proxy (endpoint, action) DocOptions{..} =

740 single endpoint' action'

807 single endpoint' action'

741

808

742 where endpoint' = endpoint & method .~ DocPOST

809 where endpoint' = endpoint & method .~ DocPOST

743− action' = action & response.respBody .~ sampleByteStrings t p

810+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

744 & response.respTypes .~ supportedTypes t

811 & response.respTypes .~ supportedTypes t

745 & response.respStatus .~ 201

812 & response.respStatus .~ 201

746 t = Proxy :: Proxy cts

813 t = Proxy :: Proxy cts

@@ -753,12 +820,12 @@ instance

753 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

820 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

754 , AllHeaderSamples ls , GetHeaders (HList ls) )

821 , AllHeaderSamples ls , GetHeaders (HList ls) )

755 => HasDocs (Post cts (Headers ls a)) where

822 => HasDocs (Post cts (Headers ls a)) where

756− docsFor Proxy (endpoint, action) =

823+ docsFor Proxy (endpoint, action) DocOptions{..} =

757 single endpoint' action'

824 single endpoint' action'

758

825

759 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

826 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

760 endpoint' = endpoint & method .~ DocPOST

827 endpoint' = endpoint & method .~ DocPOST

761− action' = action & response.respBody .~ sampleByteStrings t p

828+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

762 & response.respTypes .~ supportedTypes t

829 & response.respTypes .~ supportedTypes t

763 & response.respStatus .~ 201

830 & response.respStatus .~ 201

764 & response.respHeaders .~ hdrs

831 & response.respHeaders .~ hdrs

@@ -771,11 +838,11 @@ instance

771#endif

838#endif

772 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

839 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)

773 => HasDocs (Put cts a) where

840 => HasDocs (Put cts a) where

774− docsFor Proxy (endpoint, action) =

841+ docsFor Proxy (endpoint, action) DocOptions{..} =

775 single endpoint' action'

842 single endpoint' action'

776

843

777 where endpoint' = endpoint & method .~ DocPUT

844 where endpoint' = endpoint & method .~ DocPUT

778− action' = action & response.respBody .~ sampleByteStrings t p

845+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

779 & response.respTypes .~ supportedTypes t

846 & response.respTypes .~ supportedTypes t

780 & response.respStatus .~ 200

847 & response.respStatus .~ 200

781 t = Proxy :: Proxy cts

848 t = Proxy :: Proxy cts

@@ -788,12 +855,12 @@ instance

788 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

855 (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts

789 , AllHeaderSamples ls , GetHeaders (HList ls) )

856 , AllHeaderSamples ls , GetHeaders (HList ls) )

790 => HasDocs (Put cts (Headers ls a)) where

857 => HasDocs (Put cts (Headers ls a)) where

791− docsFor Proxy (endpoint, action) =

858+ docsFor Proxy (endpoint, action) DocOptions{..} =

792 single endpoint' action'

859 single endpoint' action'

793

860

794 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

861 where hdrs = allHeaderToSample (Proxy :: Proxy ls)

795 endpoint' = endpoint & method .~ DocPUT

862 endpoint' = endpoint & method .~ DocPUT

796− action' = action & response.respBody .~ sampleByteStrings t p

863+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

797 & response.respTypes .~ supportedTypes t

864 & response.respTypes .~ supportedTypes t

798 & response.respStatus .~ 200

865 & response.respStatus .~ 200

799 & response.respHeaders .~ hdrs

866 & response.respHeaders .~ hdrs

@@ -875,7 +942,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)

875 symP = Proxy :: Proxy sym

942 symP = Proxy :: Proxy sym

876

943

877instance HasDocs Raw where

944instance HasDocs Raw where

878− docsFor _proxy (endpoint, action) =

945+ docsFor _proxy (endpoint, action) _ =

879 single endpoint action

946 single endpoint action

880

947

881-- TODO: We use 'AllMimeRender' here because we need to be able to show the

948-- TODO: We use 'AllMimeRender' here because we need to be able to show the

@@ -920,155 +987,33 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where

920 docsFor Proxy ep =

987 docsFor Proxy ep =

921 docsFor (Proxy :: Proxy sublayout) ep

988 docsFor (Proxy :: Proxy sublayout) ep

922

989

990+-- ToSample instances for simple types

991+instance ToSample () ()

992+instance ToSample Bool Bool

993+instance ToSample Ordering Ordering

994+

995+-- polymorphic ToSample instances

996+instance (ToSample a a, ToSample b b) => ToSample (a, b) (a, b)

997+instance (ToSample a a, ToSample b b, ToSample c c) => ToSample (a, b, c) (a, b, c)

998+instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d) => ToSample (a, b, c, d) (a, b, c, d)

999+instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e) => ToSample (a, b, c, d, e) (a, b, c, d, e)

1000+instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f)

1001+instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f, ToSample g g) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)

1002+

1003+instance ToSample a a => ToSample (Maybe a) (Maybe a)

1004+instance (ToSample a a, ToSample b b) => ToSample (Either a b) (Either a b)

1005+instance ToSample a a => ToSample [a] [a]

1006+

1007+-- ToSample instances for Control.Applicative types

1008+instance ToSample a a => ToSample (Const a b) (Const a b)

1009+instance ToSample a a => ToSample (ZipList a) (ZipList a)

1010+

1011+-- ToSample instances for Data.Monoid newtypes

1012+instance ToSample All All

1013+instance ToSample Any Any

1014+instance ToSample a a => ToSample (Sum a) (Sum a)

1015+instance ToSample a a => ToSample (Product a) (Product a)

1016+instance ToSample a a => ToSample (First a) (First a)

1017+instance ToSample a a => ToSample (Last a) (Last a)

1018+instance ToSample a a => ToSample (Dual a) (Dual a)

923

1019

924−-- polymorphic 'ToSample' instances

925−

926−instance ( ToSample a a

927− , ToSample b b

928− ) => ToSample (a, b) (a, b) where

929− toSample _ = (,)

930− <$> toSample (Proxy :: Proxy a)

931− <*> toSample (Proxy :: Proxy b)

932− toSamples _ = render

933− <$> toSamples (Proxy :: Proxy a)

934− <*> toSamples (Proxy :: Proxy b)

935− where render (ta, va) (tb, vb)

936− = ("(" <> ta <>

937− ", " <> tb <>

938− ")"

939− , (va, vb))

940−

941−instance ( ToSample a a

942− , ToSample b b

943− , ToSample c c

944− ) => ToSample (a, b, c) (a, b, c) where

945− toSample _ = (,,)

946− <$> toSample (Proxy :: Proxy a)

947− <*> toSample (Proxy :: Proxy b)

948− <*> toSample (Proxy :: Proxy c)

949− toSamples _ = render

950− <$> toSamples (Proxy :: Proxy a)

951− <*> toSamples (Proxy :: Proxy b)

952− <*> toSamples (Proxy :: Proxy c)

953− where render (ta, va) (tb, vb) (tc, vc)

954− = ("(" <> ta <>

955− ", " <> tb <>

956− ", " <> tc <>

957− ")"

958− , (va, vb, vc))

959−

960−instance ( ToSample a a

961− , ToSample b b

962− , ToSample c c

963− , ToSample d d

964− ) => ToSample (a, b, c, d) (a, b, c, d) where

965− toSample _ = (,,,)

966− <$> toSample (Proxy :: Proxy a)

967− <*> toSample (Proxy :: Proxy b)

968− <*> toSample (Proxy :: Proxy c)

969− <*> toSample (Proxy :: Proxy d)

970− toSamples _ = render

971− <$> toSamples (Proxy :: Proxy a)

972− <*> toSamples (Proxy :: Proxy b)

973− <*> toSamples (Proxy :: Proxy c)

974− <*> toSamples (Proxy :: Proxy d)

975− where render (ta, va) (tb, vb) (tc, vc) (td, vd)

976− = ("(" <> ta <>

977− ", " <> tb <>

978− ", " <> tc <>

979− ", " <> td <>

980− ")"

981− , (va, vb, vc, vd))

982−

983−instance ( ToSample a a

984− , ToSample b b

985− , ToSample c c

986− , ToSample d d

987− , ToSample e e

988− ) => ToSample (a, b, c, d, e) (a, b, c, d, e) where

989− toSample _ = (,,,,)

990− <$> toSample (Proxy :: Proxy a)

991− <*> toSample (Proxy :: Proxy b)

992− <*> toSample (Proxy :: Proxy c)

993− <*> toSample (Proxy :: Proxy d)

994− <*> toSample (Proxy :: Proxy e)

995− toSamples _ = render

996− <$> toSamples (Proxy :: Proxy a)

997− <*> toSamples (Proxy :: Proxy b)

998− <*> toSamples (Proxy :: Proxy c)

999− <*> toSamples (Proxy :: Proxy d)

1000− <*> toSamples (Proxy :: Proxy e)

1001− where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve)

1002− = ("(" <> ta <>

1003− ", " <> tb <>

1004− ", " <> tc <>

1005− ", " <> td <>

1006− ", " <> te <>

1007− ")"

1008− , (va, vb, vc, vd, ve))

1009−

1010−instance ( ToSample a a

1011− , ToSample b b

1012− , ToSample c c

1013− , ToSample d d

1014− , ToSample e e

1015− , ToSample f f

1016− ) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f) where

1017− toSample _ = (,,,,,)

1018− <$> toSample (Proxy :: Proxy a)

1019− <*> toSample (Proxy :: Proxy b)

1020− <*> toSample (Proxy :: Proxy c)

1021− <*> toSample (Proxy :: Proxy d)

1022− <*> toSample (Proxy :: Proxy e)

1023− <*> toSample (Proxy :: Proxy f)

1024− toSamples _ = render

1025− <$> toSamples (Proxy :: Proxy a)

1026− <*> toSamples (Proxy :: Proxy b)

1027− <*> toSamples (Proxy :: Proxy c)

1028− <*> toSamples (Proxy :: Proxy d)

1029− <*> toSamples (Proxy :: Proxy e)

1030− <*> toSamples (Proxy :: Proxy f)

1031− where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf)

1032− = ("(" <> ta <>

1033− ", " <> tb <>

1034− ", " <> tc <>

1035− ", " <> td <>

1036− ", " <> te <>

1037− ", " <> tf <>

1038− ")"

1039− , (va, vb, vc, vd, ve, vf))

1040−

1041−instance ( ToSample a a

1042− , ToSample b b

1043− , ToSample c c

1044− , ToSample d d

1045− , ToSample e e

1046− , ToSample f f

1047− , ToSample g g

1048− ) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) where

1049− toSample _ = (,,,,,,)

1050− <$> toSample (Proxy :: Proxy a)

1051− <*> toSample (Proxy :: Proxy b)

1052− <*> toSample (Proxy :: Proxy c)

1053− <*> toSample (Proxy :: Proxy d)

1054− <*> toSample (Proxy :: Proxy e)

1055− <*> toSample (Proxy :: Proxy f)

1056− <*> toSample (Proxy :: Proxy g)

1057− toSamples _ = render

1058− <$> toSamples (Proxy :: Proxy a)

1059− <*> toSamples (Proxy :: Proxy b)

1060− <*> toSamples (Proxy :: Proxy c)

1061− <*> toSamples (Proxy :: Proxy d)

1062− <*> toSamples (Proxy :: Proxy e)

1063− <*> toSamples (Proxy :: Proxy f)

1064− <*> toSamples (Proxy :: Proxy g)

1065− where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) (tg, vg)

1066− = ("(" <> ta <>

1067− ", " <> tb <>

1068− ", " <> tc <>

1069− ", " <> td <>

1070− ", " <> te <>

1071− ", " <> tf <>

1072− ", " <> tg <>

1073− ")"

1074− , (va, vb, vc, vd, ve, vf, vg))

servant-docs/test/Servant/DocsSpec.hs+15−13

@@ -36,7 +36,7 @@ spec = describe "Servant.Docs" $ do

36 extraInfo

37 (Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1))

38 (defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]])

39− md = markdown (docsWith [] extra (Proxy :: Proxy TestApi1))

39+ md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))

40 tests md

41 it "contains the extra info provided" $ do

42 md `shouldContain` "Get an Integer"

@@ -49,14 +49,18 @@ spec = describe "Servant.Docs" $ do

49 (toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1)

50 (toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1)

51 (toSamples (Proxy :: Proxy (TT, UT))) `shouldBe`

52− [ ("(eins, yks)",(TT1,UT1)), ("(eins, kaks)",(TT1,UT2))

52+ [ ("eins, yks",(TT1,UT1)), ("eins, kaks",(TT1,UT2))

53− , ("(zwei, yks)",(TT2,UT1)), ("(zwei, kaks)",(TT2,UT2))

53+ , ("zwei, yks",(TT2,UT1)), ("zwei, kaks",(TT2,UT2))

54 ]

55 (toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe`

56+ [ ("eins, yks, yks",(TT1,UT1,UT1))

56− [ ("(eins, yks, yks)",(TT1,UT1,UT1)), ("(eins, yks, kaks)",(TT1,UT1,UT2))

57+ , ("eins, yks, kaks",(TT1,UT1,UT2))

58+ , ("zwei, yks, yks",(TT2,UT1,UT1))

57− , ("(eins, kaks, yks)",(TT1,UT2,UT1)), ("(eins, kaks, kaks)",(TT1,UT2,UT2))

59+ , ("eins, kaks, yks",(TT1,UT2,UT1))

58− , ("(zwei, yks, yks)",(TT2,UT1,UT1)), ("(zwei, yks, kaks)",(TT2,UT1,UT2))

60+ , ("zwei, yks, kaks",(TT2,UT1,UT2))

61+ , ("eins, kaks, kaks",(TT1,UT2,UT2))

62+ , ("zwei, kaks, yks",(TT2,UT2,UT1))

59− , ("(zwei, kaks, yks)",(TT2,UT2,UT1)), ("(zwei, kaks, kaks)",(TT2,UT2,UT2))

63+ , ("zwei, kaks, kaks",(TT2,UT2,UT2))

60 ]

64 ]

62 where

66 where

@@ -87,13 +91,13 @@ data Datatype1 = Datatype1 { dt1field1 :: String

87instance ToJSON Datatype1

91instance ToJSON Datatype1

89instance ToSample Datatype1 Datatype1 where

93instance ToSample Datatype1 Datatype1 where

90− toSample _ = Just $ Datatype1 "field 1" 13

94+ toSamples _ = singleSample $ Datatype1 "field 1" 13

92−instance ToSample String String where

96+instance ToSample Char Char where

93− toSample _ = Just "a string"

97+ toSamples _ = samples ['a'..'z']

95instance ToSample Int Int where

99instance ToSample Int Int where

96− toSample _ = Just 17

100+ toSamples _ = singleSample 17

101

98instance MimeRender PlainText Int where

102instance MimeRender PlainText Int where

99 mimeRender _ = cs . show

103 mimeRender _ = cs . show

@@ -105,9 +109,7 @@ data TT = TT1 | TT2 deriving (Show, Eq)

105data UT = UT1 | UT2 deriving (Show, Eq)

109data UT = UT1 | UT2 deriving (Show, Eq)

106

110

107instance ToSample TT TT where

111instance ToSample TT TT where

108− toSample _ = Just TT1

109 toSamples _ = [("eins", TT1), ("zwei", TT2)]

112 toSamples _ = [("eins", TT1), ("zwei", TT2)]

110

113

111instance ToSample UT UT where

114instance ToSample UT UT where

112− toSample _ = Just UT1

113 toSamples _ = [("yks", UT1), ("kaks", UT2)]

115 toSamples _ = [("yks", UT1), ("kaks", UT2)]

servant-examples/tutorial/T10.hs+3−3

@@ -24,7 +24,7 @@ instance ToCapture (Capture "y" Int) where

24 toCapture _ = DocCapture "y" "(integer) position on the y axis"

26instance ToSample T3.Position T3.Position where

27− toSample _ = Just (T3.Position 3 14)

27+ toSamples _ = singleSample (T3.Position 3 14)

29instance ToParam (QueryParam "name" String) where

30 toParam _ =

@@ -43,10 +43,10 @@ ci :: T3.ClientInfo

43ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]

45instance ToSample T3.ClientInfo T3.ClientInfo where

46− toSample _ = Just ci

46+ toSamples _ = singleSample ci

48instance ToSample T3.Email T3.Email where

49− toSample _ = Just (T3.emailForClient ci)

49+ toSamples _ = singleSample (T3.emailForClient ci)

51api :: Proxy DocsAPI

52api = Proxy

stack-ghc-7.8.4.yaml+1

@@ -19,4 +19,5 @@ extra-deps:

19- engine-io-wai-1.0.3

20- socket-io-1.3.3

21- stm-delay-0.1.1.1

22+- control-monad-omega-0.3.1

22resolver: lts-2.22

23resolver: lts-2.22

stack.yaml+1

@@ -14,4 +14,5 @@ packages:

14- servant-server/

15extra-deps:

16- engine-io-wai-1.0.2

17+- control-monad-omega-0.3.1

17resolver: nightly-2015-09-10

18resolver: nightly-2015-09-10