"]) 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) =
+ 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, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
+ => HasDocs (ReqBody 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
+ p = Proxy :: Proxy a
+
+instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
+
+ docsFor Proxy (endpoint, action) =
+ docsFor sublayoutP (endpoint', action)
+
+ where sublayoutP = Proxy :: Proxy sublayout
+ endpoint' = endpoint & path <>~ [symbolVal pa]
+ pa = Proxy :: Proxy path
+
+{-
+
+-- | Serve your API's docs as markdown embedded in an html \ tag.
+--
+-- > type MyApi = "users" :> Get [User]
+-- > :<|> "docs :> Raw
+-- >
+-- > apiProxy :: Proxy MyApi
+-- > apiProxy = Proxy
+-- >
+-- > server :: Server MyApi
+-- > server = listUsers
+-- > :<|> serveDocumentation apiProxy
+serveDocumentation :: HasDocs api => Proxy api -> Server Raw
+serveDocumentation proxy _request respond =
+ respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
+
+toHtml :: String -> String
+toHtml md =
+ "" ++
+ "" ++
+ "" ++
+ md ++
+ "
" ++
+ "" ++
+ ""
+-}
diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs
new file mode 100644
index 00000000..803823ba
--- /dev/null
+++ b/servant-docs/test/Servant/DocsSpec.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Servant.DocsSpec where
+
+import Data.Aeson
+import Data.Proxy
+import Data.String.Conversions (cs)
+import GHC.Generics
+import Test.Hspec
+
+import Servant.API
+import Servant.Docs.Internal
+
+spec :: Spec
+spec = describe "Servant.Docs" $ do
+
+ describe "markdown" $ do
+ let md = markdown (docs (Proxy :: Proxy TestApi1))
+
+ 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"
+ md `shouldContain` "Status code 201"
+
+ it "mentions methods" $ do
+ md `shouldContain` "POST"
+ md `shouldContain` "GET"
+
+ it "contains response samples" $ do
+ md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"
+ it "contains request body samples" $ do
+ md `shouldContain` "17"
+-- * APIs
+
+data Datatype1 = Datatype1 { dt1field1 :: String
+ , dt1field2 :: Int
+ } deriving (Eq, Show, Generic)
+
+instance ToJSON Datatype1
+
+instance ToSample Datatype1 where
+ toSample = Just $ Datatype1 "field 1" 13
+
+instance ToSample String where
+ toSample = Just "a string"
+
+instance ToSample Int where
+ toSample = Just 17
+
+instance MimeRender PlainText Int where
+ mimeRender _ = cs . show
+
+
+type TestApi1 = Get '[JSON, PlainText] Int
+ :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
+
diff --git a/servant-docs/test/Spec.hs b/servant-docs/test/Spec.hs
new file mode 100644
index 00000000..a824f8c3
--- /dev/null
+++ b/servant-docs/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}