{- | Parse Servant API into documentation

__Example script__

[Generating the intermediate documentation structure](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/parse.hs)

[Parsing custom API type combinators](https://github.com/Holmusk/servant-docs-simple/blob/master/examples/custom.hs)

__Example of parsing an API__

/API type/

> type API = "hello" :> "world" :> Request :> Response
> type Request = ReqBody '[()] ()
> type Response = Post '[()] ()

/Intermediate structure/

> ApiDocs ( fromList [( "/hello/world",
>                     , Details (fromList ([ ( "RequestBody"
>                                            , Details (fromList ([ ( "Format"
>                                                                   , Detail "[()]"
>                                                                   )
>                                                                 , ( "ContentType"
>                                                                   , Detail "()"
>                                                                   )
>                                                                 ]))
>                                            )
>                                          , ( "RequestType"
>                                            , Detail "'POST"
>                                            )
>                                          , ( "Response"
>                                            , Details (fromList ([ ( "Format"
>                                                                   , Detail "[()]"
>                                                                   )
>                                                                 , ( "ContentType"
>                                                                   , Detail "()"
>                                                                   )
>                                                                 ]))
>                                            )
>                                          ]))
>                     )])

-}

{-# LANGUAGE UndecidableInstances #-}

module Servant.Docs.Simple.Parse
       ( HasParsableEndpoint (..)
       , HasParsableApi (..)
       , symbolVal'
       , typeText
       , typeListText
       ) where


import Data.Foldable (fold)
import Data.Proxy
import Data.Text (Text, pack)
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,
                    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)
import Data.Kind (Type)

-- | Flattens API into type level list of Endpoints
class HasParsableApi api where
    parseApi :: ApiDocs

-- | If the flattened API can be collated into documentation, it is parsable
instance HasCollatable (S.Endpoints a) => HasParsableApi a where
    parseApi :: ApiDocs
parseApi = HasCollatable (Endpoints a) => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @(S.Endpoints a)

-- | Empty APIs should have no documentation
instance {-# OVERLAPPING #-} HasParsableApi EmptyAPI where
    parseApi :: ApiDocs
parseApi = HasCollatable '[] => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @'[]

-- | Folds api endpoints into documentation
class HasCollatable api where
    -- | Folds list of endpoints to documentation
    collate :: ApiDocs

-- | Collapse a type-level list of API endpoints into documentation
instance (HasParsableEndpoint e, HasCollatable b) => HasCollatable (e ': b) where
    collate :: ApiDocs
collate = [(Route, Details)] -> ApiDocs
ApiDocs ([(Route, Details)] -> ApiDocs) -> [(Route, Details)] -> ApiDocs
forall a b. (a -> b) -> a -> b
$ ([(Route, Details)] -> Details
Details ([(Route, Details)] -> Details)
-> (Route, [(Route, Details)]) -> (Route, Details)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasParsableEndpoint e => (Route, [(Route, Details)])
forall k (a :: k).
HasParsableEndpoint a =>
(Route, [(Route, Details)])
documentEndpoint @e) (Route, Details) -> [(Route, Details)] -> [(Route, Details)]
forall a. a -> [a] -> [a]
: [(Route, Details)]
previous
      where ApiDocs [(Route, Details)]
previous = HasCollatable b => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @b

-- | Terminal step when there are no more endpoints left to recurse over
instance HasCollatable '[] where
    collate :: ApiDocs
collate = [(Route, Details)] -> ApiDocs
ApiDocs []

-- | Folds an api endpoint into documentation
documentEndpoint :: forall a. HasParsableEndpoint a => (Route, [(Parameter, Details)])
documentEndpoint :: (Route, [(Route, Details)])
documentEndpoint = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @a Route
"" []

-- | Folds an api endpoint into documentation
class HasParsableEndpoint e where

    -- | We use this to destructure the API type and convert it into documentation
    parseEndpoint :: Route -- ^ Route documentation
                  -> [(Parameter, Details)] -- ^ Everything else documentation
                  -> (Route, [(Parameter, Details)]) -- ^ Generated documentation for the route

-- | Static route documentation
instance (HasParsableEndpoint b, KnownSymbol route) => HasParsableEndpoint ((route :: Symbol) :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
formatted
      where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, Route
"/", Route
fragment]
            fragment :: Route
fragment = KnownSymbol route => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @route

-- | Capture documentation
instance (HasParsableEndpoint b, KnownSymbol dRoute, Typeable t) => HasParsableEndpoint (Capture' m (dRoute :: Symbol) t :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
formatted
      where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, Route
"/", Route
"{", Route
var, Route
"::", Route
format, Route
"}"]
            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

-- | CaptureAll documentation
instance (HasParsableEndpoint b, KnownSymbol dRoute, Typeable t) => HasParsableEndpoint (CaptureAll (dRoute :: Symbol) t :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
formatted
      where formatted :: Route
formatted = [Route] -> Route
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Route
r, Route
"/", Route
"{", Route
var, Route
"::", Route
format, Route
"}"]
            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

-- | Request HttpVersion documentation
instance HasParsableEndpoint b => HasParsableEndpoint (HttpVersion :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"Captures Http Version", Route -> Details
Detail Route
"True")]

-- | IsSecure documentation
instance HasParsableEndpoint b => HasParsableEndpoint (IsSecure :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"SSL Only", Route -> Details
Detail Route
"True")]

-- | Request Remote host documentation
instance HasParsableEndpoint b => HasParsableEndpoint (RemoteHost :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"Captures RemoteHost/IP", Route -> Details
Detail Route
"True")]

