{-# LANGUAGE UndecidableInstances #-}
module Servant.Docs.Simple.Parse
( HasDocumentApi (..)
, HasParsable (..)
, symbolVal'
, toDetails
, typeText
) 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 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 (ApiDocs (..), Details (..), Parameter, Route)
class HasParsable api where
parse :: ApiDocs
instance HasCollatable (S.Endpoints a) => HasParsable a where
parse :: ApiDocs
parse = HasCollatable (Endpoints a) => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @(S.Endpoints a)
instance {-# OVERLAPPING #-} HasParsable EmptyAPI where
parse :: ApiDocs
parse = HasCollatable '[] => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @'[]
class HasCollatable api where
collate :: ApiDocs
instance (HasDocumentApi api, HasCollatable b) => HasCollatable (api ': b) where
collate :: ApiDocs
collate = OMap Route Details -> ApiDocs
ApiDocs (OMap Route Details -> ApiDocs) -> OMap Route Details -> ApiDocs
forall a b. (a -> b) -> a -> b
$ (OMap Route Details -> Details
Details (OMap Route Details -> Details)
-> (Route, OMap Route Details) -> (Route, Details)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasDocumentApi api => (Route, OMap Route Details)
forall k (a :: k). HasDocumentApi a => (Route, OMap Route Details)
documentEndpoint @api) (Route, Details) -> OMap Route Details -> OMap Route Details
forall k v. Ord k => (k, v) -> OMap k v -> OMap k v
|< OMap Route Details
previous
where ApiDocs previous :: OMap Route Details
previous = HasCollatable b => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @b
instance HasCollatable '[] where
collate :: ApiDocs
collate = OMap Route Details -> ApiDocs
ApiDocs OMap Route Details
forall k v. OMap k v
empty
documentEndpoint :: forall a. HasDocumentApi a => (Route, OMap Parameter Details)
documentEndpoint :: (Route, OMap Route Details)
documentEndpoint = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @a "" []
class HasDocumentApi api where
document :: Route
-> [(Parameter, Details)]
-> (Route, OMap Parameter Details)
instance (HasDocumentApi b, KnownSymbol route) => HasDocumentApi ((route :: Symbol) :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
formatted
where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, "/", Route
fragment]
fragment :: Route
fragment = KnownSymbol route => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @route
instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (Capture' m (dRoute :: Symbol) t :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
formatted
where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, "/", "{", Route
var, "::", Route
format, "}"]
var :: Route
var = KnownSymbol dRoute => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @dRoute
format :: Route
format = Typeable t => Route
forall k (a :: k). Typeable a => Route
typeText @t
instance (HasDocumentApi b, KnownSymbol dRoute, Typeable t) => HasDocumentApi (CaptureAll (dRoute :: Symbol) t :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
formatted
where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, "/", "{", Route
var, "::", Route
format, "}"]
var :: Route
var = KnownSymbol dRoute => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @dRoute
format :: Route
format = Typeable t => Route
forall k (a :: k). Typeable a => Route
typeText @t
instance HasDocumentApi b => HasDocumentApi (HttpVersion :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Captures Http Version", Route -> Details
Detail "True")]
instance HasDocumentApi b => HasDocumentApi (IsSecure :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("SSL Only", Route -> Details
Detail "True")]
instance HasDocumentApi b => HasDocumentApi (RemoteHost :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Captures RemoteHost/IP", Route -> Details
Detail "True")]
instance (HasDocumentApi b, KnownSymbol desc) => HasDocumentApi (Description (desc :: Symbol) :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Description", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol desc => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @desc)]
instance (HasDocumentApi b, KnownSymbol s) => HasDocumentApi (Summary (s :: Symbol) :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Summary", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol s => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @s)]
instance HasDocumentApi b => HasDocumentApi (Vault :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Vault", Route -> Details
Detail "True")]
instance (HasDocumentApi b, KnownSymbol realm, Typeable a) => HasDocumentApi (BasicAuth (realm :: Symbol) a :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "Basic Authentication"
, [(Route, Details)] -> Details
toDetails [ ("Realm", Route -> Details
Detail Route
realm)
, ("UserData", Route -> Details
Detail Route
userData)
]
)]
where realm :: Route
realm = KnownSymbol realm => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @realm
userData :: Route
userData = Typeable a => Route
forall k (a :: k). Typeable a => Route
typeText @a
instance (HasDocumentApi b, KnownSymbol token) => HasDocumentApi (AuthProtect (token :: Symbol) :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [("Authentication", Route -> Details
Detail Route
authDoc)]
where authDoc :: Route
authDoc = KnownSymbol token => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @token
instance (HasDocumentApi b, KnownSymbol ct, Typeable typ) => HasDocumentApi (Header' m (ct :: Symbol) typ :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "RequestHeaders"
, [(Route, Details)] -> Details
toDetails [ ("Name", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol ct => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @ct)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)]
instance (HasDocumentApi b, KnownSymbol param) => HasDocumentApi (QueryFlag (param :: Symbol) :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "QueryFlag"
, [(Route, Details)] -> Details
toDetails [ ("Param", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @param) ]
)]
instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParam' m (param :: Symbol) typ :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "QueryParam"
, [(Route, Details)] -> Details
toDetails [ ("Param", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @param)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)]
instance (HasDocumentApi b, KnownSymbol param, Typeable typ) => HasDocumentApi (QueryParams (param :: Symbol) typ :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "QueryParams"
, [(Route, Details)] -> Details
toDetails [ ("Param", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ KnownSymbol param => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @param)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)]
instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (ReqBody' m ct typ :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "RequestBody"
, [(Route, Details)] -> Details
toDetails [ ("Format", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Route
forall k (a :: k). Typeable a => Route
typeText @ct)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)]
instance (HasDocumentApi b, Typeable ct, Typeable typ) => HasDocumentApi (StreamBody' m ct typ :> b) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, OMap Route Details)
forall k (api :: k).
HasDocumentApi api =>
Route -> [(Route, Details)] -> (Route, OMap Route Details)
document @b Route
r ([(Route, Details)] -> (Route, OMap Route Details))
-> [(Route, Details)] -> (Route, OMap Route Details)
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [( "StreamBody"
, [(Route, Details)] -> Details
toDetails [ ("Format", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Route
forall k (a :: k). Typeable a => Route
typeText @ct)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)]
instance (Typeable m, Typeable ct, Typeable typ) => HasDocumentApi (Verb m s ct typ) where
document :: Route -> [(Route, Details)] -> (Route, OMap Route Details)
document r :: Route
r a :: [(Route, Details)]
a = ( Route
r
, [(Route, Details)] -> OMap Route Details
forall k v. Ord k => [(k, v)] -> OMap k v
fromList ([(Route, Details)] -> OMap Route Details)
-> [(Route, Details)] -> OMap Route Details
forall a b. (a -> b) -> a -> b
$ [(Route, Details)]
a [(Route, Details)] -> [(Route, Details)] -> [(Route, Details)]
forall a. Semigroup a => a -> a -> a
<> [(Route, Details)
requestType, (Route, Details)
response]
)
where requestType :: (Route, Details)
requestType = ("RequestType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable m => Route
forall k (a :: k). Typeable a => Route
typeText @m)
response :: (Route, Details)
response = ( "Response"
, [(Route, Details)] -> Details
toDetails [ ("Format", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable ct => Route
forall k (a :: k). Typeable a => Route
typeText @ct)
, ("ContentType", Route -> Details
Detail (Route -> Details) -> Route -> Details
forall a b. (a -> b) -> a -> b
$ Typeable typ => Route
forall k (a :: k). Typeable a => Route
typeText @typ)
]
)
toDetails :: [(Text, Details)] -> Details
toDetails :: [(Route, Details)] -> Details
toDetails = OMap Route Details -> Details
Details (OMap Route Details -> Details)
-> ([(Route, Details)] -> OMap Route Details)
-> [(Route, Details)]
-> Details
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Route, Details)] -> OMap Route Details
forall k v. Ord k => [(k, v)] -> OMap k v
fromList
typeText :: forall a. (Typeable a) => Text
typeText :: Route
typeText = String -> Route
pack (String -> Route) -> (Proxy a -> String) -> Proxy a -> Route
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 -> Route) -> Proxy a -> Route
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
symbolVal' :: forall n. KnownSymbol n => Text
symbolVal' :: Route
symbolVal' = String -> Route
pack (String -> Route) -> (Proxy n -> String) -> Proxy n -> Route
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 -> Route) -> Proxy n -> Route
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n