diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # servant-docs-simple -[![Build status](https://img.shields.io/travis/holmusk/servant-docs-simple.svg?logo=travis)](https://travis-ci.org/holmusk/servant-docs-simple) +[![Build status](https://github.com/holmusk/servant-docs-simple/workflows/CI/badge.svg)](https://github.com/holmusk/servant-docs-simple/actions) [![Hackage](https://img.shields.io/hackage/v/servant-docs-simple.svg?logo=haskell)](https://hackage.haskell.org/package/servant-docs-simple) [![Stackage Lts](http://stackage.org/package/servant-docs-simple/badge/lts)](http://stackage.org/lts/package/servant-docs-simple) [![Stackage Nightly](http://stackage.org/package/servant-docs-simple/badge/nightly)](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 diff --git a/servant-docs-simple.cabal b/servant-docs-simple.cabal --- a/servant-docs-simple.cabal +++ b/servant-docs-simple.cabal @@ -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 diff --git a/src/Servant/Docs/Simple.hs b/src/Servant/Docs/Simple.hs --- a/src/Servant/Docs/Simple.hs +++ b/src/Servant/Docs/Simple.hs @@ -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: () -} diff --git a/src/Servant/Docs/Simple/Parse.hs b/src/Servant/Docs/Simple/Parse.hs --- a/src/Servant/Docs/Simple/Parse.hs +++ b/src/Servant/Docs/Simple/Parse.hs @@ -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 diff --git a/src/Servant/Docs/Simple/Render.hs b/src/Servant/Docs/Simple/Render.hs --- a/src/Servant/Docs/Simple/Render.hs +++ b/src/Servant/Docs/Simple/Render.hs @@ -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 diff --git a/test/Test/Servant/Docs/Simple.hs b/test/Test/Servant/Docs/Simple.hs --- a/test/Test/Servant/Docs/Simple.hs +++ b/test/Test/Servant/Docs/Simple.hs @@ -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" $ diff --git a/test/Test/Servant/Docs/Simple/Parse.hs b/test/Test/Servant/Docs/Simple/Parse.hs --- a/test/Test/Servant/Docs/Simple/Parse.hs +++ b/test/Test/Servant/Docs/Simple/Parse.hs @@ -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]" + diff --git a/test/Test/Servant/Docs/Simple/Render.hs b/test/Test/Servant/Docs/Simple/Render.hs --- a/test/Test/Servant/Docs/Simple/Render.hs +++ b/test/Test/Servant/Docs/Simple/Render.hs @@ -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" $ diff --git a/test/Test/Servant/Docs/Simple/Samples.hs b/test/Test/Servant/Docs/Simple/Samples.hs --- a/test/Test/Servant/Docs/Simple/Samples.hs +++ b/test/Test/Servant/Docs/Simple/Samples.hs @@ -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 '[()] ()