-- | Description documentation
instance (HasParsableEndpoint b, KnownSymbol desc) => HasParsableEndpoint (Description (desc :: Symbol) :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"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)]

-- | Summary documentation
instance (HasParsableEndpoint b, KnownSymbol s) => HasParsableEndpoint (Summary (s :: Symbol) :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"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)]

-- | Vault documentation
instance HasParsableEndpoint b => HasParsableEndpoint (Vault :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"Vault", Route -> Details
Detail Route
"True")]

-- | Basic authentication documentation
instance (HasParsableEndpoint b, KnownSymbol realm, Typeable a) => HasParsableEndpoint (BasicAuth (realm :: Symbol) a :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"Basic Authentication"
                                        , [(Route, Details)] -> Details
Details [ (Route
"Realm", Route -> Details
Detail Route
realm)
                                                  , (Route
"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

-- | Authentication documentation
instance (HasParsableEndpoint b, KnownSymbol token) => HasParsableEndpoint (AuthProtect (token :: Symbol) :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"Authentication", Route -> Details
Detail Route
authDoc)]
        where authDoc :: Route
authDoc = KnownSymbol token => Route
forall (n :: Symbol). KnownSymbol n => Route
symbolVal' @token

-- | Request header documentation
instance (HasParsableEndpoint b, KnownSymbol ct, Typeable typ) => HasParsableEndpoint (Header' m (ct :: Symbol) typ :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"RequestHeaders"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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)
                                                  , (Route
"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)
                                                  ]
                                        )]

-- | Query flag documentation
instance (HasParsableEndpoint b, KnownSymbol param) => HasParsableEndpoint (QueryFlag (param :: Symbol) :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"QueryFlag"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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) ]
                                        )]

-- | Query param documentation
instance (HasParsableEndpoint b, KnownSymbol param, Typeable typ) => HasParsableEndpoint (QueryParam' m (param :: Symbol) typ :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"QueryParam"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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)
                                                  , (Route
"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)
                                                  ]
                                        )]

-- | Query params documentation
instance (HasParsableEndpoint b, KnownSymbol param, Typeable typ) => HasParsableEndpoint (QueryParams (param :: Symbol) typ :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"QueryParams"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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)
                                                  , (Route
"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)
                                                  ]
                                        )]

