{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-missing-methods #-}

module Servant.Client.TypeScript
  ( -- * Generator functions
    gen
  , tsClient
    -- * Type Classes
  , Fletch (..)
  , GenAll (..)
    -- * AST data types
  , DocType (..)
  , InputMethod (..)
  , URIBit (..)
  ) where

import           Data.Aeson (ToJSON (toJSON))
import qualified Data.Aeson as Aeson
import           Data.Aeson.Generics.TypeScript
  ( FieldSpec (..)
  , FieldTypeName (fieldTypeName)
  , TypeScriptDefinition
  , concretely
  , fieldTypeName
  , fs_wrapped
  )
import qualified Data.Aeson.Generics.TypeScript as TS
import           Data.Containers.ListUtils (nubOrd)
import           Data.Kind (Constraint, Type)
import           Data.List (intercalate, sort)
import qualified Data.Map as Map
import           Data.Maybe (mapMaybe)
import           Data.String (fromString)
import           Data.String.Interpolate (i)
import           Data.Text (Text, pack, unpack)
import           Data.Text.Encoding (decodeUtf8')
import           Data.Typeable (Proxy (..))
import           GHC.TypeLits
  ( ErrorMessage (Text)
  , KnownSymbol
  , Symbol
  , TypeError
  , symbolVal
  )
import           Jose.Jwt (Jwt)
import           Network.HTTP.Types (Method, urlEncode)
import           Servant.API as Servant
  ( AuthProtect
  , Capture'
  , CaptureAll
  , Description
  , EmptyAPI
  , Fragment
  , HList (HCons)
  , Header'
  , Headers (Headers)
  , JSON
  , NoContent
  , QueryFlag
  , QueryParam'
  , QueryParams
  , ReflectMethod (reflectMethod)
  , ReqBody'
  , ResponseHeader (..)
  , Summary
  , Verb
  , type (:>)
  , (:<|>)
  )
import           Servant.API.WebSocketConduit (WebSocketConduit)

hush :: Either a b -> Maybe b
hush :: forall a b. Either a b -> Maybe b
hush (Right b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x
hush Either a b
_         = Maybe b
forall a. Maybe a
Nothing

-- | What is the means of input for this @URIBit@?
type InputMethod :: Type
data InputMethod
  = Capture
  | Query
  | Querys
  | Header_
  | Body
  | Fragment
  | WSInput
  deriving stock (InputMethod -> InputMethod -> Bool
(InputMethod -> InputMethod -> Bool)
-> (InputMethod -> InputMethod -> Bool) -> Eq InputMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputMethod -> InputMethod -> Bool
== :: InputMethod -> InputMethod -> Bool
$c/= :: InputMethod -> InputMethod -> Bool
/= :: InputMethod -> InputMethod -> Bool
Eq, Int -> InputMethod -> ShowS
[InputMethod] -> ShowS
InputMethod -> String
(Int -> InputMethod -> ShowS)
-> (InputMethod -> String)
-> ([InputMethod] -> ShowS)
-> Show InputMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputMethod -> ShowS
showsPrec :: Int -> InputMethod -> ShowS
$cshow :: InputMethod -> String
show :: InputMethod -> String
$cshowList :: [InputMethod] -> ShowS
showList :: [InputMethod] -> ShowS
Show)

-- | What kind of API documentation are we using for this route?
type DocType :: Type
data DocType
  = Summary'
  | Description'
  deriving stock (Int -> DocType -> ShowS
[DocType] -> ShowS
DocType -> String
(Int -> DocType -> ShowS)
-> (DocType -> String) -> ([DocType] -> ShowS) -> Show DocType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocType -> ShowS
showsPrec :: Int -> DocType -> ShowS
$cshow :: DocType -> String
show :: DocType -> String
$cshowList :: [DocType] -> ShowS
showList :: [DocType] -> ShowS
Show)

-- | An input chunk of the URI
type URIBit :: Type
data URIBit = PathBit String
            | ArgBit InputMethod String String
            | DocBit DocType String
  deriving stock (Int -> URIBit -> ShowS
[URIBit] -> ShowS
URIBit -> String
(Int -> URIBit -> ShowS)
-> (URIBit -> String) -> ([URIBit] -> ShowS) -> Show URIBit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URIBit -> ShowS
showsPrec :: Int -> URIBit -> ShowS
$cshow :: URIBit -> String
show :: URIBit -> String
$cshowList :: [URIBit] -> ShowS
showList :: [URIBit] -> ShowS
Show)

-- | Type class that iterates over the servant type and seperates out inputs and outputs
type Fletch :: Type -> Constraint
class Fletch route where
  argBits :: [URIBit]
  returnType :: (Method, String)

instance (KnownSymbol s, Fletch xs) => Fletch (Summary s :> xs) where
  argBits :: [URIBit]
argBits = DocType -> String -> URIBit
DocBit DocType
Summary' (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> String) -> Proxy s -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (KnownSymbol s, Fletch xs) => Fletch (Description s :> xs) where
  argBits :: [URIBit]
argBits = DocType -> String -> URIBit
DocBit DocType
Description' (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> String) -> Proxy s -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (TypeError ('Text "💠 EmptyAPI's cannot be Fletched as they do not make a request")) => Fletch EmptyAPI where
instance (TypeError ('Text "💠 EmptyAPI's cannot be GenAll as they do not make a request")) => GenAll EmptyAPI where

instance (FieldTypeName i, FieldTypeName o) => Fletch (WebSocketConduit i o) where
  argBits :: [URIBit]
argBits = [InputMethod -> String -> String -> URIBit
ArgBit InputMethod
WSInput String
"WebSocketInput" (String -> URIBit) -> (Proxy i -> String) -> Proxy i -> URIBit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy i -> FieldSpec) -> Proxy i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy i -> URIBit) -> Proxy i -> URIBit
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i]
  returnType :: (ByteString, String)
returnType = (ByteString
"connect", FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy o -> FieldSpec) -> Proxy o -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy o -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy o -> String) -> Proxy o -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @o)

