servant-docs 0.11.2 → 0.11.3
raw patch · 11 files changed
+814/−142 lines, 11 filesdep +tastydep +tasty-goldendep +tasty-hunitdep −hspecdep −semigroupsdep ~aesondep ~basedep ~base-compat
Dependencies added: tasty, tasty-golden, tasty-hunit, transformers
Dependencies removed: hspec, semigroups
Dependency ranges changed: aeson, base, base-compat, bytestring, case-insensitive, hashable, http-media, http-types, lens, servant, unordered-containers
Files
- CHANGELOG.md +6/−0
- LICENSE +1/−1
- example/greet.hs +9/−8
- golden/comprehensive.md +557/−0
- include/overlapping-compat.h +0/−8
- servant-docs.cabal +32/−33
- src/Servant/Docs.hs +2/−2
- src/Servant/Docs/Internal.hs +111/−58
- src/Servant/Docs/Internal/Pretty.hs +10/−6
- test/Servant/DocsSpec.hs +78/−25
- test/Spec.hs +8/−1
CHANGELOG.md view
@@ -1,6 +1,12 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.11.3+------++- Support `servant-0.15`+ - Instances for 'Stream' and 'StreamBody'+ 0.11.2 ------
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors All rights reserved.
example/greet.hs view
@@ -5,14 +5,15 @@ {-# 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+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
+ golden/comprehensive.md view
@@ -0,0 +1,557 @@+## GET /++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /alternative/left++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /alternative/right++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /capture/:foo++### Captures:++- *foo*: Capture foo Int++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /capture-all/:foo++### Captures:++- *foo*: Capture all foo Int++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /description++### foo+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /flag++### GET Parameters:++- foo+ - **Description**: QueryFlag+ - This parameter is a **flag**. This means no value is expected to be associated to this parameter.+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /foo++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /get-int++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript+17+```++## GET /header++### Headers:++- This endpoint is sensitive to the value of the **foo** HTTP header.++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /header-lenient++### Headers:++- This endpoint is sensitive to the value of the **bar** HTTP header.++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /http-version++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /is-secure++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /named-context++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /param++### GET Parameters:++- foo+ - **Values**: *1, 2, 3*+ - **Description**: QueryParams Int+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /param-lenient++### GET Parameters:++- bar+ - **Values**: *1, 2, 3*+ - **Description**: QueryParams Int+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /params++### GET Parameters:++- foo+ - **Values**: *1, 2, 3*+ - **Description**: QueryParams Int+ - This parameter is a **list**. All GET parameters with the name foo[] will forward their values in a list to the handler.+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## POST /post-int++### Response:++- Status code 204+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript+17+```++## POST /post-no-content++### Response:++- Status code 204+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /raw++### Response:++- Status code 200+- Headers: []++- No response body++## GET /remote-host++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /req-body++### Request:++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript+17+```++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /req-body-lenient++### Request:++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript+17+```++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /res-headers++### Response:++- Status code 200+- Headers: [("foo","17")]++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /streaming++### Request:++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- No response body++## GET /summary++### foo+++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```++## GET /vault++### Response:++- Status code 200+- Headers: []++- Supported content types are:++ - `application/json;charset=utf-8`+ - `application/json`++- Example (`application/json;charset=utf-8`, `application/json`):++```javascript++```+
− include/overlapping-compat.h
@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif
servant-docs.cabal view
@@ -1,31 +1,35 @@+cabal-version: >=1.10 name: servant-docs-version: 0.11.2+version: 0.11.3+ synopsis: generate API docs for your servant webservice+category: Servant, Web description: Library for generating API docs from a servant API definition. . Runnable example <https://github.com/haskell-servant/servant/blob/master/servant-docs/example/greet.hs here>. . <https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md CHANGELOG>++homepage: http://haskell-servant.readthedocs.org/+bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com-copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors-category: Servant, Web+copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors build-type: Simple-cabal-version: >=1.10 tested-with:- GHC==7.8.4- GHC==7.10.3- GHC==8.0.2- GHC==8.2.2-homepage: http://haskell-servant.readthedocs.org/-Bug-reports: http://github.com/haskell-servant/servant/issues+ GHC ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.2+ extra-source-files:- include/*.h CHANGELOG.md README.md+ golden/comprehensive.md+ source-repository head type: git location: http://github.com/haskell-servant/servant.git@@ -41,39 +45,32 @@ -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends:- base >= 4.7 && < 4.11- , bytestring >= 0.10.4.0 && < 0.11+ base >= 4.9 && < 4.13+ , bytestring >= 0.10.8.1 && < 0.11 , text >= 1.2.3.0 && < 1.3 - if !impl(ghc >= 8.0)- build-depends:- semigroups >=0.18.3 && <0.19- -- Servant dependencies build-depends:- servant == 0.13.*+ servant == 0.15.* -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends:- aeson >= 1.2.3.0 && < 1.3+ aeson >= 1.4.1.0 && < 1.5 , aeson-pretty >= 0.8.5 && < 0.9- , base-compat >= 0.9.3 && < 0.10- , case-insensitive >= 1.2.0.10 && < 1.3+ , base-compat >= 0.10.5 && < 0.11+ , case-insensitive >= 1.2.0.11 && < 1.3 , control-monad-omega >= 0.3.1 && < 0.4- , hashable >= 1.2.6.1 && < 1.3- , http-media >= 0.7.1.1 && < 0.8- , http-types >= 0.12 && < 0.13- , lens >= 4.15.4 && < 4.17+ , hashable >= 1.2.7.0 && < 1.3+ , http-media >= 0.7.1.3 && < 0.8+ , http-types >= 0.12.2 && < 0.13+ , lens >= 4.17 && < 4.18 , string-conversions >= 0.4.0.1 && < 0.5- , unordered-containers >= 0.2.8.0 && < 0.3+ , unordered-containers >= 0.2.9.0 && < 0.3 hs-source-dirs: src default-language: Haskell2010- ghc-options: -Wall- if impl(ghc >= 8.0)- ghc-options: -Wno-redundant-constraints- include-dirs: include+ ghc-options: -Wall -Wno-redundant-constraints executable greet-docs main-is: greet.hs@@ -100,6 +97,7 @@ -- Dependencies inherited from the library. No need to specify bounds. build-depends: base+ , base-compat , aeson , lens , servant@@ -108,7 +106,8 @@ -- Additonal dependencies build-depends:- hspec >= 2.4.4 && < 2.5+ tasty >= 1.1.0.4 && < 1.2,+ tasty-golden >= 2.3.2 && < 2.4,+ tasty-hunit >= 0.10.0.1 && < 0.11,+ transformers >= 0.5.2.0 && < 0.6 - build-tool-depends:- hspec-discover:hspec-discover >=2.4.4 && <2.5
src/Servant/Docs.hs view
@@ -56,5 +56,5 @@ , single ) where -import Servant.Docs.Internal-import Servant.Docs.Internal.Pretty+import Servant.Docs.Internal+import Servant.Docs.Internal.Pretty
src/Servant/Docs/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}@@ -17,36 +16,49 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#include "overlapping-compat.h" module Servant.Docs.Internal where -import Prelude ()+import Prelude () import Prelude.Compat import Control.Applicative-import Control.Arrow (second)-import Control.Lens (makeLenses, mapped, over,- traversed, view, (%~), (&), (.~),- (<>~), (^.), (|>))+import Control.Arrow+ (second)+import Control.Lens+ (makeLenses, mapped, over, traversed, view, (%~), (&), (.~),+ (<>~), (^.), (|>)) import qualified Control.Monad.Omega as Omega import qualified Data.ByteString.Char8 as BSC-import Data.ByteString.Lazy.Char8 (ByteString)+import Data.ByteString.Lazy.Char8+ (ByteString) import qualified Data.CaseInsensitive as CI-import Data.Foldable (fold)-import Data.Hashable (Hashable)-import Data.HashMap.Strict (HashMap)-import Data.List.Compat (intercalate, intersperse, sort)-import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)+import Data.Foldable+ (toList)+import Data.Foldable+ (fold)+import Data.Hashable+ (Hashable)+import Data.HashMap.Strict+ (HashMap)+import Data.List.Compat+ (intercalate, intersperse, sort)+import Data.List.NonEmpty+ (NonEmpty ((:|)), groupWith) import qualified Data.List.NonEmpty as NE import Data.Maybe-import Data.Monoid (All (..), Any (..), Dual (..),- First (..), Last (..),- Product (..), Sum (..))-import Data.Ord (comparing)-import Data.Proxy (Proxy (Proxy))-import Data.Semigroup (Semigroup (..))-import Data.String.Conversions (cs)-import Data.Text (Text, unpack)+import Data.Monoid+ (All (..), Any (..), Dual (..), First (..), Last (..),+ Product (..), Sum (..))+import Data.Ord+ (comparing)+import Data.Proxy+ (Proxy (Proxy))+import Data.Semigroup+ (Semigroup (..))+import Data.String.Conversions+ (cs)+import Data.Text+ (Text, unpack) import GHC.Generics import GHC.TypeLits import Servant.API@@ -64,14 +76,15 @@ -- or any 'Endpoint' value you want using the 'path' and 'method' -- lenses to tweak. ----- @--- λ> 'defEndpoint'--- GET /--- λ> 'defEndpoint' & 'path' '<>~' ["foo"]--- GET /foo--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'--- POST /foo--- @+-- >>> defEndpoint+-- "GET" /+--+-- >>> defEndpoint & path <>~ ["foo"]+-- "GET" /foo+--+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost+-- "POST" /foo+-- data Endpoint = Endpoint { _path :: [String] -- type collected , _method :: HTTP.Method -- type collected@@ -92,14 +105,15 @@ -- -- Here's how you can modify it: ----- @--- λ> 'defEndpoint'--- GET /--- λ> 'defEndpoint' & 'path' '<>~' ["foo"]--- GET /foo--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'--- POST /foo--- @+-- >>> defEndpoint+-- "GET" /+--+-- >>> defEndpoint & path <>~ ["foo"]+-- "GET" /foo+--+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost+-- "POST" /foo+-- defEndpoint :: Endpoint defEndpoint = Endpoint [] HTTP.methodGet @@ -210,12 +224,14 @@ -- want to write a 'ToSample' instance for the type that'll be represented -- as encoded data in the response. ----- Can be tweaked with three lenses.+-- Can be tweaked with four lenses. ----- > λ> defResponse--- > Response {_respStatus = 200, _respTypes = [], _respBody = []}--- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]--- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}+-- >>> defResponse+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}+--+-- >>> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "application/json", "{ \"status\": \"ok\" }")]+-- Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well",application/json,"{ \"status\": \"ok\" }")], _respHeaders = []}+-- data Response = Response { _respStatus :: Int , _respTypes :: [M.MediaType]@@ -225,12 +241,14 @@ -- | Default response: status code 200, no response body. ----- Can be tweaked with two lenses.+-- Can be tweaked with four lenses. ----- > λ> defResponse--- > Response {_respStatus = 200, _respBody = Nothing}--- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"--- > Response {_respStatus = 204, _respBody = Just "[]"}+-- >>> defResponse+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}+--+-- >>> defResponse & respStatus .~ 204+-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}+-- defResponse :: Response defResponse = Response { _respStatus = 200@@ -276,10 +294,12 @@ -- -- Tweakable with lenses. ----- > λ> defAction--- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}--- > λ> defAction & response.respStatus .~ 201--- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}+-- >>> defAction+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}+--+-- >>> defAction & response.respStatus .~ 201+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}+-- defAction :: Action defAction = Action []@@ -347,7 +367,8 @@ -- | Generate the docs for a given API that implements 'HasDocs'. This is the -- default way to create documentation. ----- prop> docs == docsWithOptions defaultDocOptions+-- > docs == docsWithOptions defaultDocOptions+-- docs :: HasDocs api => Proxy api -> API docs p = docsWithOptions p defaultDocOptions @@ -750,9 +771,9 @@ contentStr mime_type body = "" :- " ```" <> markdownForType mime_type :+ "```" <> markdownForType mime_type : cs body :- " ```" :+ "```" : "" : [] @@ -776,7 +797,7 @@ -- | The generated docs for @a ':<|>' b@ just appends the docs -- for @a@ with the docs for @b@.-instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-} (HasDocs a, HasDocs b) => HasDocs (a :<|> b) where @@ -824,7 +845,7 @@ symP = Proxy :: Proxy sym -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-} (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status , ReflectMethod method) => HasDocs (Verb method status (ct ': cts) a) where@@ -840,7 +861,25 @@ status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a -instance OVERLAPPING_+-- | TODO: mention the endpoint is streaming, its framing strategy+--+-- Also there are no samples.+--+-- TODO: AcceptFraming for content-type+instance {-# OVERLAPPABLE #-}+ (Accept ct, KnownNat status, ReflectMethod method)+ => HasDocs (Stream method status framing ct a) where+ docsFor Proxy (endpoint, action) DocOptions{..} =+ single endpoint' action'++ where endpoint' = endpoint & method .~ method'+ action' = action & response.respTypes .~ allMime t+ & response.respStatus .~ status+ t = Proxy :: Proxy '[ct]+ method' = reflectMethod (Proxy :: Proxy method)+ status = fromInteger $ natVal (Proxy :: Proxy status)++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@@ -930,7 +969,6 @@ -- both are even defined) for any particular type. instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api) => HasDocs (ReqBody' mods (ct ': cts) a :> api) where- docsFor Proxy (endpoint, action) opts@DocOptions{..} = docsFor subApiP (endpoint, action') opts @@ -941,6 +979,18 @@ t = Proxy :: Proxy (ct ': cts) p = Proxy :: Proxy a +-- | TODO: this instance is incomplete.+instance (HasDocs api, Accept ctype) => HasDocs (StreamBody' mods framing ctype a :> api) where+ docsFor Proxy (endpoint, action) opts =+ docsFor subApiP (endpoint, action') opts+ where+ subApiP = Proxy :: Proxy api++ action' :: Action+ action' = action & rqtypes .~ toList (contentTypes t)++ t = Proxy :: Proxy ctype+ instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where docsFor Proxy (endpoint, action) =@@ -1005,3 +1055,6 @@ instance ToSample a => ToSample (First a) instance ToSample a => ToSample (Last a) instance ToSample a => ToSample (Dual a)++-- $setup+-- >>> :set -XOverloadedStrings
src/Servant/Docs/Internal/Pretty.hs view
@@ -4,16 +4,20 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} 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+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
test/Servant/DocsSpec.hs view
@@ -1,55 +1,69 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -freduction-depth=100 #-}-#else-{-# OPTIONS_GHC -fcontext-stack=100 #-}-#endif module Servant.DocsSpec where import Control.Lens+ ((&), (<>~))+import Control.Monad+ (unless)+import Control.Monad.Trans.Writer+ (Writer, runWriter, tell) import Data.Aeson-import Data.Monoid+import Data.List+ (isInfixOf) import Data.Proxy-import Data.String.Conversions (cs)+import Data.String.Conversions+ (cs) import GHC.Generics-import Test.Hspec+import Prelude ()+import Prelude.Compat+import Test.Tasty+ (TestName, TestTree, testGroup)+import Test.Tasty.Golden+ (goldenVsString)+import Test.Tasty.HUnit+ (Assertion, HasCallStack, assertFailure, testCase, (@?=)) import Servant.API-import Servant.API.Internal.Test.ComprehensiveAPI import Servant.Docs.Internal+import Servant.Test.ComprehensiveAPI -- * comprehensive api -- This declaration simply checks that all instances are in place.-_ = docs comprehensiveAPI+comprehensiveDocs :: API+comprehensiveDocs = docs comprehensiveAPI instance ToParam (QueryParam' mods "foo" Int) where- toParam = error "unused"+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" Normal instance ToParam (QueryParam' mods "bar" Int) where- toParam = error "unused"+ toParam _ = DocQueryParam "bar" ["1","2","3"] "QueryParams Int" Normal instance ToParam (QueryParams "foo" Int) where- toParam = error "unused"+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List instance ToParam (QueryFlag "foo") where- toParam = error "unused"+ toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag instance ToCapture (Capture "foo" Int) where- toCapture = error "unused"+ toCapture _ = DocCapture "foo" "Capture foo Int" instance ToCapture (CaptureAll "foo" Int) where- toCapture = error "unused"+ toCapture _ = DocCapture "foo" "Capture all foo Int" -- * specs -spec :: Spec+spec :: TestTree spec = describe "Servant.Docs" $ do+ golden "comprehensive API" "golden/comprehensive.md" (markdown comprehensiveDocs) describe "markdown" $ do let md = markdown (docs (Proxy :: Proxy TestApi1))@@ -150,3 +164,42 @@ instance ToSample UT where toSamples _ = [("yks", UT1), ("kaks", UT2)]++-------------------------------------------------------------------------------+-- HSpec like DSL for tasty+-------------------------------------------------------------------------------++newtype TestTreeM a = TestTreeM (Writer [TestTree] a)+ deriving (Functor, Applicative, Monad)++runTestTreeM :: TestTreeM () -> [TestTree]+runTestTreeM (TestTreeM m) = snd (runWriter m)++class Describe r where+ describe :: TestName -> TestTreeM () -> r++instance a ~ () => Describe (TestTreeM a) where+ describe n t = TestTreeM $ tell [ describe n t ]++instance Describe TestTree where+ describe n t = testGroup n $ runTestTreeM t++it :: TestName -> Assertion -> TestTreeM ()+it n assertion = TestTreeM $ tell [ testCase n assertion ]++shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion+shouldBe = (@?=)++shouldContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion+shouldContain = compareWith (flip isInfixOf) "does not contain"++shouldNotContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion+shouldNotContain = compareWith (\x y -> not (isInfixOf y x)) "contains"++compareWith :: (Show a, Show b, HasCallStack) => (a -> b -> Bool) -> String -> a -> b -> Assertion+compareWith f msg x y = unless (f x y) $ assertFailure $+ show x ++ " " ++ msg ++ " " ++ show y++golden :: TestName -> FilePath -> String -> TestTreeM ()+golden n fp contents = TestTreeM $ tell+ [ goldenVsString n fp (return (cs contents)) ]
test/Spec.hs view
@@ -1,1 +1,8 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+module Main (main) where++import Test.Tasty+ (defaultMain)+import qualified Servant.DocsSpec++main :: IO ()+main = defaultMain Servant.DocsSpec.spec