-- | Request body documentation
instance (HasParsableEndpoint b, Typeable (ct :: [Type]), Typeable typ) => HasParsableEndpoint (ReqBody' m (ct :: [Type]) typ :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"RequestBody"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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
typeListText @ct)
                                                  , (Route
"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)
                                                  ]
                                        )]

-- | Stream body documentation
instance (HasParsableEndpoint b, Typeable ct, Typeable typ) => HasParsableEndpoint (StreamBody' m ct typ :> b) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = Route -> [(Route, Details)] -> (Route, [(Route, Details)])
forall k (e :: k).
HasParsableEndpoint e =>
Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint @b Route
r ([(Route, Details)] -> (Route, [(Route, Details)]))
-> [(Route, Details)] -> (Route, [(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
"StreamBody"
                                        , [(Route, Details)] -> Details
Details [ (Route
"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)
                                                  , (Route
"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)
                                                  ]
                                        )]

-- | 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 :: [Type]), Typeable typ) => HasParsableEndpoint (Verb m s (ct :: [Type]) typ) where
    parseEndpoint :: Route -> [(Route, Details)] -> (Route, [(Route, Details)])
parseEndpoint Route
r [(Route, Details)]
a = (Route
r,  [(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 = (Route
"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 = ( Route
"Response"
                         , [(Route, Details)] -> Details
Details [ (Route
"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
typeListText @ct)
                                   , (Route
"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)
                                   ]
                         )


-- | Convert types to Text
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

-- | 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 :: Route
typeListText = case TypeRep -> Maybe [TypeRep]
go (TypeRep -> Maybe [TypeRep])
-> (Proxy a -> TypeRep) -> Proxy a -> Maybe [TypeRep]
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 -> Maybe [TypeRep]) -> Proxy a -> Maybe [TypeRep]
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a of
    Maybe [TypeRep]
Nothing -> Typeable a => Route
forall k (a :: k). Typeable a => Route
typeText @a
    Just [TypeRep]
typeReps -> String -> Route
pack (String -> Route) -> String -> Route
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> String
forall a. Show a => a -> String
show [TypeRep]
typeReps
  where
    go :: TypeRep -> Maybe [TypeRep]
    go :: TypeRep -> Maybe [TypeRep]
go TypeRep
typRep = case TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
typRep of
        (TyCon
tyCon, [TypeRep
x,TypeRep
xs]) | TyCon -> Bool
isCons TyCon
tyCon -> (TypeRep
xTypeRep -> [TypeRep] -> [TypeRep]
forall a. a -> [a] -> [a]
:) ([TypeRep] -> [TypeRep]) -> Maybe [TypeRep] -> Maybe [TypeRep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRep -> Maybe [TypeRep]
go TypeRep
xs
        (TyCon
tyCon, [])| TyCon -> Bool
isNil TyCon
tyCon -> [TypeRep] -> Maybe [TypeRep]
forall a. a -> Maybe a
Just []
        (TyCon, [TypeRep])
_ -> Maybe [TypeRep]
forall a. Maybe a
Nothing
    
    isCons :: TyCon -> Bool
    isCons :: TyCon -> Bool
isCons TyCon
tc =
        TyCon -> String
tyConPackage TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ghc-prim"
        Bool -> Bool -> Bool
&& TyCon -> String
tyConModule TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"GHC.Types"
        Bool -> Bool -> Bool
&& TyCon -> String
tyConName TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"':"

    isNil :: TyCon -> Bool
    isNil :: TyCon -> Bool
isNil TyCon
tc =
        TyCon -> String
tyConPackage TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ghc-prim"
        Bool -> Bool -> Bool
&& TyCon -> String
tyConModule TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"GHC.Types"
        Bool -> Bool -> Bool
&& TyCon -> String
tyConName TyCon
tc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"'[]"

-- | Convert symbol to Text
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