servant-docs 0.4.4.7 → 0.5
raw patch · 11 files changed
+466/−423 lines, 11 filesdep +aeson-prettydep +control-monad-omegadep ~servantsetup-changed
Dependencies added: aeson-pretty, control-monad-omega
Dependency ranges changed: servant
Files
- CHANGELOG.md +12/−3
- LICENSE +1/−1
- README.md +1/−1
- Setup.hs +1/−1
- example/greet.hs +5/−17
- include/overlapping-compat.h +8/−0
- servant-docs.cabal +12/−5
- src/Servant/Docs.hs +11/−124
- src/Servant/Docs/Internal.hs +230/−271
- src/Servant/Docs/Internal/Pretty.hs +48/−0
- test/Servant/DocsSpec.hs +137/−0
CHANGELOG.md view
@@ -1,6 +1,15 @@-0.4.3-------* docsWith will no longer eat your documentation (https://github.com/haskell-servant/servant/pull/124)+0.5+----++* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators+* Support maximum samples setting with new `DocOptions` type (used by `docsWithOptions` and `docsWith`)+* Remove redundant second parameter of ToSample+* Add Generic-based default implementation for `ToSample` class+* Add more `ToSamples` instances: `Bool`, `Ordering`, tuples (up to 7), `[]`, `Maybe`, `Either`, `Const`, `ZipList` and some monoids+* Move `toSample` out of `ToSample` class+* Add a few helper functions to define `toSamples`+* Remove matrix params.+* Added support for Basic authentication 0.4 ---
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014, Zalora South East Asia Pte Ltd+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors All rights reserved.
README.md view
@@ -6,7 +6,7 @@ ## Example -See [here](https://github.com/haskell-servant/servant/tree/master/servant-docs/blob/master/example/greet.md) for the output of the following program.+See [here](https://github.com/haskell-servant/servant/blob/master/servant-docs/example/greet.md) for the output of the following program. ``` haskell {-# LANGUAGE DataKinds #-}
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
example/greet.hs view
@@ -46,26 +46,14 @@ \Default is false." Normal -instance ToParam (MatrixParam "lang" String) where- toParam _ =- DocQueryParam "lang"- ["en", "sv", "fr"]- "Get the greeting message selected language. Default is en."- Normal--instance ToSample () () where- toSample _ = Just ()--instance ToSample Greet Greet where- toSample _ = Just $ Greet "Hello, haskeller!"-+instance ToSample Greet where toSamples _ = [ ("If you use ?capital=true", Greet "HELLO, HASKELLER") , ("If you use ?capital=false", Greet "Hello, haskeller") ] -instance ToSample Int Int where- toSample _ = Just 1729+instance ToSample Int where+ toSamples _ = singleSample 1729 -- We define some introductory sections, these will appear at the top of the -- documentation.@@ -86,7 +74,7 @@ -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText- "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet+ "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet -- POST /greet with a Greet as JSON in the request body, -- returns a Greet as JSON@@ -117,7 +105,7 @@ -- -- > docs testAPI :: API docsGreet :: API-docsGreet = docsWith [intro1, intro2] extra testApi+docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi main :: IO () main = putStrLn $ markdown docsGreet
+ include/overlapping-compat.h view
@@ -0,0 +1,8 @@+#if __GLASGOW_HASKELL__ >= 710+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}+#define OVERLAPPING_ {-# OVERLAPPING #-}+#else+{-# LANGUAGE OverlappingInstances #-}+#define OVERLAPPABLE_+#define OVERLAPPING_+#endif
servant-docs.cabal view
@@ -1,5 +1,5 @@ name: servant-docs-version: 0.4.4.7+version: 0.5 synopsis: generate API docs for your servant webservice description: Library for generating API docs from a servant API definition.@@ -9,9 +9,9 @@ <https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md CHANGELOG> license: BSD3 license-file: LICENSE-author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni-maintainer: alpmestan@gmail.com-copyright: 2014-2015 Zalora South East Asia Pte Ltd+author: Servant Contributors+maintainer: haskell-servant-maintainers@googlegroups.com+copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors category: Web build-type: Simple cabal-version: >=1.10@@ -19,6 +19,7 @@ homepage: http://haskell-servant.github.io/ Bug-reports: http://github.com/haskell-servant/servant/issues extra-source-files:+ include/*.h CHANGELOG.md README.md source-repository head@@ -29,8 +30,11 @@ exposed-modules: Servant.Docs , Servant.Docs.Internal+ , Servant.Docs.Internal.Pretty build-depends: base >=4.7 && <5+ , aeson+ , aeson-pretty , bytestring , bytestring-conversion , case-insensitive@@ -38,13 +42,15 @@ , http-media >= 0.6 , http-types >= 0.7 , lens- , servant == 0.4.*+ , servant == 0.5.* , string-conversions , text , unordered-containers+ , control-monad-omega == 0.3.* hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall+ include-dirs: include executable greet-docs main-is: greet.hs@@ -64,6 +70,7 @@ test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules: Servant.DocsSpec hs-source-dirs: test ghc-options: -Wall build-depends:
src/Servant/Docs.hs view
@@ -20,142 +20,28 @@ -- The only thing you'll need to do will be to implement some classes -- for your captures, get parameters and request or response bodies. ----- Here is a complete example that you can run to see the markdown pretty--- printer in action:------ > {-# LANGUAGE DataKinds #-}--- > {-# LANGUAGE DeriveGeneric #-}--- > {-# LANGUAGE FlexibleInstances #-}--- > {-# LANGUAGE MultiParamTypeClasses #-}--- > {-# LANGUAGE OverloadedStrings #-}--- > {-# LANGUAGE TypeOperators #-}--- > {-# OPTIONS_GHC -fno-warn-orphans #-}--- > import Control.Lens--- > import Data.Aeson--- > import Data.Proxy--- > import Data.String.Conversions--- > import Data.Text (Text)--- > import GHC.Generics--- > import Servant.API--- > import Servant.Docs--- >--- > -- * Example--- >--- > -- | A greet message data type--- > newtype Greet = Greet Text--- > deriving (Generic, Show)--- >--- > -- | We can get JSON support automatically. This will be used to parse--- > -- and encode a Greeting as 'JSON'.--- > instance FromJSON Greet--- > instance ToJSON Greet--- >--- > -- | We can also implement 'MimeRender' for additional formats like 'PlainText'.--- > instance MimeRender PlainText Greet where--- > mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""--- >--- > -- We add some useful annotations to our captures,--- > -- query parameters and request body to make the docs--- > -- really helpful.--- > instance ToCapture (Capture "name" Text) where--- > toCapture _ = DocCapture "name" "name of the person to greet"--- >--- > instance ToCapture (Capture "greetid" Text) where--- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"--- >--- > instance ToParam (QueryParam "capital" Bool) where--- > toParam _ =--- > DocQueryParam "capital"--- > ["true", "false"]--- > "Get the greeting message in uppercase (true) or not (false).\--- > \Default is false."--- > Normal--- >--- > instance ToParam (MatrixParam "lang" String) where--- > toParam _ =--- > DocQueryParam "lang"--- > ["en", "sv", "fr"]--- > "Get the greeting message selected language. Default is en."--- > Normal--- >--- > instance ToSample Greet Greet where--- > toSample _ = Just $ Greet "Hello, haskeller!"--- >--- > toSamples _ =--- > [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")--- > , ("If you use ?capital=false", Greet "Hello, haskeller")--- > ]--- >--- > -- We define some introductory sections, these will appear at the top of the--- > -- documentation.--- > ----- > -- We pass them in with 'docsWith', below. If you only want to add--- > -- introductions, you may use 'docsWithIntros'--- > intro1 :: DocIntro--- > intro1 = DocIntro "On proper introductions." -- The title--- > [ "Hello there."--- > , "As documentation is usually written for humans, it's often useful \--- > \to introduce concepts with a few words." ] -- Elements are paragraphs--- >--- > intro2 :: DocIntro--- > intro2 = DocIntro "This title is below the last"--- > [ "You'll also note that multiple intros are possible." ]--- >--- >--- > -- API specification--- > type TestApi =--- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText--- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet--- >--- > -- POST /greet with a Greet as JSON in the request body,--- > -- returns a Greet as JSON--- > :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet--- >--- > -- DELETE /greet/:greetid--- > :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()--- >--- > testApi :: Proxy TestApi--- > testApi = Proxy--- >--- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We--- > -- want to add documentation about a secret unicorn header and some extra--- > -- notes.--- > extra :: ExtraInfo TestApi--- > extra =--- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] ())) $--- > defAction & headers <>~ ["unicorns"]--- > & notes <>~ [ DocNote "Title" ["This is some text"]--- > , DocNote "Second secton" ["And some more"]--- > ]--- >--- > -- Generate the data that lets us have API docs. This--- > -- is derived from the type as well as from--- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.--- > ----- > -- If you didn't want intros and extra information, you could just call:--- > ----- > -- > docs testAPI :: API--- > docsGreet :: API--- > docsGreet = docsWith [intro1, intro2] extra testApi--- >--- > main :: IO ()--- > main = putStrLn $ markdown docsGreet+-- See example/greet.hs for an example. module Servant.Docs ( -- * 'HasDocs' class and key functions- HasDocs(..), docs, markdown+ HasDocs(..), docs, pretty, markdown -- * Generating docs with extra information- , ExtraInfo(..), docsWith, docsWithIntros, extraInfo+ , docsWith, docsWithIntros, docsWithOptions+ , ExtraInfo(..), extraInfo+ , DocOptions(..) , defaultDocOptions, maxSamples , -- * Classes you need to implement for your types ToSample(..)+ , toSample+ , noSamples+ , singleSample+ , samples , sampleByteString , sampleByteStrings , ToParam(..) , ToCapture(..) , -- * ADTs to represent an 'API'- Method(..)- , Endpoint, path, method, defEndpoint+ Endpoint, path, method, defEndpoint , API, apiIntros, apiEndpoints, emptyAPI , DocCapture(..), capSymbol, capDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind@@ -167,3 +53,4 @@ ) where import Servant.Docs.Internal+import Servant.Docs.Internal.Pretty
src/Servant/Docs/Internal.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -8,25 +9,25 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-#if !MIN_VERSION_base(4,8,0)-{-# LANGUAGE OverlappingInstances #-}-#endif++#include "overlapping-compat.h" module Servant.Docs.Internal where -#if !MIN_VERSION_base(4,8,0) import Control.Applicative-#endif-import Control.Lens (makeLenses, over, traversed, (%~),- (&), (.~), (<>~), (^.), _1, _2,- _last, (|>))+import Control.Arrow (second)+import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),+ (&), (.~), (<>~), (^.), (|>))+import qualified Control.Monad.Omega as Omega import Data.ByteString.Conversion (ToByteString, toByteString) import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BSC import qualified Data.CaseInsensitive as CI import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap)@@ -36,7 +37,7 @@ import Data.Ord (comparing) import Data.Proxy (Proxy(Proxy)) import Data.String.Conversions (cs)-import Data.Text (Text, pack, unpack)+import Data.Text (Text, unpack) import GHC.Exts (Constraint) import GHC.Generics import GHC.TypeLits@@ -49,21 +50,6 @@ import qualified Network.HTTP.Media as M import qualified Network.HTTP.Types as HTTP --- | Supported HTTP request methods-data Method = DocDELETE -- ^ the DELETE method- | DocGET -- ^ the GET method- | DocPOST -- ^ the POST method- | DocPUT -- ^ the PUT method- deriving (Eq, Ord, Generic)--instance Show Method where- show DocGET = "GET"- show DocPOST = "POST"- show DocDELETE = "DELETE"- show DocPUT = "PUT"--instance Hashable Method- -- | An 'Endpoint' type that holds the 'path' and the 'method'. -- -- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'@@ -75,12 +61,12 @@ -- GET / -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost' -- POST /foo -- @ data Endpoint = Endpoint- { _path :: [String] -- type collected- , _method :: Method -- type collected+ { _path :: [String] -- type collected+ , _method :: HTTP.Method -- type collected } deriving (Eq, Ord, Generic) instance Show Endpoint where@@ -94,7 +80,7 @@ showPath [] = "/" showPath ps = concatMap ('/' :) ps --- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'+-- | An 'Endpoint' whose path is `"/"` and whose method is @GET@ -- -- Here's how you can modify it: --@@ -103,11 +89,11 @@ -- GET / -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] -- GET /foo--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost' -- POST /foo -- @ defEndpoint :: Endpoint-defEndpoint = Endpoint [] DocGET+defEndpoint = Endpoint [] HTTP.methodGet instance Hashable Endpoint @@ -154,6 +140,12 @@ , _introBody :: [String] -- ^ Each String is a paragraph. } deriving (Eq, Show) +-- | A type to represent Authentication information about an endpoint.+data DocAuthentication = DocAuthentication+ { _authIntro :: String+ , _authDataRequired :: String+ } deriving (Eq, Ord, Show)+ instance Ord DocIntro where compare = comparing _introTitle @@ -177,6 +169,16 @@ ExtraInfo a `mappend` ExtraInfo b = ExtraInfo $ HM.unionWith combineAction a b +-- | Documentation options.+data DocOptions = DocOptions+ { _maxSamples :: Int -- ^ Maximum samples allowed.+ } deriving (Show)++-- | Default documentation options.+defaultDocOptions :: DocOptions+defaultDocOptions = DocOptions+ { _maxSamples = 5 }+ -- | Type of GET parameter: -- -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter@@ -234,7 +236,8 @@ -- You can tweak an 'Action' (like the default 'defAction') with these lenses -- to transform an action and add some information to it. data Action = Action- { _captures :: [DocCapture] -- type collected + user supplied info+ { _authInfo :: [DocAuthentication] -- user supplied info+ , _captures :: [DocCapture] -- type collected + user supplied info , _headers :: [Text] -- type collected , _params :: [DocQueryParam] -- type collected + user supplied info , _notes :: [DocNote] -- user supplied@@ -251,8 +254,8 @@ -- 'combineAction' to mush two together taking the response, body and content -- types from the very left. combineAction :: Action -> Action -> Action-Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =- Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =+ Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp -- Default 'Action'. Has no 'captures', no GET 'params', expects -- no request body ('rqbody') and the typical response is 'defResponse'.@@ -272,6 +275,7 @@ [] [] []+ [] defResponse -- | Create an API that's comprised of a single endpoint.@@ -281,6 +285,8 @@ single e a = API mempty (HM.singleton e a) -- gimme some lenses+makeLenses ''DocAuthentication+makeLenses ''DocOptions makeLenses ''API makeLenses ''Endpoint makeLenses ''DocCapture@@ -292,9 +298,15 @@ -- | Generate the docs for a given API that implements 'HasDocs'. This is the -- default way to create documentation.+--+-- prop> docs == docsWithOptions defaultDocOptions docs :: HasDocs layout => Proxy layout -> API-docs p = docsFor p (defEndpoint, defAction)+docs p = docsWithOptions p defaultDocOptions +-- | Generate the docs for a given API that implements 'HasDocs'.+docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API+docsWithOptions p = docsFor p (defEndpoint, defAction)+ -- | Closed type family, check if endpoint is exactly within API. -- We aren't sure what affects how an Endpoint is built up, so we require an@@ -320,7 +332,7 @@ extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint) => Proxy endpoint -> Action -> ExtraInfo layout extraInfo p action =- let api = docsFor p (defEndpoint, defAction)+ let api = docsFor p (defEndpoint, defAction) defaultDocOptions -- Assume one endpoint, HasLink constraint means that we should only ever -- point at one endpoint. in ExtraInfo $ api ^. apiEndpoints & traversed .~ action@@ -337,21 +349,22 @@ -- 'extraInfo'. -- -- If you only want to add an introduction, use 'docsWithIntros'.-docsWith :: HasDocs layout => [DocIntro] -> ExtraInfo layout -> Proxy layout -> API-docsWith intros (ExtraInfo endpoints) p =- docs p & apiIntros <>~ intros- & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints+docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API+docsWith opts intros (ExtraInfo endpoints) p =+ docsWithOptions p opts+ & apiIntros <>~ intros+ & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints -- | Generate the docs for a given API that implements 'HasDocs' with with any -- number of introduction(s) docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API-docsWithIntros intros = docsWith intros mempty+docsWithIntros intros = docsWith defaultDocOptions intros mempty -- | The class that abstracts away the impact of API combinators -- on documentation generation. class HasDocs layout where- docsFor :: Proxy layout -> (Endpoint, Action) -> API+ docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API -- | The class that lets us display a sample input or output in the supported -- content-types when generating documentation for endpoints that either:@@ -374,8 +387,8 @@ -- > instance FromJSON Greet -- > instance ToJSON Greet -- >--- > instance ToSample Greet Greet where--- > toSample _ = Just g+-- > instance ToSample Greet where+-- > toSamples _ = singleSample g -- > -- > where g = Greet "Hello, haskeller!" --@@ -383,30 +396,74 @@ -- 'toSample': it lets you specify different responses along with -- some context (as 'Text') that explains when you're supposed to -- get the corresponding response.-class ToSample a b | a -> b where- {-# MINIMAL (toSample | toSamples) #-}- toSample :: Proxy a -> Maybe b- toSample _ = snd <$> listToMaybe samples- where samples = toSamples (Proxy :: Proxy a)+class ToSample a where+ toSamples :: Proxy a -> [(Text, a)]+ default toSamples :: (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]+ toSamples = defaultSamples - toSamples :: Proxy a -> [(Text, b)]- toSamples _ = maybe [] (return . ("",)) s- where s = toSample (Proxy :: Proxy a)+-- | Sample input or output (if there is at least one).+toSample :: forall a. ToSample a => Proxy a -> Maybe a+toSample _ = snd <$> listToMaybe (toSamples (Proxy :: Proxy a)) -instance ToSample a b => ToSample (Headers ls a) b where- toSample _ = toSample (Proxy :: Proxy a)- toSamples _ = toSamples (Proxy :: Proxy a)+-- | No samples.+noSamples :: [(Text, a)]+noSamples = empty +-- | Single sample without description.+singleSample :: a -> [(Text, a)]+singleSample x = [("", x)] +-- | Samples without documentation.+samples :: [a] -> [(Text, a)]+samples = map ("",)++-- | Default sample Generic-based inputs/outputs.+defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]+defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))++-- | @'ToSample'@ for Generics.+--+-- The use of @'Omega'@ allows for more productive sample generation.+class GToSample t where+ gtoSamples :: proxy t -> Omega.Omega (Text, t x)++instance GToSample U1 where+ gtoSamples _ = Omega.each (singleSample U1)++instance GToSample V1 where+ gtoSamples _ = empty++instance (GToSample p, GToSample q) => GToSample (p :*: q) where+ gtoSamples _ = render <$> ps <*> qs+ where+ ps = gtoSamples (Proxy :: Proxy p)+ qs = gtoSamples (Proxy :: Proxy q)+ render (ta, a) (tb, b)+ | T.null ta || T.null tb = (ta <> tb, a :*: b)+ | otherwise = (ta <> ", " <> tb, a :*: b)++instance (GToSample p, GToSample q) => GToSample (p :+: q) where+ gtoSamples _ = lefts <|> rights+ where+ lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)+ rights = second R1 <$> gtoSamples (Proxy :: Proxy q)++instance ToSample a => GToSample (K1 i a) where+ gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))++instance (GToSample f) => GToSample (M1 i a f) where+ gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)++ class AllHeaderSamples ls where allHeaderToSample :: Proxy ls -> [HTTP.Header] instance AllHeaderSamples '[] where allHeaderToSample _ = [] -instance (ToByteString l, AllHeaderSamples ls, ToSample l l, KnownSymbol h)+instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h) => AllHeaderSamples (Header h l ': ls) where- allHeaderToSample _ = (mkHeader (toSample (Proxy :: Proxy l))) :+ allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) : allHeaderToSample (Proxy :: Proxy ls) where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h) mkHeader (Just x) = (headerName, cs $ toByteString x)@@ -414,8 +471,8 @@ -- | Synthesise a sample value of a type, encoded in the specified media types. sampleByteString- :: forall ctypes a b. (ToSample a b, IsNonEmpty ctypes, AllMimeRender ctypes b)- => Proxy ctypes+ :: forall ct cts a. (ToSample a, AllMimeRender (ct ': cts) a)+ => Proxy (ct ': cts) -> Proxy a -> [(M.MediaType, ByteString)] sampleByteString ctypes@Proxy Proxy =@@ -424,27 +481,14 @@ -- | Synthesise a list of sample values of a particular type, encoded in the -- specified media types. sampleByteStrings- :: forall ctypes a b. (ToSample a b, IsNonEmpty ctypes, AllMimeRender ctypes b)- => Proxy ctypes+ :: forall ct cts a. (ToSample a, AllMimeRender (ct ': cts) a)+ => Proxy (ct ': cts) -> Proxy a -> [(Text, M.MediaType, ByteString)] sampleByteStrings ctypes@Proxy Proxy =- let samples = toSamples (Proxy :: Proxy a)+ let samples' = toSamples (Proxy :: Proxy a) enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s- in concatMap enc samples---- | Generate a list of 'MediaType' values describing the content types--- accepted by an API component.-class SupportedTypes (list :: [*]) where- supportedTypes :: Proxy list -> [M.MediaType]--instance SupportedTypes '[] where- supportedTypes Proxy = []--instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)- where- supportedTypes Proxy =- contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)+ in concatMap enc samples' -- | The class that helps us automatically get documentation -- for GET parameters.@@ -469,6 +513,10 @@ class ToCapture c where toCapture :: Proxy c -> DocCapture +-- | The class that helps us get documentation for authenticated endpoints+class ToAuthInfo a where+ toAuthInfo :: Proxy a -> DocAuthentication+ -- | Generate documentation in Markdown format for -- the given 'API'. markdown :: API -> String@@ -481,15 +529,15 @@ str : "" : notesStr (action ^. notes) +++ authStr (action ^. authInfo) ++ capturesStr (action ^. captures) ++- mxParamsStr (action ^. mxParams) ++ headersStr (action ^. headers) ++ paramsStr (action ^. params) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++ responseStr (action ^. response) ++ [] - where str = "## " ++ show (endpoint^.method)+ where str = "## " ++ BSC.unpack (endpoint^.method) ++ " " ++ showPath (endpoint^.path) introsStr :: [DocIntro] -> [String]@@ -514,6 +562,20 @@ "" : [] ++ authStr :: [DocAuthentication] -> [String]+ authStr auths =+ let authIntros = mapped %~ view authIntro $ auths+ clientInfos = mapped %~ view authDataRequired $ auths+ in "#### Authentication":+ "":+ unlines authIntros :+ "":+ "Clients must supply the following data" :+ unlines clientInfos :+ "" :+ []+ capturesStr :: [DocCapture] -> [String] capturesStr [] = [] capturesStr l =@@ -526,20 +588,6 @@ captureStr cap = "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) - mxParamsStr :: [(String, [DocQueryParam])] -> [String]- mxParamsStr [] = []- mxParamsStr l =- "#### Matrix Parameters:" :- "" :- map segmentStr l- segmentStr :: (String, [DocQueryParam]) -> String- segmentStr (segment, l) = unlines $- ("**" ++ segment ++ "**:") :- "" :- map paramStr l ++- "" :- []- headersStr :: [Text] -> [String] headersStr [] = [] headersStr l = [""] ++ map headerStr l ++ [""]@@ -575,10 +623,10 @@ rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String] rqbodyStr [] [] = []- rqbodyStr types samples =+ rqbodyStr types s = ["#### Request:", ""] <> formatTypes types- <> concatMap formatBody samples+ <> concatMap formatBody s formatTypes [] = [] formatTypes ts = ["- Supported content types are:", ""]@@ -626,7 +674,8 @@ -- | The generated docs for @a ':<|>' b@ just appends the docs -- for @a@ with the docs for @b@.-instance (HasDocs layout1, HasDocs layout2)+instance OVERLAPPABLE_+ (HasDocs layout1, HasDocs layout2) => HasDocs (layout1 :<|> layout2) where docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)@@ -653,70 +702,38 @@ symP = Proxy :: Proxy sym -instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPABLe #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)- => HasDocs (Delete cts a) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where endpoint' = endpoint & method .~ DocDELETE- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- t = Proxy :: Proxy cts- p = Proxy :: Proxy a--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPING #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts- , AllHeaderSamples ls , GetHeaders (HList ls) )- => HasDocs (Delete cts (Headers ls a)) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where hdrs = allHeaderToSample (Proxy :: Proxy ls)- endpoint' = endpoint & method .~ DocDELETE- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- & response.respHeaders .~ hdrs- t = Proxy :: Proxy cts- p = Proxy :: Proxy a--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPABLe #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)- => HasDocs (Get cts a) where- docsFor Proxy (endpoint, action) =+instance OVERLAPPABLE_+ (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status+ , ReflectMethod method)+ => HasDocs (Verb method status (ct ': cts) a) where+ docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' - where endpoint' = endpoint & method .~ DocGET- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- t = Proxy :: Proxy cts+ where endpoint' = endpoint & method .~ method'+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)+ & response.respTypes .~ allMime t+ & response.respStatus .~ status+ t = Proxy :: Proxy (ct ': cts)+ method' = reflectMethod (Proxy :: Proxy method)+ status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a -instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPING #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts- , AllHeaderSamples ls , GetHeaders (HList ls) )- => HasDocs (Get cts (Headers ls a)) where- docsFor Proxy (endpoint, action) =+instance OVERLAPPING_+ (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status+ , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))+ => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where+ docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' - where hdrs = allHeaderToSample (Proxy :: Proxy ls)- endpoint' = endpoint & method .~ DocGET- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t+ where endpoint' = endpoint & method .~ method'+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)+ & response.respTypes .~ allMime t+ & response.respStatus .~ status & response.respHeaders .~ hdrs- t = Proxy :: Proxy cts+ t = Proxy :: Proxy (ct ': cts)+ hdrs = allHeaderToSample (Proxy :: Proxy ls)+ method' = reflectMethod (Proxy :: Proxy method)+ status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a instance (KnownSymbol sym, HasDocs sublayout)@@ -726,77 +743,7 @@ where sublayoutP = Proxy :: Proxy sublayout action' = over headers (|> headername) action- headername = pack $ symbolVal (Proxy :: Proxy sym)--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPABLE #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)- => HasDocs (Post cts a) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where endpoint' = endpoint & method .~ DocPOST- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- & response.respStatus .~ 201- t = Proxy :: Proxy cts- p = Proxy :: Proxy a--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPING #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts- , AllHeaderSamples ls , GetHeaders (HList ls) )- => HasDocs (Post cts (Headers ls a)) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where hdrs = allHeaderToSample (Proxy :: Proxy ls)- endpoint' = endpoint & method .~ DocPOST- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- & response.respStatus .~ 201- & response.respHeaders .~ hdrs- t = Proxy :: Proxy cts- p = Proxy :: Proxy a--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPABLE #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)- => HasDocs (Put cts a) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where endpoint' = endpoint & method .~ DocPUT- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- & response.respStatus .~ 200- t = Proxy :: Proxy cts- p = Proxy :: Proxy a--instance-#if MIN_VERSION_base(4,8,0)- {-# OVERLAPPING #-}-#endif- (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts- , AllHeaderSamples ls , GetHeaders (HList ls) )- => HasDocs (Put cts (Headers ls a)) where- docsFor Proxy (endpoint, action) =- single endpoint' action'-- where hdrs = allHeaderToSample (Proxy :: Proxy ls)- endpoint' = endpoint & method .~ DocPUT- action' = action & response.respBody .~ sampleByteStrings t p- & response.respTypes .~ supportedTypes t- & response.respStatus .~ 200- & response.respHeaders .~ hdrs- t = Proxy :: Proxy cts- p = Proxy :: Proxy a+ headername = T.pack $ symbolVal (Proxy :: Proxy sym) instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout) => HasDocs (QueryParam sym a :> sublayout) where@@ -830,67 +777,24 @@ action' = over params (|> toParam paramP) action -instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)- => HasDocs (MatrixParam sym a :> sublayout) where-- docsFor Proxy (endpoint, action) =- docsFor sublayoutP (endpoint', action')-- where sublayoutP = Proxy :: Proxy sublayout- paramP = Proxy :: Proxy (MatrixParam sym a)- segment = endpoint ^. (path._last)- segment' = action ^. (mxParams._last._1)- endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint-- action' = if segment' /= segment- -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list- then over mxParams (|> (segment, [toParam paramP])) action- -- We've already inserted a matrix parameter for this segment, append to the existing list- else action & mxParams._last._2 <>~ [toParam paramP]- symP = Proxy :: Proxy sym---instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)- => HasDocs (MatrixParams sym a :> sublayout) where-- docsFor Proxy (endpoint, action) =- docsFor sublayoutP (endpoint', action)-- where sublayoutP = Proxy :: Proxy sublayout- endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint- symP = Proxy :: Proxy sym---instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)- => HasDocs (MatrixFlag sym :> sublayout) where-- docsFor Proxy (endpoint, action) =- docsFor sublayoutP (endpoint', action)-- where sublayoutP = Proxy :: Proxy sublayout-- endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint- symP = Proxy :: Proxy sym- instance HasDocs Raw where- docsFor _proxy (endpoint, action) =+ docsFor _proxy (endpoint, action) _ = single endpoint action -- TODO: We use 'AllMimeRender' here because we need to be able to show the -- example data. However, there's no reason to believe that the instances of -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that -- both are even defined) for any particular type.-instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, HasDocs sublayout- , SupportedTypes cts)- => HasDocs (ReqBody cts a :> sublayout) where+instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs sublayout)+ => HasDocs (ReqBody (ct ': cts) a :> sublayout) where docsFor Proxy (endpoint, action) = docsFor sublayoutP (endpoint, action') where sublayoutP = Proxy :: Proxy sublayout action' = action & rqbody .~ sampleByteString t p- & rqtypes .~ supportedTypes t- t = Proxy :: Proxy cts+ & rqtypes .~ allMime t+ t = Proxy :: Proxy (ct ': cts) p = Proxy :: Proxy a instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where@@ -902,3 +806,58 @@ endpoint' = endpoint & path <>~ [symbolVal pa] pa = Proxy :: Proxy path +instance HasDocs sublayout => HasDocs (RemoteHost :> sublayout) where+ docsFor Proxy ep =+ docsFor (Proxy :: Proxy sublayout) ep++instance HasDocs sublayout => HasDocs (IsSecure :> sublayout) where+ docsFor Proxy ep =+ docsFor (Proxy :: Proxy sublayout) ep++instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where+ docsFor Proxy ep =+ docsFor (Proxy :: Proxy sublayout) ep++instance HasDocs sublayout => HasDocs (Vault :> sublayout) where+ docsFor Proxy ep =+ docsFor (Proxy :: Proxy sublayout) ep++instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where+ docsFor Proxy = docsFor (Proxy :: Proxy sublayout)++instance (ToAuthInfo (BasicAuth realm usr), HasDocs sublayout) => HasDocs (BasicAuth realm usr :> sublayout) where+ docsFor Proxy (endpoint, action) =+ docsFor (Proxy :: Proxy sublayout) (endpoint, action')+ where+ authProxy = Proxy :: Proxy (BasicAuth realm usr)+ action' = over authInfo (|> toAuthInfo authProxy) action++-- ToSample instances for simple types+instance ToSample ()+instance ToSample Bool+instance ToSample Ordering++-- polymorphic ToSample instances+instance (ToSample a, ToSample b) => ToSample (a, b)+instance (ToSample a, ToSample b, ToSample c) => ToSample (a, b, c)+instance (ToSample a, ToSample b, ToSample c, ToSample d) => ToSample (a, b, c, d)+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e) => ToSample (a, b, c, d, e)+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f) => ToSample (a, b, c, d, e, f)+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f, ToSample g) => ToSample (a, b, c, d, e, f, g)++instance ToSample a => ToSample (Maybe a)+instance (ToSample a, ToSample b) => ToSample (Either a b)+instance ToSample a => ToSample [a]++-- ToSample instances for Control.Applicative types+instance ToSample a => ToSample (Const a b)+instance ToSample a => ToSample (ZipList a)++-- ToSample instances for Data.Monoid newtypes+instance ToSample All+instance ToSample Any+instance ToSample a => ToSample (Sum a)+instance ToSample a => ToSample (Product a)+instance ToSample a => ToSample (First a)+instance ToSample a => ToSample (Last a)+instance ToSample a => ToSample (Dual a)
+ src/Servant/Docs/Internal/Pretty.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}++module Servant.Docs.Internal.Pretty where++import Data.Aeson (ToJSON(..))+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.Proxy (Proxy(Proxy))+import Network.HTTP.Media ((//))+import Servant.API++-- | PrettyJSON content type.+data PrettyJSON++instance Accept PrettyJSON where+ contentType _ = "application" // "json"++instance ToJSON a => MimeRender PrettyJSON a where+ mimeRender _ = encodePretty++-- | Prettify generated JSON documentation.+--+-- @+-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))+-- @+pretty :: Proxy layout -> Proxy (Pretty layout)+pretty Proxy = Proxy++-- | Replace all JSON content types with PrettyJSON.+-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@.+type family Pretty (layout :: k) :: k where+ Pretty (x :<|> y) = Pretty x :<|> Pretty y+ Pretty (x :> y) = Pretty x :> Pretty y+ Pretty (Get cs r) = Get (Pretty cs) r+ Pretty (Post cs r) = Post (Pretty cs) r+ Pretty (Put cs r) = Put (Pretty cs) r+ Pretty (Delete cs r) = Delete (Pretty cs) r+ Pretty (Patch cs r) = Patch (Pretty cs) r+ Pretty (ReqBody cs r) = ReqBody (Pretty cs) r+ Pretty (JSON ': xs) = PrettyJSON ': xs+ Pretty (x ': xs) = x ': Pretty xs+ Pretty x = x
+ test/Servant/DocsSpec.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Servant.DocsSpec where++import Control.Lens+import Data.Aeson+import Data.Monoid+import Data.Proxy+import Data.String.Conversions (cs)+import GHC.Generics+import Test.Hspec++import Servant.API+import Servant.API.Internal.Test.ComprehensiveAPI+import Servant.Docs.Internal++-- * comprehensive api++-- This declaration simply checks that all instances are in place.+_ = docs comprehensiveAPI++instance ToParam (QueryParam "foo" Int) where+ toParam = error "unused"+instance ToParam (QueryParams "foo" Int) where+ toParam = error "unused"+instance ToParam (QueryFlag "foo") where+ toParam = error "unused"+instance ToCapture (Capture "foo" Int) where+ toCapture = error "unused"++-- * specs++spec :: Spec+spec = describe "Servant.Docs" $ do++ describe "markdown" $ do+ let md = markdown (docs (Proxy :: Proxy TestApi1))+ tests md++ describe "markdown with extra info" $ do+ let+ extra = extraInfo+ (Proxy :: Proxy (Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)))+ (defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]])+ <>+ extraInfo+ (Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1))+ (defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]])+ md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))+ tests md+ it "contains the extra info provided" $ do+ md `shouldContain` "Get an Integer"+ md `shouldContain` "Post data"+ md `shouldContain` "get an integer in Json or plain text"+ md `shouldContain` "Posts some Json data"++ describe "tuple samples" $ do+ it "looks like expected" $ do+ (toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1)+ (toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1)+ (toSamples (Proxy :: Proxy (TT, UT))) `shouldBe`+ [ ("eins, yks",(TT1,UT1)), ("eins, kaks",(TT1,UT2))+ , ("zwei, yks",(TT2,UT1)), ("zwei, kaks",(TT2,UT2))+ ]+ (toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe`+ [ ("eins, yks, yks",(TT1,UT1,UT1))+ , ("eins, yks, kaks",(TT1,UT1,UT2))+ , ("zwei, yks, yks",(TT2,UT1,UT1))+ , ("eins, kaks, yks",(TT1,UT2,UT1))+ , ("zwei, yks, kaks",(TT2,UT1,UT2))+ , ("eins, kaks, kaks",(TT1,UT2,UT2))+ , ("zwei, kaks, yks",(TT2,UT2,UT1))+ , ("zwei, kaks, kaks",(TT2,UT2,UT2))+ ]+++ where+ tests md = do+ it "mentions supported content-types" $ do+ md `shouldContain` "application/json"+ md `shouldContain` "text/plain;charset=utf-8"++ it "mentions status codes" $ do+ md `shouldContain` "Status code 200"++ it "has methods as section headers" $ do+ md `shouldContain` "## POST"+ md `shouldContain` "## GET"++ it "mentions headers" $ do+ md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."++ it "contains response samples" $+ md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"+ it "contains request body samples" $+ md `shouldContain` "17"+++-- * APIs++data Datatype1 = Datatype1 { dt1field1 :: String+ , dt1field2 :: Int+ } deriving (Eq, Show, Generic)++instance ToJSON Datatype1++instance ToSample Datatype1 where+ toSamples _ = singleSample $ Datatype1 "field 1" 13++instance ToSample Char where+ toSamples _ = samples ['a'..'z']++instance ToSample Int where+ toSamples _ = singleSample 17++instance MimeRender PlainText Int where+ mimeRender _ = cs . show++type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)+ :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1+ :<|> Header "X-Test" Int :> Put '[JSON] Int++data TT = TT1 | TT2 deriving (Show, Eq)+data UT = UT1 | UT2 deriving (Show, Eq)++instance ToSample TT where+ toSamples _ = [("eins", TT1), ("zwei", TT2)]++instance ToSample UT where+ toSamples _ = [("yks", UT1), ("kaks", UT2)]