servant-docs-simple 0.3.0.0 → 0.4.0.0
raw patch · 10 files changed
+305/−223 lines, 10 filesdep −ordered-containersdep −unordered-containersdep ~aesondep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies removed: ordered-containers, unordered-containers
Dependency ranges changed: aeson, base, bytestring, hspec, hspec-core, prettyprinter, servant
API changes (from Hackage documentation)
- Servant.Docs.Simple.Parse: instance forall k b (ct :: GHC.Types.Symbol) (typ :: k) (m :: [*]). (Servant.Docs.Simple.Parse.HasParsableEndpoint b, GHC.TypeLits.KnownSymbol ct, Data.Typeable.Internal.Typeable typ) => Servant.Docs.Simple.Parse.HasParsableEndpoint (Servant.API.Header.Header' m ct typ Servant.API.Sub.:> b)
- Servant.Docs.Simple.Parse: toDetails :: [(Text, Details)] -> Details
+ Servant.Docs.Simple.Parse: instance (Servant.Docs.Simple.Parse.HasParsableEndpoint b, GHC.TypeLits.KnownSymbol ct, Data.Typeable.Internal.Typeable typ) => Servant.Docs.Simple.Parse.HasParsableEndpoint (Servant.API.Header.Header' m ct typ Servant.API.Sub.:> b)
+ Servant.Docs.Simple.Parse: typeListText :: forall a. Typeable a => Text
- Servant.Docs.Simple.Parse: parseEndpoint :: HasParsableEndpoint e => Route -> [(Parameter, Details)] -> (Route, OMap Parameter Details)
+ Servant.Docs.Simple.Parse: parseEndpoint :: HasParsableEndpoint e => Route -> [(Parameter, Details)] -> (Route, [(Parameter, Details)])
- Servant.Docs.Simple.Render: ApiDocs :: OMap Route Details -> ApiDocs
+ Servant.Docs.Simple.Render: ApiDocs :: [(Route, Details)] -> ApiDocs
- Servant.Docs.Simple.Render: Details :: OMap Parameter Details -> Details
+ Servant.Docs.Simple.Render: Details :: [(Parameter, Details)] -> Details
Files
- CHANGELOG.md +10/−0
- README.md +9/−9
- servant-docs-simple.cabal +19/−18
- src/Servant/Docs/Simple.hs +6/−6
- src/Servant/Docs/Simple/Parse.hs +69/−40
- src/Servant/Docs/Simple/Render.hs +29/−26
- test/Test/Servant/Docs/Simple.hs +2/−2
- test/Test/Servant/Docs/Simple/Parse.hs +16/−9
- test/Test/Servant/Docs/Simple/Render.hs +1/−1
- test/Test/Servant/Docs/Simple/Samples.hs +144/−112
CHANGELOG.md view
@@ -27,3 +27,13 @@ `HasDocumentApi` -> `HasParsableEndpoint` `parse` -> `parseApi`++## 0.4.0.0++* Improve how type-level lists are rendered.+ Instead of "Format: ': * JSON ('[] *)"+ you'll get "Format: [JSON]"++* Fix bug when any given API combinator would only be rendered once per endpoint++* API change: removed `toDetails` function. Use `Details` constructor directly instead.
README.md view
@@ -1,6 +1,6 @@ # servant-docs-simple -[](https://travis-ci.org/holmusk/servant-docs-simple)+[](https://github.com/holmusk/servant-docs-simple/actions) [](https://hackage.haskell.org/package/servant-docs-simple) [](http://stackage.org/lts/package/servant-docs-simple) [](http://stackage.org/nightly/package/servant-docs-simple)@@ -33,7 +33,7 @@ **Using this script** ``` haskell--- stack --system-ghc runghc --package servant-docs-simple+-- stack runghc --package servant-docs-simple {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}@@ -51,10 +51,10 @@ main :: IO () main = do- -- Writes to the file $PWD/docsJson+ -- Writes to the file $PWD/docs.json writeDocsJson @API "docs.json" - -- Writes to the file $PWD/docsPlainText+ -- Writes to the file $PWD/docs.txt writeDocsPlainText @API "docs.txt" ```@@ -75,12 +75,12 @@ { "/hello/world": { "Response": {- "Format": "': * () ('[] *)",+ "Format": "[()]", "ContentType": "()" }, "RequestType": "'POST", "RequestBody": {- "Format": "': * () ('[] *)",+ "Format": "[()]", "ContentType": "()" } }@@ -92,11 +92,11 @@ ``` text /hello/world: RequestBody:- Format: ': * () ('[] *)+ Format: [()] ContentType: () RequestType: 'POST Response:- Format: ': * () ('[] *)+ Format: [()] ContentType: () ``` @@ -138,7 +138,7 @@ -- --- Format Types --- -- | | -- v v- type singleAPI = "hello" :> ReqBody '[JSON] User :> POST '[JSON] Message+ type SingleAPI = "hello" :> ReqBody '[JSON] User :> POST '[JSON] Message data User = User Name Password deriving Typeable data Messsage = Message Id Content deriving Typeable
servant-docs-simple.cabal view
@@ -1,10 +1,10 @@ cabal-version: 2.4 name: servant-docs-simple-version: 0.3.0.0+version: 0.4.0.0 synopsis: Generate endpoints overview for Servant API description:- This library uses [Data.Typeable](http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Typeable.html)+ This library uses [Data.Typeable](https://hackage.haskell.org/package/base/docs/Data-Typeable.html) to generate documentation for [Servant](https://hackage.haskell.org/package/servant) API types. @@ -24,37 +24,33 @@ CHANGELOG.md extra-source-files: README.md tested-with: GHC == 8.6.5- GHC == 8.8.2+ GHC == 8.8.4+ GHC == 8.10.7 + source-repository head type: git location: https://github.com/Holmusk/servant-docs-simple.git common common-options- build-depends: base >= 4.11.1.0 && < 4.14- , aeson >= 1.4.2 && < 1.5- , aeson-pretty >= 0.8.7 && < 0.9- , bytestring >= 0.10.8.2 && < 0.11- , ordered-containers >= 0.2.2 && < 0.3- , prettyprinter >= 1.2.1 && < 1.7- , servant >= 0.15 && < 0.18- , text >= 1.2.3.1 && < 1.3- , unordered-containers >= 0.2.10 && < 0.3+ build-depends: base >= 4.11.1.0 && < 5+ , aeson >= 1.4.2 && < 1.6+ , servant >= 0.15 && < 0.19 ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates- if impl(ghc >= 8.0)- ghc-options: -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths+ -Wredundant-constraints+ -fhide-source-paths if impl(ghc >= 8.4) ghc-options: -Wmissing-export-lists -Wpartial-fields if impl(ghc >= 8.8) ghc-options: -Wmissing-deriving-strategies+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages default-language: Haskell2010 default-extensions: AllowAmbiguousTypes@@ -73,6 +69,11 @@ library import: common-options+ build-depends: aeson-pretty >= 0.8.7 && < 0.9+ , bytestring >= 0.10.8.2 && < 0.12+ , prettyprinter >= 1.6 && < 1.8+ , text >= 1.2.3.1 && < 1.3+ hs-source-dirs: src exposed-modules: Servant.Docs.Simple@@ -86,8 +87,8 @@ main-is: Spec.hs build-depends: servant-docs-simple- , hspec >= 2.7.1 && < 2.8- , hspec-core >= 2.7.1 && < 2.8+ , hspec >= 2.7.1 && < 2.9+ , hspec-core >= 2.7.1 && < 2.9 , raw-strings-qq >= 1.1 && < 1.2 other-modules: Test.Servant.Docs.Simple
src/Servant/Docs/Simple.hs view
@@ -24,10 +24,10 @@ > > main :: IO () > main = do-> -- Writes to the file $PWD/docsJson+> -- Writes to the file $PWD/docs.json > writeDocsJson @API "docs.json" >-> -- Writes to the file $PWD/docsPlainText+> -- Writes to the file $PWD/docs.txt > writeDocsPlainText @API "docs.txt" __Expected Output__@@ -43,12 +43,12 @@ > { > "/hello/world": { > "Response": {-> "Format": "': * () ('[] *)",+> "Format": "[()]", > "ContentType": "()" > }, > "RequestType": "'POST", > "RequestBody": {-> "Format": "': * () ('[] *)",+> "Format": "[()]", > "ContentType": "()" > } > }@@ -58,11 +58,11 @@ > /hello/world: > RequestBody:-> Format: ': * () ('[] *)+> Format: [()] > ContentType: () > RequestType: 'POST > Response:-> Format: ': * () ('[] *)+> Format: [()] > ContentType: () -}
src/Servant/Docs/Simple/Parse.hs view
@@ -19,7 +19,7 @@ > ApiDocs ( fromList [( "/hello/world", > , Details (fromList ([ ( "RequestBody" > , Details (fromList ([ ( "Format"-> , Detail "': * () ('[] *)"+> , Detail "[()]" > ) > , ( "ContentType" > , Detail "()"@@ -31,7 +31,7 @@ > ) > , ( "Response" > , Details (fromList ([ ( "Format"-> , Detail "': * () ('[] *)"+> , Detail "[()]" > ) > , ( "ContentType" > , Detail "()"@@ -49,16 +49,15 @@ ( HasParsableEndpoint (..) , HasParsableApi (..) , symbolVal'- , toDetails , typeText+ , typeListText ) where import Data.Foldable (fold)-import Data.Map.Ordered (OMap, empty, fromList, (|<)) import Data.Proxy import Data.Text (Text, pack)-import Data.Typeable (Typeable, typeRep)+import Data.Typeable (Typeable, typeRep, TypeRep, splitTyConApp, TyCon, tyConPackage, tyConModule, tyConName) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Servant.API ((:>), AuthProtect, BasicAuth, Capture', CaptureAll, Description, EmptyAPI,@@ -67,6 +66,7 @@ import qualified Servant.API.TypeLevel as S (Endpoints) import Servant.Docs.Simple.Render (ApiDocs (..), Details (..), Parameter, Route)+import Data.Kind (Type) -- | Flattens API into type level list of Endpoints class HasParsableApi api where@@ -87,15 +87,15 @@ -- | Collapse a type-level list of API endpoints into documentation instance (HasParsableEndpoint e, HasCollatable b) => HasCollatable (e ': b) where- collate = ApiDocs $ (Details <$> documentEndpoint @e) |< previous+ collate = ApiDocs $ (Details <$> documentEndpoint @e) : previous where ApiDocs previous = collate @b -- | Terminal step when there are no more endpoints left to recurse over instance HasCollatable '[] where- collate = ApiDocs empty+ collate = ApiDocs [] -- | Folds an api endpoint into documentation-documentEndpoint :: forall a. HasParsableEndpoint a => (Route, OMap Parameter Details)+documentEndpoint :: forall a. HasParsableEndpoint a => (Route, [(Parameter, Details)]) documentEndpoint = parseEndpoint @a "" [] -- | Folds an api endpoint into documentation@@ -104,7 +104,7 @@ -- | We use this to destructure the API type and convert it into documentation parseEndpoint :: Route -- ^ Route documentation -> [(Parameter, Details)] -- ^ Everything else documentation- -> (Route, OMap Parameter Details) -- ^ Generated documentation for the route+ -> (Route, [(Parameter, Details)]) -- ^ Generated documentation for the route -- | Static route documentation instance (HasParsableEndpoint b, KnownSymbol route) => HasParsableEndpoint ((route :: Symbol) :> b) where@@ -153,9 +153,9 @@ -- | Basic authentication documentation instance (HasParsableEndpoint b, KnownSymbol realm, Typeable a) => HasParsableEndpoint (BasicAuth (realm :: Symbol) a :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "Basic Authentication"- , toDetails [ ("Realm", Detail realm)- , ("UserData", Detail userData)- ]+ , Details [ ("Realm", Detail realm)+ , ("UserData", Detail userData)+ ] )] where realm = symbolVal' @realm@@ -169,70 +169,99 @@ -- | Request header documentation instance (HasParsableEndpoint b, KnownSymbol ct, Typeable typ) => HasParsableEndpoint (Header' m (ct :: Symbol) typ :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "RequestHeaders"- , toDetails [ ("Name", Detail $ symbolVal' @ct)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Name", Detail $ symbolVal' @ct)+ , ("ContentType", Detail $ typeText @typ)+ ] )] -- | Query flag documentation instance (HasParsableEndpoint b, KnownSymbol param) => HasParsableEndpoint (QueryFlag (param :: Symbol) :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "QueryFlag"- , toDetails [ ("Param", Detail $ symbolVal' @param) ]+ , Details [ ("Param", Detail $ symbolVal' @param) ] )] -- | Query param documentation instance (HasParsableEndpoint b, KnownSymbol param, Typeable typ) => HasParsableEndpoint (QueryParam' m (param :: Symbol) typ :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "QueryParam"- , toDetails [ ("Param", Detail $ symbolVal' @param)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Param", Detail $ symbolVal' @param)+ , ("ContentType", Detail $ typeText @typ)+ ] )] -- | Query params documentation instance (HasParsableEndpoint b, KnownSymbol param, Typeable typ) => HasParsableEndpoint (QueryParams (param :: Symbol) typ :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "QueryParams"- , toDetails [ ("Param", Detail $ symbolVal' @param)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Param", Detail $ symbolVal' @param)+ , ("ContentType", Detail $ typeText @typ)+ ] )] -- | Request body documentation-instance (HasParsableEndpoint b, Typeable ct, Typeable typ) => HasParsableEndpoint (ReqBody' m ct typ :> b) where+instance (HasParsableEndpoint b, Typeable (ct :: [Type]), Typeable typ) => HasParsableEndpoint (ReqBody' m (ct :: [Type]) typ :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "RequestBody"- , toDetails [ ("Format", Detail $ typeText @ct)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Format", Detail $ typeListText @ct)+ , ("ContentType", Detail $ typeText @typ)+ ] )] -- | Stream body documentation instance (HasParsableEndpoint b, Typeable ct, Typeable typ) => HasParsableEndpoint (StreamBody' m ct typ :> b) where parseEndpoint r a = parseEndpoint @b r $ a <> [( "StreamBody"- , toDetails [ ("Format", Detail $ typeText @ct)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Format", Detail $ typeText @ct)+ , ("ContentType", Detail $ typeText @typ)+ ] )] -- | Response documentation -- Terminates here as responses are last parts of api endpoints -- Note that request type information (GET, POST etc...) is contained here-instance (Typeable m, Typeable ct, Typeable typ) => HasParsableEndpoint (Verb m s ct typ) where- parseEndpoint r a = ( r- , fromList $ a <> [requestType, response]- )+instance (Typeable m, Typeable (ct :: [Type]), Typeable typ) => HasParsableEndpoint (Verb m s (ct :: [Type]) typ) where+ parseEndpoint r a = (r, a <> [requestType, response]) where requestType = ("RequestType", Detail $ typeText @m) response = ( "Response"- , toDetails [ ("Format", Detail $ typeText @ct)- , ("ContentType", Detail $ typeText @typ)- ]+ , Details [ ("Format", Detail $ typeListText @ct)+ , ("ContentType", Detail $ typeText @typ)+ ] ) --- | Convert parameter-value pairs to Details type-toDetails :: [(Text, Details)] -> Details-toDetails = Details . fromList -- | Convert types to Text-typeText :: forall a. (Typeable a) => Text+typeText :: forall a. Typeable a => Text typeText = pack . show . typeRep $ Proxy @a++-- | Converts type-level list of types to Text.+-- If the type variable doesn't correspond to type level list,+-- the result is the same as calling 'typeText'.+--+-- >>> typeListText @'[JSON,PlainText]+-- "[JSON,PlainText]"+---+-- This is nicer way to print type-level lists than using 'typeText',+-- the output of which is difficult to read due to use of ticked list constructors.+-- >>> typeText @'[JSON,PlainText]+-- "': * JSON (': * PlainText ('[] *))"+typeListText :: forall a. Typeable a => Text+typeListText = case go . typeRep $ Proxy @a of+ Nothing -> typeText @a+ Just typeReps -> pack $ show typeReps+ where+ go :: TypeRep -> Maybe [TypeRep]+ go typRep = case splitTyConApp typRep of+ (tyCon, [x,xs]) | isCons tyCon -> (x:) <$> go xs+ (tyCon, [])| isNil tyCon -> Just []+ _ -> Nothing+ + isCons :: TyCon -> Bool+ isCons tc =+ tyConPackage tc == "ghc-prim"+ && tyConModule tc == "GHC.Types"+ && tyConName tc == "':"++ isNil :: TyCon -> Bool+ isNil tc =+ tyConPackage tc == "ghc-prim"+ && tyConModule tc == "GHC.Types"+ && tyConName tc == "'[]" -- | Convert symbol to Text symbolVal' :: forall n. KnownSymbol n => Text
src/Servant/Docs/Simple/Render.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- | Renders the intermediate structure into common documentation formats __Example scripts__@@ -13,7 +14,7 @@ > ApiDocs ( fromList [( "/hello/world", > , Details (fromList ([ ( "RequestBody" > , Details (fromList ([ ( "Format"-> , Detail "': * () ('[] *)"+> , Detail "[()]" > ) > , ( "ContentType" > , Detail "()"@@ -25,7 +26,7 @@ > ) > , ( "Response" > , Details (fromList ([ ( "Format"-> , Detail "': * () ('[] *)"+> , Detail "[()]" > ) > , ( "ContentType" > , Detail "()"@@ -41,12 +42,12 @@ > { > "/hello/world": { > "Response": {-> "Format": "': * () ('[] *)",+> "Format": "[()]", > "ContentType": "()" > }, > "RequestType": "'POST", > "RequestBody": {-> "Format": "': * () ('[] *)",+> "Format": "[()]", > "ContentType": "()" > } > }@@ -56,11 +57,11 @@ > /hello/world: > RequestBody:-> Format: ': * () ('[] *)+> Format: [()] > ContentType: () > RequestType: 'POST > Response:-> Format: ': * () ('[] *)+> Format: [()] > ContentType: () -}@@ -77,16 +78,20 @@ , PlainText (..) ) where -import Data.Aeson (ToJSON (..), Value (..))-import Data.HashMap.Strict (fromList)+import Data.Aeson (ToJSON (..), Value (..), (.=), object) import Data.List (intersperse)-import Data.Map.Ordered (OMap, assocs) import Data.Text (Text, pack)+#if MIN_VERSION_prettyprinter(1,7,0)+import Prettyprinter (Doc, annotate, defaultLayoutOptions, indent, layoutPretty, line, pretty, vcat,+ vsep)+import Prettyprinter.Render.Util.StackMachine (renderSimplyDecorated)+#else import Data.Text.Prettyprint.Doc (Doc, annotate, defaultLayoutOptions, indent, layoutPretty, line, pretty, vcat, vsep) import Data.Text.Prettyprint.Doc.Render.Util.StackMachine (renderSimplyDecorated)+#endif --- | Intermediate documentation structure, a hashmap of endpoints+-- | Intermediate documentation structure, a tree of endpoints -- -- API type: --@@ -100,7 +105,7 @@ -- > ApiDocs ( fromList [ ( "/users/update", -- > , Details (fromList ([ ( "Response" -- > , Details (fromList ([ ( "Format"--- > , Detail "': * () ('[] *)"+-- > , Detail "[()]" -- > ) -- > , ( "ContentType" -- > , Detail "()"@@ -112,7 +117,7 @@ -- > , ( "/users/get", -- > , Details (fromList ([ ( "Response" -- > , Details (fromList ([ ( "Format"--- > , Detail "': * () ('[] *)"+-- > , Detail "[()]" -- > ) -- > , ( "ContentType" -- > , Detail "()"@@ -125,7 +130,7 @@ -- -- For more examples reference [Test.Servant.Docs.Simple.Samples](https://github.com/Holmusk/servant-docs-simple/blob/master/test/Test/Servant/Docs/Simple/Samples.hs) ---newtype ApiDocs = ApiDocs (OMap Route Details) deriving stock (Eq, Show)+newtype ApiDocs = ApiDocs [(Route, Details)] deriving stock (Eq, Show) -- | Route representation type Route = Text@@ -144,7 +149,7 @@ -- -- Can be interpreted as a Parameter (Response) and /Details/ (Format (...), ContentType (...)) ---data Details = Details (OMap Parameter Details) -- ^ OMap of Parameter-Details+data Details = Details [(Parameter, Details)] | Detail Text -- ^ Single Value deriving stock (Eq, Show) @@ -162,14 +167,13 @@ instance Renderable Json where render = Json . toJSON --- | Json instance for the endpoints hashmap instance ToJSON ApiDocs where- toJSON (ApiDocs endpoints) = toJSON . fromList . assocs $ endpoints+ toJSON (ApiDocs endpoints) =+ object $ fmap (\(route, details) -> route .= toJSON details) endpoints --- | Json instance for the parameter hashmap of each endpoint instance ToJSON Details where toJSON (Detail t) = String t- toJSON (Details ls) = toJSON . fromList . assocs $ ls+ toJSON (Details ds) = object $ fmap (\(param, details) -> param .= toJSON details) ds -- | Conversion to prettyprint newtype Pretty = Pretty { getPretty :: Doc Ann }@@ -186,7 +190,7 @@ prettyPrint (ApiDocs endpoints) = vsep $ intersperse line $ documentRoute- <$> assocs endpoints+ <$> endpoints -- | Documents an API route documentRoute :: (Route, Details) -- ^ Route-Details pair@@ -204,9 +208,8 @@ Details ds -> (line <>) $ indent i $ vcat- $ documentParameters <$> ds'- where ds' = assocs ds- documentParameters (param, details) = annotate AnnParam (pretty param)+ $ documentParameters <$> ds+ where documentParameters (param, details) = annotate AnnParam (pretty param) <> ":" <> documentDetails (i + 4) details @@ -224,12 +227,12 @@ render docs = Markdown m where m = renderSimplyDecorated id annOpen annClose docStream annOpen = \case- AnnRoute -> "### "- AnnParam -> "- **"+ AnnRoute -> "### "+ AnnParam -> "- **" AnnDetail -> "`" annClose = \case- AnnRoute -> ""- AnnParam -> "**"+ AnnRoute -> ""+ AnnParam -> "**" AnnDetail -> "`" docStream = layoutPretty defaultLayoutOptions docs' docs' = getPretty $ render docs
test/Test/Servant/Docs/Simple.hs view
@@ -4,14 +4,14 @@ import Test.Hspec (Spec, describe, it, shouldBe)-import Test.Servant.Docs.Simple.Samples+import Test.Servant.Docs.Simple.Samples (ApiComplete, apiCompleteJson, apiCompletePlainText) import Servant.Docs.Simple (document, documentWith) import Servant.Docs.Simple.Render (Json) mainSpec :: Spec-mainSpec = describe "Generates Documentation" $ do+mainSpec = describe "document/documentWith" $ do it "should generate Plaintext" $ document @ApiComplete `shouldBe` apiCompletePlainText it "should generate JSON" $
test/Test/Servant/Docs/Simple/Parse.hs view
@@ -3,22 +3,29 @@ module Test.Servant.Docs.Simple.Parse (parseSpec) where -import Data.Map.Ordered (empty) import Servant.API (EmptyAPI)+import Servant.API.ContentTypes (JSON, PlainText) import Test.Hspec (Spec, describe, it, shouldBe) import Test.Servant.Docs.Simple.Samples (ApiComplete, ApiMultiple, apiCompleteParsed, apiMultipleParsed) -import Servant.Docs.Simple.Parse (parseApi)+import Servant.Docs.Simple.Parse (parseApi, typeListText) import Servant.Docs.Simple.Render (ApiDocs (..)) parseSpec :: Spec-parseSpec = describe "Parses API to Document Tree" $ do- it "parses an EmptyAPI Details" $- parseApi @EmptyAPI `shouldBe` ApiDocs empty- it "parses all Servant API Combinators" $- parseApi @ApiComplete `shouldBe` apiCompleteParsed- it "parses an API with multiple endpoints" $- parseApi @ApiMultiple `shouldBe` apiMultipleParsed+parseSpec = describe "Servant.Docs.Simple.Parse" $ do+ describe "parseApi" $ do+ it "parses an EmptyAPI Details" $+ parseApi @EmptyAPI `shouldBe` ApiDocs []+ it "parses all Servant API Combinators" $+ parseApi @ApiComplete `shouldBe` apiCompleteParsed+ it "parses an API with multiple endpoints" $+ parseApi @ApiMultiple `shouldBe` apiMultipleParsed+ describe "typeListText" $ do+ it "works for '[()]" $ do+ typeListText @'[()] `shouldBe` "[()]"+ it "works for '[JSON,PlainText]" $+ typeListText @'[JSON,PlainText] `shouldBe` "[JSON,PlainText]"+
test/Test/Servant/Docs/Simple/Render.hs view
@@ -10,7 +10,7 @@ renderSpec :: Spec-renderSpec = describe "Renders Details" $ do+renderSpec = describe "render" $ do it "should render as JSON" $ render @Json apiCompleteParsed `shouldBe` apiCompleteJson it "should render as PlainText" $
test/Test/Servant/Docs/Simple/Samples.hs view
@@ -5,78 +5,77 @@ apiCompleteParsed, apiCompleteJson, apiMultipleParsed) where import Data.Aeson (Value (String), object)-import Data.Map.Ordered (fromList, singleton)-import Servant.API ((:<|>), (:>), AuthProtect, BasicAuth, Capture, CaptureAll, Description, Header,- HttpVersion, IsSecure, Post, QueryFlag, QueryParam, QueryParams, RemoteHost,- ReqBody, StreamBody, Summary, Vault)+import Servant.API (AuthProtect, BasicAuth, Capture, CaptureAll, Description, Header, HttpVersion,+ IsSecure,QueryFlag, QueryParam, QueryParams, RemoteHost, ReqBody,+ StreamBody, Summary, Vault, (:<|>), (:>), JSON )+import Servant.API.Verbs (Put, Post, Patch, Get) import Text.RawString.QQ (r) -import Servant.Docs.Simple.Parse (toDetails) import Servant.Docs.Simple.Render (ApiDocs (..), Details (..), Json (..), PlainText (..)) type ApiComplete = StaticRouteTest :> DynRouteTest :> CaptureAllTest :> ApiDetails apiCompleteParsed :: ApiDocs-apiCompleteParsed = ApiDocs $ curry singleton "/test_route/{test::()}/{test::()}" apiDetails+apiCompleteParsed = ApiDocs [("/test_route/{test::()}/{test::()}", apiDetails)] apiCompleteJson :: Json-apiCompleteJson = Json (object [ ( "/test_route/{test::()}/{test::()}"- , object [ ( "StreamBody"- , object [ ( "Format", String "()")- , ( "ContentType", String "()")- ])-- , ( "Summary",String "sampleText" )-- , ( "Basic Authentication"- , object [ ( "UserData", String "()")- , ( "Realm", String "local")- ])-- , ( "Captures Http Version", String "True")-- , ( "QueryParam"- , object [ ( "Param",String "test")- , ( "ContentType",String "()")- ])-- , ( "Authentication", String "TEST_JWT")-- , ( "Response"- , object [ ( "Format", String "': * () ('[] *)")- , ( "ContentType",String "()")- ])-- , ( "RequestType", String "'POST")-- , ( "Vault", String "True")-- , ( "Captures RemoteHost/IP", String "True")-- , ( "RequestHeaders"- , object [ ( "Name",String "test")- , ( "ContentType",String "()")- ])-- , ( "SSL Only",String "True")-- , ( "QueryParams"- , object [ ( "Param",String "test")- , ( "ContentType",String "()")- ])-- , ( "Description", String "sampleText")-- , ( "QueryFlag", object [( "Param",String "test")])-- , ( "RequestBody"- , object [ ( "Format", String "': * () ('[] *)")- , ( "ContentType",String "()")- ])-- ])])+apiCompleteJson = Json $ object+ [ ( "/test_route/{test::()}/{test::()}"+ , object+ [ ( "StreamBody"+ , object [ ( "Format", String "()")+ , ( "ContentType", String "()")+ ]+ )+ , ( "Summary", String "sampleText")+ , ( "Basic Authentication"+ , object [ ( "UserData", String "()")+ , ( "Realm", String "local")+ ]+ )+ , ( "Captures Http Version", String "True")+ , ( "QueryParam"+ , object [ ( "Param",String "test1")+ , ( "ContentType",String "Int")+ ]+ )+ , ( "QueryParam"+ , object [ ( "Param",String "test2")+ , ( "ContentType",String "Bool")+ ]+ )+ , ( "Authentication", String "TEST_JWT")+ , ( "Response"+ , object [ ( "Format", String "[()]")+ , ( "ContentType", String "()")+ ]+ )+ , ( "RequestType", String "'POST")+ , ( "Vault", String "True")+ , ( "Captures RemoteHost/IP", String "True")+ , ( "RequestHeaders"+ , object [ ( "Name",String "test")+ , ( "ContentType",String "()")+ ]+ )+ , ( "SSL Only", String "True")+ , ( "QueryParams"+ , object [ ( "Param",String "test")+ , ( "ContentType",String "()")+ ]+ )+ , ( "Description", String "sampleText")+ , ( "QueryFlag", object [( "Param",String "test")])+ , ( "RequestBody"+ , object [ ( "Format", String "[()]")+ , ( "ContentType",String "()")+ ]+ )+ ]+ )+ ] apiCompletePlainText :: PlainText apiCompletePlainText = PlainText [r|/test_route/{test::()}/{test::()}:@@ -96,31 +95,59 @@ QueryFlag: Param: test QueryParam:- Param: test- ContentType: ()+ Param: test1+ ContentType: Int+QueryParam:+ Param: test2+ ContentType: Bool QueryParams: Param: test ContentType: () RequestBody:- Format: ': * () ('[] *)+ Format: [()] ContentType: () StreamBody: Format: () ContentType: () RequestType: 'POST Response:- Format: ': * () ('[] *)+ Format: [()] ContentType: ()|] type ApiMultiple = "route1" :> DynRouteTest :> CaptureAllTest :> ApiDetails :<|> "route2" :> DynRouteTest :> CaptureAllTest :> ApiDetails :<|> "route3" :> DynRouteTest :> CaptureAllTest :> ApiDetails+ :<|> "get" :> GetTest+ :<|> "post" :> PostTest+ :<|> "put" :> PutTest+ :<|> "patch" :> PatchTest apiMultipleParsed :: ApiDocs-apiMultipleParsed = ApiDocs $ fromList [ ("/route1/{test::()}/{test::()}", apiDetails)- , ("/route2/{test::()}/{test::()}", apiDetails)- , ("/route3/{test::()}/{test::()}", apiDetails)- ]+apiMultipleParsed = ApiDocs + [ ("/route1/{test::()}/{test::()}", apiDetails)+ , ("/route2/{test::()}/{test::()}", apiDetails)+ , ("/route3/{test::()}/{test::()}", apiDetails)+ , ("/get", Details [ ("RequestType", Detail "'GET")+ , ("Response", Details [ ("Format",Detail "[JSON]")+ , ("ContentType",Detail "()")+ ])+ ])+ , ("/post", Details [ ("RequestType",Detail "'POST")+ , ("Response", Details [ ("Format",Detail "[()]")+ , ("ContentType",Detail "()")+ ])+ ])+ , ("/put", Details [ ("RequestType",Detail "'PUT")+ , ("Response", Details [ ("Format",Detail "[()]")+ , ("ContentType",Detail "()")+ ])+ ])+ , ("/patch", Details [ ("RequestType", Detail "'PATCH")+ , ("Response", Details [ ("Format",Detail "[()]")+ , ("ContentType",Detail "()")+ ])+ ])+ ] type ApiDetails = HttpVersionTest@@ -134,52 +161,49 @@ :> HeaderTest :> QueryFlagTest :> QueryParamTest+ :> QueryParamTest2 -- Check that multiple query parameters can be included in 1 endpoint :> QueryParamsTest :> ReqBodyTest :> StreamBodyTest- :> ResponseTest+ :> PostTest -apiDetails :: Details-apiDetails = toDetails [ ("Captures Http Version", Detail "True")- , ("SSL Only", Detail "True")- , ("Captures RemoteHost/IP", Detail "True")- , ("Description", Detail "sampleText")- , ("Summary", Detail "sampleText")- , ("Vault", Detail "True")- , ("Basic Authentication", toDetails [ ("Realm", Detail "local")- , ("UserData", Detail "()")- ]) - , ("Authentication", Detail "TEST_JWT")-- , ("RequestHeaders", toDetails [ ("Name", Detail "test")- , ("ContentType", Detail "()")- ])-- , ("QueryFlag", Details $ curry singleton "Param" (Detail "test"))-- , ("QueryParam", toDetails [ ("Param", Detail "test")- , ("ContentType", Detail "()")- ])-- , ("QueryParams", toDetails [ ("Param", Detail "test")- , ("ContentType", Detail "()")- ])-- , ("RequestBody", toDetails [ ("Format", Detail "': * () ('[] *)")- , ("ContentType", Detail "()")- ])-- , ("StreamBody", toDetails [ ("Format", Detail "()")- , ("ContentType", Detail "()")- ])-- , ("RequestType", Detail "'POST")-- , ("Response", toDetails [ ("Format", Detail "': * () ('[] *)")- , ("ContentType", Detail "()")- ])- ]+apiDetails :: Details+apiDetails = Details+ [ ("Captures Http Version", Detail "True")+ , ("SSL Only", Detail "True")+ , ("Captures RemoteHost/IP", Detail "True")+ , ("Description", Detail "sampleText")+ , ("Summary", Detail "sampleText")+ , ("Vault", Detail "True")+ , ("Basic Authentication", Details [ ("Realm", Detail "local")+ , ("UserData", Detail "()")+ ])+ , ("Authentication", Detail "TEST_JWT")+ , ("RequestHeaders", Details [ ("Name", Detail "test")+ , ("ContentType", Detail "()")+ ])+ , ("QueryFlag", Details [("Param", Detail "test")])+ , ("QueryParam", Details [ ("Param", Detail "test1")+ , ("ContentType", Detail "Int")+ ])+ , ("QueryParam", Details [ ("Param", Detail "test2")+ , ("ContentType", Detail "Bool")+ ])+ , ("QueryParams", Details [ ("Param", Detail "test")+ , ("ContentType", Detail "()")+ ])+ , ("RequestBody", Details [ ("Format", Detail "[()]")+ , ("ContentType", Detail "()")+ ])+ , ("StreamBody", Details [ ("Format", Detail "()")+ , ("ContentType", Detail "()")+ ])+ , ("RequestType", Detail "'POST")+ , ("Response", Details [ ("Format", Detail "[()]")+ , ("ContentType", Detail "()")+ ])+ ] type StaticRouteTest = "test_route" @@ -207,12 +231,20 @@ type QueryFlagTest = QueryFlag "test" -type QueryParamTest = QueryParam "test" ()+type QueryParamTest = QueryParam "test1" Int +type QueryParamTest2 = QueryParam "test2" Bool+ type QueryParamsTest = QueryParams "test" () type ReqBodyTest = ReqBody '[()] () type StreamBodyTest = StreamBody () () -type ResponseTest = Post '[()] ()+type GetTest = Get '[JSON] ()++type PostTest = Post '[()] ()++type PutTest = Put '[()] ()++type PatchTest = Patch '[()] ()