instance (Fletch xs, KnownSymbol s) => Fletch ((s :: Symbol) :> xs) where
  argBits :: [URIBit]
argBits = String -> URIBit
PathBit (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s)) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol s) => Fletch (AuthProtect s :> xs) where
  argBits :: [URIBit]
argBits = forall route. Fletch route => [URIBit]
argBits @(Header' '[JSON] s Jwt :> xs)
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @(Header' '[JSON] s Jwt :> xs)

instance (FieldTypeName x, ReflectMethod method) => Fletch (Verb method 200 (JSON ': _ms) x) where
  argBits :: [URIBit]
argBits = []
  returnType :: (ByteString, String)
returnType = (Proxy method -> ByteString
forall {k} (a :: k). ReflectMethod a => Proxy a -> ByteString
reflectMethod (Proxy method -> ByteString) -> Proxy method -> ByteString
forall a b. (a -> b) -> a -> b
$ forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @method, FieldSpec -> String
fs_wrapped (FieldSpec -> String) -> FieldSpec -> String
forall a b. (a -> b) -> a -> b
$ Proxy x -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x))

instance (Fletch xs, KnownSymbol doc, FieldTypeName arg) => Fletch (Capture' _ys doc arg :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Capture (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy arg -> FieldSpec) -> Proxy arg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy arg -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy arg -> String) -> Proxy arg -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol doc, FieldTypeName arg) => Fletch (CaptureAll doc arg :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Capture (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy arg -> FieldSpec) -> Proxy arg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy arg -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy arg -> String) -> Proxy arg -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol doc, FieldTypeName arg) => Fletch (QueryParam' _ys doc arg :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Query (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy arg -> FieldSpec) -> Proxy arg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy arg -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy arg -> String) -> Proxy arg -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol doc, FieldTypeName arg) => Fletch (QueryParams doc arg :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Querys (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy [arg] -> FieldSpec) -> Proxy [arg] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [arg] -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy [arg] -> String) -> Proxy [arg] -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[arg]) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol doc) => Fletch (QueryFlag doc :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Query (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy Bool -> FieldSpec) -> Proxy Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Bool -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy Bool -> String) -> Proxy Bool -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Bool) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, KnownSymbol doc, FieldTypeName arg) => Fletch (Header' _ys doc arg :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Header_ (Proxy doc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @doc)) (FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy arg -> FieldSpec) -> Proxy arg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy arg -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy arg -> String) -> Proxy arg -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg) URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, FieldTypeName x) => Fletch (ReqBody' _ys '[JSON] x :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Body (ShowS
encodeJSVar String
name) String
name URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
    where name :: String
name = FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy x -> FieldSpec) -> Proxy x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy x -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy x -> String) -> Proxy x -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

instance (Fletch xs, FieldTypeName x) => Fletch (Fragment x :> xs) where
  argBits :: [URIBit]
argBits = InputMethod -> String -> String -> URIBit
ArgBit InputMethod
Fragment (ShowS
encodeJSVar String
name) String
name URIBit -> [URIBit] -> [URIBit]
forall a. a -> [a] -> [a]
: forall route. Fletch route => [URIBit]
argBits @xs
    where name :: String
name = FieldSpec -> String
fs_wrapped (FieldSpec -> String)
-> (Proxy x -> FieldSpec) -> Proxy x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy x -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy x -> String) -> Proxy x -> String
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x
  returnType :: (ByteString, String)
returnType = forall route. Fletch route => (ByteString, String)
returnType @xs

encodeJSVar :: String -> String
encodeJSVar :: ShowS
encodeJSVar = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
  Char
' ' -> Char
'_'
  Char
'-' -> Char
'_'
  Char
x -> Char
x

uriKey :: forall api. Fletch api => String
uriKey :: forall api. Fletch api => String
uriKey = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
  [ String
"/"
  , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
          PathBit String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
          ArgBit InputMethod
Capture String
doc String
_ -> String -> ShowS
forall a. Monoid a => a -> a -> a
mappend String
":" ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
urlEncode' String
doc
          URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
  , let queries :: [String]
queries = forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
          ArgBit InputMethod
Query String
doc String
_ -> String -> Maybe String
urlEncode' String
doc
          ArgBit InputMethod
Querys String
doc String
_ -> String -> Maybe String
urlEncode' String
doc
          URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
     in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
queries then String
forall a. Monoid a => a
mempty else Char
'?' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" [String]
queries
  , let req :: [String]
req = forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
          ArgBit InputMethod
Body String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
doc
          URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
     in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
req then String
forall a. Monoid a => a
mempty else String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
req String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  , let hs :: [String]
hs = forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
          ArgBit InputMethod
Header_ String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
doc
          URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
    in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
hs then String
forall a. Monoid a => a
mempty else String
"{" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
hs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
  , let frag :: [()]
frag = forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
          ArgBit InputMethod
Fragment String
_ String
_ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
          URIBit
_ -> Maybe ()
forall a. Maybe a
Nothing
     in if [()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [()]
frag then String
forall a. Monoid a => a
mempty else String
"#fragment"
  ]

docs :: forall api. Fletch api => String
docs :: forall api. Fletch api => String
docs = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
      DocBit DocType
Summary' String
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  "
      DocBit DocType
Description' String
d -> String -> Maybe String
forall a. a -> Maybe a
Just [i|/*
   * #{d}
   */
  |]
      URIBit
_ -> Maybe String
forall a. Maybe a
Nothing

urlEncode' :: String -> Maybe String
urlEncode' :: String -> Maybe String
urlEncode' = Either UnicodeException String -> Maybe String
forall a b. Either a b -> Maybe b
hush (Either UnicodeException String -> Maybe String)
-> (String -> Either UnicodeException String)
-> String
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String)
-> Either UnicodeException Text -> Either UnicodeException String
forall a b.
(a -> b) -> Either UnicodeException a -> Either UnicodeException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack (Either UnicodeException Text -> Either UnicodeException String)
-> (String -> Either UnicodeException Text)
-> String
-> Either UnicodeException String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (String -> ByteString) -> String -> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlEncode Bool
True (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

genWebSocket :: forall api. Fletch api => String
genWebSocket :: forall api. Fletch api => String
genWebSocket = [i|#{docs @api}"#{uriKey @api}": (#{functionArgs @api}):
    Promise<{ send : (input: #{wsInput}) => void
            , receive : (cb: (output: #{wsOutput}) => void) => void
            , raw : WebSocket
    }> => {
      const pr = window.location.protocol === "http:" ? "ws:" : "wss:";
      const ws = new WebSocket(`${pr}//${window.location.host}${API.base}#{pathWithCaptureArgs @api}#{queryParams @api}`#{headersWS @api});
      return Promise.resolve({
        send: (input: #{wsInput}) => ws.send(JSON.stringify(input)),
        receive: (cb: ((output: #{wsOutput}) => void)) =>
          ws.onmessage = (message: MessageEvent<string>) => cb(JSON.parse(message.data)),
        raw: ws
      });
  }|]
  where
    wsInput :: String
wsInput = case (URIBit -> Bool) -> [URIBit] -> [URIBit]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
      ArgBit InputMethod
WSInput String
_ String
_ -> Bool
True
      URIBit
_ -> Bool
False) ([URIBit] -> [URIBit]) -> [URIBit] -> [URIBit]
forall a b. (a -> b) -> a -> b
$ forall route. Fletch route => [URIBit]
argBits @api of
      [ArgBit InputMethod
WSInput String
_ String
x] -> String
x
      [URIBit]
x                    -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Bad argits: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [URIBit] -> String
forall a. Show a => a -> String
show [URIBit]
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" This is a hack to transfer the input of the WebSocket to the function here."
    (ByteString
_, String
wsOutput) = forall route. Fletch route => (ByteString, String)
returnType @api

genHTTP :: forall api. Fletch api => String
genHTTP :: forall api. Fletch api => String
genHTTP = [i|#{docs @api}"#{uriKey @api}": async (#{functionArgs @api}): Promise<#{res}> => {
    const uri = `${API.base}#{pathWithCaptureArgs @api}#{queryParams @api}`;
    return fetch(uri, {
      method: "#{method}"#{headers @api}#{reqBody @api}
    }).then(res => res.json());
  }|]
  where (ByteString
method, String
res) = forall route. Fletch route => (ByteString, String)
returnType @api

queryParams :: forall api. Fletch api => String
queryParams :: forall api. Fletch api => String
queryParams = (\String
x -> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then String
x else String
"?" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x) ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
  ArgBit InputMethod
Query String
doc String
_ -> (String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=${" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. IsString a => String -> a
fromString (ShowS
encodeJSVar String
doc) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}") ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
urlEncode' String
doc
  ArgBit InputMethod
Querys String
doc String
_ -> do
    String
doc' <- String -> Maybe String
urlEncode' String
doc
    let var :: String
var = ShowS
encodeJSVar String
doc
    String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
return [i|${#{var}.reduceRight((acc,x) => "#{doc'}=" + x + (acc ? "&" + acc : ""), "")}|]
  URIBit
_ -> Maybe String
forall a. Maybe a
Nothing

pathWithCaptureArgs :: forall api. Fletch api => String
pathWithCaptureArgs :: forall api. Fletch api => String
pathWithCaptureArgs = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend String
"/" ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
  PathBit String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
  ArgBit InputMethod
Capture String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"${" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
encodeJSVar String
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
  URIBit
_ -> Maybe String
forall a. Maybe a
Nothing

headers :: forall api. Fletch api => String
headers :: forall api. Fletch api => String
headers = let
  hs :: String
hs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
",\n        " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
    ArgBit InputMethod
Header_ String
doc String
"string" -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
encodeJSVar String
doc
    ArgBit InputMethod
Header_ String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\": \"\" + " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
encodeJSVar String
doc
    ArgBit InputMethod
Body String
_ String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
"'Content-Type': 'application/json'"
    URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
  in if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
hs then (String
"" :: String) else [i|,
      headers: {
        #{hs}
      }|]

headersWS :: forall api. Fletch api => String
headersWS :: forall api. Fletch api => String
headersWS = let
  hs :: String
hs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
    ArgBit InputMethod
Header_ String
doc String
"string" -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
encodeJSVar String
doc
    ArgBit InputMethod
Header_ String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"\"\" + " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
encodeJSVar String
doc
    URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
  in if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
hs then (String
"" :: String) else [i|, [#{hs}]|]

reqBody :: forall api. Fletch api => String
reqBody :: forall api. Fletch api => String
reqBody = case
  forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
    ArgBit InputMethod
Body String
doc String
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
encodeJSVar String
doc
    URIBit
_ -> Maybe String
forall a. Maybe a
Nothing
  of [String
doc] -> [i|,
      body: JSON.stringify(#{doc})|]
     [String]
_ -> (String
"" :: String)

functionArgs :: forall api. Fletch api => String
functionArgs :: forall api. Fletch api => String
functionArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge @api \case
  ArgBit InputMethod
y String
doc String
x
    -- Fragments are not captured by a servant server, useful with Link
    | InputMethod
y InputMethod -> InputMethod -> Bool
forall a. Eq a => a -> a -> Bool
/= InputMethod
Fragment
    -- WSInput is used to in .send, and not required as initial arguments
    Bool -> Bool -> Bool
&& InputMethod
y InputMethod -> InputMethod -> Bool
forall a. Eq a => a -> a -> Bool
/= InputMethod
WSInput -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
encodeJSVar String
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x
  URIBit
_ -> Maybe String
forall a. Maybe a
Nothing

marge :: forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge :: forall api b. Fletch api => (URIBit -> Maybe b) -> [b]
marge = ((URIBit -> Maybe b) -> [URIBit] -> [b])
-> [URIBit] -> (URIBit -> Maybe b) -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (URIBit -> Maybe b) -> [URIBit] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([URIBit] -> (URIBit -> Maybe b) -> [b])
-> [URIBit] -> (URIBit -> Maybe b) -> [b]
forall a b. (a -> b) -> a -> b
$ forall route. Fletch route => [URIBit]
argBits @api

-- | Obtain the String for the client a la carte without type definitions
gen :: forall (api :: Type).
  ( GenAll api
  ) => String
gen :: forall api. GenAll api => String
gen = [i|const API = {
  base: "",
  #{generations}
};|] where generations :: String
generations = forall api. GenAll api => String
genAll @api

-- | The type class for iterating over the API type
type GenAll :: Type -> Constraint
class GenAll a where
  genAll :: String

-- | Handle left association of routes (IE parens on the left)
instance {-# OVERLAPS #-} (GenAll (route :<|> subrest), GenAll rest) => GenAll ((route :<|> subrest) :<|> rest) where
  genAll :: String
genAll = forall api. GenAll api => String
genAll @(route :<|> subrest) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
",\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall api. GenAll api => String
genAll @rest

-- | Handle right association of routes (IE parens on the left)
instance (Fletch route, GenAll rest) => GenAll (route :<|> rest) where
  genAll :: String
genAll = forall api. GenAll api => String
genAll @route String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
",\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall api. GenAll api => String
genAll @rest

-- | Handle right association of routes (IE parens on the left)
instance {-# OVERLAPPABLE #-} Fletch route => GenAll route where
  genAll :: String
genAll =
    case (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, String) -> ByteString)
-> (ByteString, String) -> ByteString
forall a b. (a -> b) -> a -> b
$ forall route. Fletch route => (ByteString, String)
returnType @route of
      -- POS sentinel value until I think of something better
      ByteString
"connect" -> forall api. Fletch api => String
genWebSocket @route
      ByteString
_         -> forall api. Fletch api => String
genHTTP @route

type TypeDecls :: [Type] -> Constraint
class TypeDecls xs where typeDecls :: [TS.TSType]
instance (TypeDecls xs, TypeScriptDefinition x) => TypeDecls (x ': xs) where
  typeDecls :: [TSType]
typeDecls = forall a. TypeScriptDefinition a => TSType
TS.gen @x TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: forall (xs :: [*]). TypeDecls xs => [TSType]
typeDecls @xs
instance TypeDecls '[] where
  typeDecls :: [TSType]
typeDecls = []

-- | Generate complete TypeScript client for a given api
tsClient :: forall xs api. (TypeDecls xs, GenAll api) => String
tsClient :: forall (xs :: [*]) api. (TypeDecls xs, GenAll api) => String
tsClient = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((TSType -> String) -> [TSType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TSType -> String
TS.printTS ([TSType] -> [String])
-> ([TSType] -> [TSType]) -> [TSType] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TSType] -> [TSType]
forall a. Ord a => [a] -> [a]
sort ([TSType] -> [TSType])
-> ([TSType] -> [TSType]) -> [TSType] -> [TSType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TSType] -> [TSType]
forall a. Ord a => [a] -> [a]
nubOrd ([TSType] -> [String]) -> [TSType] -> [String]
forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]). TypeDecls xs => [TSType]
typeDecls @xs)
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> forall api. GenAll api => String
gen @api

type FromHList :: [Type] -> Constraint
class FromHList hs where
  fromHList :: HList hs -> Map.Map Text Aeson.Value

instance (KnownSymbol s, ToJSON h, FromHList hs) => FromHList (Header' ls s h ': hs) where
  fromHList :: HList (Header' ls s h : hs) -> Map Text Value
fromHList (HCons (Servant.Header x
a) HList xs
xs) = Text -> Value -> Map Text Value
forall k a. k -> a -> Map k a
Map.singleton (String -> Text
pack (String -> Text) -> (Proxy s -> String) -> Proxy s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> Text) -> Proxy s -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s) (x -> Value
forall a. ToJSON a => a -> Value
toJSON x
a) Map Text Value -> Map Text Value -> Map Text Value
forall a. Semigroup a => a -> a -> a
<> HList xs -> Map Text Value
forall (hs :: [*]). FromHList hs => HList hs -> Map Text Value
fromHList HList xs
xs
  fromHList (HCons ResponseHeader h x
MissingHeader HList xs
xs) = HList xs -> Map Text Value
forall (hs :: [*]). FromHList hs => HList hs -> Map Text Value
fromHList HList xs
xs
  fromHList (HCons (UndecodableHeader ByteString
_) HList xs
xs) = HList xs -> Map Text Value
forall (hs :: [*]). FromHList hs => HList hs -> Map Text Value
fromHList HList xs
xs

instance FromHList '[] where
  fromHList :: HList '[] -> Map Text Value
fromHList = HList '[] -> Map Text Value
forall a. Monoid a => a
mempty

instance (Aeson.ToJSON x, FromHList xs) => Aeson.ToJSON (Headers xs x) where
  toJSON :: Headers xs x -> Value
toJSON (Headers x
x HList xs
xs) = [Pair] -> Value
Aeson.object
    [ Key
"content" Key -> x -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= x
x
    , Key
"headers" Key -> Map Text Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= HList xs -> Map Text Value
forall (hs :: [*]). FromHList hs => HList hs -> Map Text Value
fromHList HList xs
xs
    ]

instance (FieldTypeName x, FieldTypeName hs) => FieldTypeName (Headers hs x) where
  fieldTypeName :: Proxy (Headers hs x) -> FieldSpec
fieldTypeName Proxy (Headers hs x)
_ =
    let
      x :: FieldSpec
x = Proxy x -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x)
      hs :: FieldSpec
hs = Proxy hs -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @hs)
      obj :: p -> p -> dst
obj p
x_ p
hs_ = [i|{
  contents: #{x_},
  headers: #{hs_}
}|]
    in FieldType -> String -> String -> FieldSpec
FieldSpec (FieldSpec -> FieldType
fs_type FieldSpec
x FieldType -> FieldType -> FieldType
forall a. Semigroup a => a -> a -> a
<> FieldSpec -> FieldType
fs_type FieldSpec
hs) (FieldSpec -> String
fs_wrapped FieldSpec
x String -> ShowS
forall {dst} {p} {p}.
(Interpolatable (IsCustomSink dst) p dst,
 Interpolatable (IsCustomSink dst) p dst) =>
p -> p -> dst
`obj` FieldSpec -> String
fs_wrapped FieldSpec
hs) (FieldSpec -> String
fs_unwrapped FieldSpec
x String -> ShowS
forall {dst} {p} {p}.
(Interpolatable (IsCustomSink dst) p dst,
 Interpolatable (IsCustomSink dst) p dst) =>
p -> p -> dst
`obj` FieldSpec -> String
fs_unwrapped FieldSpec
hs)

instance FieldTypeName '[] where
  fieldTypeName :: Proxy '[] -> FieldSpec
fieldTypeName Proxy '[]
_ = String -> FieldSpec
concretely String
""

instance (FieldTypeName hs, FieldTypeName x) => FieldTypeName (Header' ts doc x ': hs) where
  fieldTypeName :: Proxy (Header' ts doc x : hs) -> FieldSpec
fieldTypeName Proxy (Header' ts doc x : hs)
_ =
    let xhs :: FieldSpec
xhs = Proxy hs -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy hs -> FieldSpec) -> Proxy hs -> FieldSpec
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @hs
        xfs :: FieldSpec
xfs = Proxy x -> FieldSpec
forall a (a1 :: a). FieldTypeName a1 => Proxy a1 -> FieldSpec
fieldTypeName (Proxy x -> FieldSpec) -> Proxy x -> FieldSpec
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x
        comma :: t a -> t a
comma t a
z = if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
z then t a
"" else t a
",\n" t a -> t a -> t a
forall a. Semigroup a => a -> a -> a
<> t a
z
     in FieldType -> String -> String -> FieldSpec
FieldSpec (FieldSpec -> FieldType
fs_type FieldSpec
xhs FieldType -> FieldType -> FieldType
forall a. Semigroup a => a -> a -> a
<> FieldSpec -> FieldType
fs_type FieldSpec
xfs)
                  (FieldSpec -> String
fs_wrapped FieldSpec
xfs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall {t :: * -> *} {a}.
(Foldable t, IsString (t a), Semigroup (t a)) =>
t a -> t a
comma (FieldSpec -> String
fs_wrapped FieldSpec
xhs))
                  (FieldSpec -> String
fs_unwrapped FieldSpec
xfs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall {t :: * -> *} {a}.
(Foldable t, IsString (t a), Semigroup (t a)) =>
t a -> t a
comma (FieldSpec -> String
fs_unwrapped FieldSpec
xhs))

instance FieldTypeName NoContent where
  fieldTypeName :: Proxy NoContent -> FieldSpec
fieldTypeName Proxy NoContent
_ = String -> FieldSpec
concretely String
"null"

instance FieldTypeName Jwt where
  fieldTypeName :: Proxy Jwt -> FieldSpec
fieldTypeName Proxy Jwt
_ = String -> FieldSpec
concretely String
"string"