{-# 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)
class HasParsableApi api where
parseApi :: ApiDocs
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)
instance {-# OVERLAPPING #-} HasParsableApi EmptyAPI where
parseApi :: ApiDocs
parseApi = HasCollatable '[] => ApiDocs
forall k (api :: k). HasCollatable api => ApiDocs
collate @'[]
class HasCollatable api where
collate :: ApiDocs
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
instance HasCollatable '[] where
collate :: ApiDocs
collate = [(Route, Details)] -> ApiDocs
ApiDocs []
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
"" []
class HasParsableEndpoint e where
parseEndpoint :: Route
-> [(Parameter, Details)]
-> (Route, [(Parameter, Details)])
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
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
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
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")]
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")]
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")]
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)]
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)]
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")]
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
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
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)
]
)]
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) ]
)]
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)
]
)]
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)
]
)]
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)
]
)]
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)
]
)]
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)
]
)
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
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
"'[]"
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