{-# LANGUAGE UndecidableInstances #-}
module Servant.Docs.Simple.Parse (HasParsable (..)) where
import Data.Foldable (fold)
import Data.Proxy
import Data.Text (Text, pack)
import Data.Typeable (Typeable, typeRep)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Servant.API ((:>), AuthProtect, BasicAuth, Capture', CaptureAll, Description, EmptyAPI,
Header', HttpVersion, IsSecure, QueryFlag, QueryParam', QueryParams, RemoteHost,
ReqBody', StreamBody', Summary, Vault, Verb)
import qualified Servant.API.TypeLevel as S (Endpoints)
import Servant.Docs.Simple.Render (Details (..), Endpoints (..), Node (..))
class HasParsable api where
parse :: Endpoints
instance HasCollatable (S.Endpoints a) => HasParsable a where
parse :: Endpoints
parse = HasCollatable (Endpoints a) => Endpoints
forall k (api :: k). HasCollatable api => Endpoints
collate @(S.Endpoints a)
instance {-# OVERLAPPING #-} HasParsable EmptyAPI where
parse :: Endpoints
parse = HasCollatable '[] => Endpoints
forall k (api :: k). HasCollatable api => Endpoints
collate @'[]
class HasCollatable api where
collate :: Endpoints
instance (HasDocumentApi api, HasCollatable b) => HasCollatable (api ': b) where
collate :: Endpoints
collate = [Node] -> Endpoints
Endpoints ([Node] -> Endpoints) -> [Node] -> Endpoints
forall a b. (a -> b) -> a -> b
$ HasDocumentApi api => Node
forall k (a :: k). HasDocumentApi a => Node
documentEndpoint @api Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
previous
where Endpoints previous :: [Node]
previous = HasCollatable b => Endpoints
forall k (api :: k). HasCollatable api => Endpoints
collate @b
instance HasCollatable '[] where
collate :: Endpoints
collate = [Node] -> Endpoints
Endpoints []
documentEndpoint :: forall a. HasDocumentApi a => Node
documentEndpoint :: Node
documentEndpoint = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @a "" []
class HasDocumentApi api where
document :: Text
-> [Node]
-> Node
instance (HasDocumentApi b, KnownSymbol route) => HasDocumentApi ((route :: Symbol) :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
formatted
where formatted :: Text
formatted = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Text
r, "/", Text
fragment]
fragment :: Text
fragment = KnownSymbol route => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @route
instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (Capture' m (dRoute :: Symbol) t :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
formatted
where formatted :: Text
formatted = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Text
r, "/", "{", Text
var, "::", Text
format, "}"]
var :: Text
var = KnownSymbol dRoute => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @dRoute
format :: Text
format = Typeable t => Text
forall k (a :: k). Typeable a => Text
typeText @t
instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (CaptureAll (dRoute :: Symbol) t :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
formatted
where formatted :: Text
formatted = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Text
r, "/", "{", Text
var, "::", Text
format, "}"]
var :: Text
var = KnownSymbol dRoute => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @dRoute
format :: Text
format = Typeable t => Text
forall k (a :: k). Typeable a => Text
typeText @t
instance HasDocumentApi b => HasDocumentApi (HttpVersion :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "Captures Http Version" (Text -> Details
Detail "True")
instance HasDocumentApi b => HasDocumentApi (IsSecure :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "SSL Only" (Text -> Details
Detail "True")
instance HasDocumentApi b => HasDocumentApi (RemoteHost :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "Captures RemoteHost/IP" (Text -> Details
Detail "True")
instance (HasDocumentApi b, KnownSymbol desc) => HasDocumentApi (Description (desc :: Symbol) :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "Description" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol desc => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @desc)
instance (HasDocumentApi b, KnownSymbol s) => HasDocumentApi (Summary (s :: Symbol) :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "Summary" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol s => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @s)
instance HasDocumentApi b => HasDocumentApi (Vault :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
desc])
where desc :: Node
desc = Text -> Details -> Node
Node "Vault" (Text -> Details
Detail "True")
instance (HasDocumentApi b, KnownSymbol realm, Typeable a) => HasDocumentApi (BasicAuth (realm :: Symbol) a :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "Basic Authentication" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Realm" (Text -> Details
Detail Text
realm)
, Text -> Details -> Node
Node "UserData" (Text -> Details
Detail Text
userData)
]
realm :: Text
realm = KnownSymbol realm => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @realm
userData :: Text
userData = Typeable a => Text
forall k (a :: k). Typeable a => Text
typeText @a
instance (HasDocumentApi b, KnownSymbol token) => HasDocumentApi (AuthProtect (token :: Symbol) :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "Authentication" (Text -> Details
Detail Text
authDoc)
authDoc :: Text
authDoc = KnownSymbol token => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @token
instance (HasDocumentApi b, KnownSymbol ct, Typeable typ) => HasDocumentApi (Header' m (ct :: Symbol) typ :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "RequestHeaders" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Name" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol ct => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @ct)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
instance (HasDocumentApi b, KnownSymbol param) => HasDocumentApi (QueryFlag (param :: Symbol) :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "QueryFlag" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Param" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @param) ]
instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParam' m (param :: Symbol) typ :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "QueryParam" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Param" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @param)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParams (param :: Symbol) typ :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "QueryParams" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Param" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Text
forall (n :: Symbol). KnownSymbol n => Text
symbolVal' @param)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (ReqBody' m ct typ :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "RequestBody" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Format" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Text
forall k (a :: k). Typeable a => Text
typeText @ct)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (StreamBody' m ct typ :> b) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> [Node] -> Node
forall k (api :: k). HasDocumentApi api => Text -> [Node] -> Node
document @b Text
r ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node
formatted])
where formatted :: Node
formatted = Text -> Details -> Node
Node "StreamBody" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Format" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Text
forall k (a :: k). Typeable a => Text
typeText @ct)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
instance (Typeable m, Typeable ct, Typeable typ) => HasDocumentApi (Verb m s ct typ) where
document :: Text -> [Node] -> Node
document r :: Text
r a :: [Node]
a = Text -> Details -> Node
Node Text
r (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details ([Node]
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [ Node
requestType
, Node
response
])
where requestType :: Node
requestType = Text -> Details -> Node
Node "RequestType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable m => Text
forall k (a :: k). Typeable a => Text
typeText @m)
response :: Node
response = Text -> Details -> Node
Node "Response" (Details -> Node) -> Details -> Node
forall a b. (a -> b) -> a -> b
$
[Node] -> Details
Details [ Text -> Details -> Node
Node "Format" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Text
forall k (a :: k). Typeable a => Text
typeText @ct)
, Text -> Details -> Node
Node "ContentType" (Text -> Details
Detail (Text -> Details) -> Text -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Text
forall k (a :: k). Typeable a => Text
typeText @typ)
]
typeText :: forall a. (Typeable a) => Text
typeText :: Text
typeText = String -> Text
pack (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy a -> TypeRep) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
symbolVal' :: forall n. KnownSymbol n => Text
symbolVal' :: Text
symbolVal' = String -> Text
pack (String -> Text) -> (Proxy n -> String) -> Proxy n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n -> Text) -> Proxy n -> Text
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n