{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Servant.Hateoas.RelationLink
(
  -- * RelationLink
  -- ** Type
  RelationLink(..),
  RelationParam(..),

  -- *** Creation
  fromURI,

  -- *** Operations
  mkPlaceHolder,
  appendPath,

  -- ** Class
  HasRelationLink(..),

  -- * Utility
  -- ** ReflectStdMethod
  reflectStdMethod,
)
where

import Prelude hiding (dropWhile, break)
import Servant
import Servant.API.ContentTypes (AllMime(..))
import Servant.API.Modifiers (FoldRequired)
import Network.URI (unEscapeString)
import Network.HTTP.Media (MediaType)
import Network.HTTP.Types (parseMethod, Method)
import Data.String (fromString)
import Data.Aeson
import Data.Text (Text, intercalate, dropWhile, split, break)
import Data.Singletons.Bool
import GHC.TypeLits

-- | Link data-type for hypermedia-links in HATEOAS with potentially templated URIs.
data RelationLink = RelationLink
  { RelationLink -> Text
_path         :: Text
  , RelationLink -> [RelationParam]
_params       :: [RelationParam]
  , RelationLink -> Bool
_templated    :: Bool
  , RelationLink -> StdMethod
_method       :: StdMethod
  , RelationLink -> [MediaType]
_contentTypes :: [MediaType]
  , RelationLink -> Maybe Text
_summary      :: Maybe Text
  , RelationLink -> Maybe Text
_description  :: Maybe Text
  } deriving (Int -> RelationLink -> ShowS
[RelationLink] -> ShowS
RelationLink -> [Char]
(Int -> RelationLink -> ShowS)
-> (RelationLink -> [Char])
-> ([RelationLink] -> ShowS)
-> Show RelationLink
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationLink -> ShowS
showsPrec :: Int -> RelationLink -> ShowS
$cshow :: RelationLink -> [Char]
show :: RelationLink -> [Char]
$cshowList :: [RelationLink] -> ShowS
showList :: [RelationLink] -> ShowS
Show, RelationLink -> RelationLink -> Bool
(RelationLink -> RelationLink -> Bool)
-> (RelationLink -> RelationLink -> Bool) -> Eq RelationLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationLink -> RelationLink -> Bool
== :: RelationLink -> RelationLink -> Bool
$c/= :: RelationLink -> RelationLink -> Bool
/= :: RelationLink -> RelationLink -> Bool
Eq)

-- | Parameter data-type for hypermedia-links in HATEOAS.
data RelationParam = RelationParam
  { RelationParam -> Text
_name        :: Text
  , RelationParam -> Bool
_required    :: Bool
  } deriving (Int -> RelationParam -> ShowS
[RelationParam] -> ShowS
RelationParam -> [Char]
(Int -> RelationParam -> ShowS)
-> (RelationParam -> [Char])
-> ([RelationParam] -> ShowS)
-> Show RelationParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationParam -> ShowS
showsPrec :: Int -> RelationParam -> ShowS
$cshow :: RelationParam -> [Char]
show :: RelationParam -> [Char]
$cshowList :: [RelationParam] -> ShowS
showList :: [RelationParam] -> ShowS
Show, RelationParam -> RelationParam -> Bool
(RelationParam -> RelationParam -> Bool)
-> (RelationParam -> RelationParam -> Bool) -> Eq RelationParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationParam -> RelationParam -> Bool
== :: RelationParam -> RelationParam -> Bool
$c/= :: RelationParam -> RelationParam -> Bool
/= :: RelationParam -> RelationParam -> Bool
Eq)

-- | Create a placeholder for a URI template parameter.
mkPlaceHolder :: Text -> Text
mkPlaceHolder :: Text -> Text
mkPlaceHolder Text
s = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- | Append a path to a URI.
appendPath :: Text -> Text -> Text
appendPath :: Text -> Text -> Text
appendPath Text
l Text
"" = Text
l
appendPath Text
l Text
r = Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r

-- | Creates a 'RelationLink' from an 'URI'.
fromURI :: [MediaType] -> StdMethod -> URI -> RelationLink
fromURI :: [MediaType] -> StdMethod -> URI -> RelationLink
fromURI [MediaType]
cts StdMethod
m (URI [Char]
_ Maybe URIAuth
_ [Char]
path [Char]
query [Char]
_) = RelationLink
  { _path :: Text
_path = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
path
  , _params :: [RelationParam]
_params = [RelationParam]
params
  , _templated :: Bool
_templated = Bool
False
  , _method :: StdMethod
_method = StdMethod
m
  , _contentTypes :: [MediaType]
_contentTypes = [MediaType]
cts
  , _summary :: Maybe Text
_summary = Maybe Text
forall a. Maybe a
Nothing
  , _description :: Maybe Text
_description = Maybe Text
forall a. Maybe a
Nothing
  }
  where
    params :: [RelationParam]
params = (RelationParam -> Bool) -> [RelationParam] -> [RelationParam]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") (Text -> Bool) -> (RelationParam -> Text) -> RelationParam -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationParam -> Text
_name)
      ([RelationParam] -> [RelationParam])
-> [RelationParam] -> [RelationParam]
forall a b. (a -> b) -> a -> b
$ (Text -> RelationParam) -> [Text] -> [RelationParam]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
kv -> Text -> Bool -> RelationParam
RelationParam ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
kv) Bool
False)
      ([Text] -> [RelationParam]) -> [Text] -> [RelationParam]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&')
      (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?')
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString
      ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString [Char]
query

-- | Like 'reflectMethod' but returns a 'StdMethod'.
reflectStdMethod :: ReflectMethod method => Proxy method -> StdMethod
reflectStdMethod :: forall {k} (method :: k).
ReflectMethod method =>
Proxy method -> StdMethod
reflectStdMethod = ByteString -> StdMethod
unsafeMethodToStdMethod (ByteString -> StdMethod)
-> (Proxy method -> ByteString) -> Proxy method -> StdMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy method -> ByteString
forall {k} (a :: k). ReflectMethod a => Proxy a -> ByteString
reflectMethod

unsafeMethodToStdMethod :: Method -> StdMethod
unsafeMethodToStdMethod :: ByteString -> StdMethod
unsafeMethodToStdMethod (ByteString -> Either ByteString StdMethod
parseMethod -> Right StdMethod
m) = StdMethod
m
unsafeMethodToStdMethod (ByteString -> Either ByteString StdMethod
parseMethod -> Left  ByteString
m) = [Char] -> StdMethod
forall a. HasCallStack => [Char] -> a
error ([Char] -> StdMethod) -> [Char] -> StdMethod
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot convert " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
m [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" to StdMethod"

instance ToJSON RelationLink where
  toJSON :: RelationLink -> Value
toJSON (RelationLink Text
path [RelationParam]
params Bool
templated StdMethod
_ [MediaType]
_ Maybe Text
_ Maybe Text
_) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
    if Bool -> Bool
not ([RelationParam] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelationParam]
params) Bool -> Bool -> Bool
&& Bool
templated
    then Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (RelationParam -> Text
_name (RelationParam -> Text) -> [RelationParam] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RelationParam]
params) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
    else Text
path

-- | Class for creating a 'RelationLink' to an API.
class HasRelationLink endpoint where
  toRelationLink :: Proxy endpoint -> RelationLink

instance HasRelationLink b => HasRelationLink (EmptyAPI :> b) where
  toRelationLink :: Proxy (EmptyAPI :> b) -> RelationLink
toRelationLink Proxy (EmptyAPI :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (KnownSymbol sym, HasRelationLink b) => HasRelationLink ((sym :: Symbol) :> b) where
  toRelationLink :: Proxy (sym :> b) -> RelationLink
toRelationLink Proxy (sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _path = prefix `appendPath` _path rl }
    where
      prefix :: Text
prefix = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)

instance (KnownSymbol sym, HasRelationLink b) => HasRelationLink (Capture' mods sym a :> b) where
  toRelationLink :: Proxy (Capture' mods sym a :> b) -> RelationLink
toRelationLink Proxy (Capture' mods sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _path = prefix `appendPath` _path rl, _templated = True }
    where
      prefix :: Text
prefix = Text -> Text
mkPlaceHolder (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)

instance (KnownSymbol sym, HasRelationLink b) => HasRelationLink (CaptureAll sym a :> b) where
  toRelationLink :: Proxy (CaptureAll sym a :> b) -> RelationLink
toRelationLink Proxy (CaptureAll sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _path = prefix `appendPath` _path rl, _templated = True }
    where
      prefix :: Text
prefix = Text -> Text
mkPlaceHolder (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)

instance HasRelationLink b => HasRelationLink (Header' mods sym a :> b) where
  toRelationLink :: Proxy (Header' mods sym a :> b) -> RelationLink
toRelationLink Proxy (Header' mods sym a :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (HttpVersion :> b) where
  toRelationLink :: Proxy (HttpVersion :> b) -> RelationLink
toRelationLink Proxy (HttpVersion :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (HasRelationLink b, KnownSymbol sym, SBoolI (FoldRequired mods)) => HasRelationLink (QueryParam' mods sym a :> b) where
  toRelationLink :: Proxy (QueryParam' mods sym a :> b) -> RelationLink
toRelationLink Proxy (QueryParam' mods sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _params = param : _params rl, _templated = True }
    where
      param :: RelationParam
param = RelationParam
        { _name :: Text
_name = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)
        , _required :: Bool
_required = SBool (FoldRequired mods) -> Bool
forall (b :: Bool). SBool b -> Bool
fromSBool (SBool (FoldRequired mods) -> Bool)
-> SBool (FoldRequired mods) -> Bool
forall a b. (a -> b) -> a -> b
$ forall (b :: Bool). SBoolI b => SBool b
sbool @(FoldRequired mods)
        }

instance (HasRelationLink b, KnownSymbol sym) => HasRelationLink (QueryParams sym a :> b) where
  toRelationLink :: Proxy (QueryParams sym a :> b) -> RelationLink
toRelationLink Proxy (QueryParams sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _params = param : _params rl, _templated = True }
    where
      param :: RelationParam
param = RelationParam
        { _name :: Text
_name = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)
        , _required :: Bool
_required = Bool
False
        }

instance (HasRelationLink b, KnownSymbol sym) => HasRelationLink (QueryFlag sym :> b) where
  toRelationLink :: Proxy (QueryFlag sym :> b) -> RelationLink
toRelationLink Proxy (QueryFlag sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _params = param : _params rl, _templated = True }
    where
      param :: RelationParam
param = RelationParam
        { _name :: Text
_name = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)
        , _required :: Bool
_required = Bool
False
        }

instance HasRelationLink b => HasRelationLink (QueryString :> b) where
  toRelationLink :: Proxy (QueryString :> b) -> RelationLink
toRelationLink Proxy (QueryString :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (HasRelationLink b, KnownSymbol sym) => HasRelationLink (DeepQuery sym a :> b) where
  toRelationLink :: Proxy (DeepQuery sym a :> b) -> RelationLink
toRelationLink Proxy (DeepQuery sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _params = param : _params rl, _templated = True }
    where
      param :: RelationParam
param = RelationParam
        { _name :: Text
_name = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)
        , _required :: Bool
_required = Bool
False
        }

instance HasRelationLink b => HasRelationLink (Fragment a :> b) where
  toRelationLink :: Proxy (Fragment a :> b) -> RelationLink
toRelationLink Proxy (Fragment a :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (ReqBody' mods cts a :> b) where
  toRelationLink :: Proxy (ReqBody' mods cts a :> b) -> RelationLink
toRelationLink Proxy (ReqBody' mods cts a :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (RemoteHost :> b) where
  toRelationLink :: Proxy (RemoteHost :> b) -> RelationLink
toRelationLink Proxy (RemoteHost :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (IsSecure :> b) where
  toRelationLink :: Proxy (IsSecure :> b) -> RelationLink
toRelationLink Proxy (IsSecure :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (Vault :> b) where
  toRelationLink :: Proxy (Vault :> b) -> RelationLink
toRelationLink Proxy (Vault :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (WithNamedContext name subs sub :> b) where
  toRelationLink :: Proxy (WithNamedContext name subs sub :> b) -> RelationLink
toRelationLink Proxy (WithNamedContext name subs sub :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (WithResource res :> b) where
  toRelationLink :: Proxy (WithResource res :> b) -> RelationLink
toRelationLink Proxy (WithResource res :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (ReflectMethod m, AllMime cts) => HasRelationLink (Verb m s cts a) where
  toRelationLink :: Proxy (Verb m s cts a) -> RelationLink
toRelationLink Proxy (Verb m s cts a)
_ = RelationLink
    { _path :: Text
_path = Text
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _templated :: Bool
_templated = Bool
False
    , _method :: StdMethod
_method = Proxy m -> StdMethod
forall {k} (method :: k).
ReflectMethod method =>
Proxy method -> StdMethod
reflectStdMethod (forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
    , _summary :: Maybe Text
_summary = Maybe Text
forall a. Maybe a
Nothing
    , _description :: Maybe Text
_description = Maybe Text
forall a. Maybe a
Nothing
    , _contentTypes :: [MediaType]
_contentTypes = Proxy cts -> [MediaType]
forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @cts)
    }

instance ReflectMethod m => HasRelationLink (NoContentVerb m) where
  toRelationLink :: Proxy (NoContentVerb m) -> RelationLink
toRelationLink Proxy (NoContentVerb m)
_ = RelationLink
    { _path :: Text
_path = Text
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _templated :: Bool
_templated = Bool
False
    , _method :: StdMethod
_method = Proxy m -> StdMethod
forall {k} (method :: k).
ReflectMethod method =>
Proxy method -> StdMethod
reflectStdMethod (forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
    , _summary :: Maybe Text
_summary = Maybe Text
forall a. Maybe a
Nothing
    , _description :: Maybe Text
_description = Maybe Text
forall a. Maybe a
Nothing
    , _contentTypes :: [MediaType]
_contentTypes = [MediaType]
forall a. Monoid a => a
mempty
    }

instance (ReflectMethod m, AllMime cts) => HasRelationLink (UVerb m cts as) where
  toRelationLink :: Proxy (UVerb m cts as) -> RelationLink
toRelationLink Proxy (UVerb m cts as)
_ = RelationLink
    { _path :: Text
_path = Text
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _templated :: Bool
_templated = Bool
False
    , _method :: StdMethod
_method = Proxy m -> StdMethod
forall {k} (method :: k).
ReflectMethod method =>
Proxy method -> StdMethod
reflectStdMethod (forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @m)
    , _summary :: Maybe Text
_summary = Maybe Text
forall a. Maybe a
Nothing
    , _description :: Maybe Text
_description = Maybe Text
forall a. Maybe a
Nothing
    , _contentTypes :: [MediaType]
_contentTypes = Proxy cts -> [MediaType]
forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @cts)
    }

instance (ReflectMethod m, Accept ct) => HasRelationLink (Stream m s f ct a) where
  toRelationLink :: Proxy (Stream m s f ct a) -> RelationLink
toRelationLink Proxy (Stream m s f ct a)
_ = RelationLink
    { _path :: Text
_path = Text
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _templated :: Bool
_templated = Bool
False
    , _method :: StdMethod
_method = Proxy m -> StdMethod
forall {k} (method :: k).
ReflectMethod method =>
Proxy method -> StdMethod
reflectStdMethod (forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
    , _summary :: Maybe Text
_summary = Maybe Text
forall a. Maybe a
Nothing
    , _description :: Maybe Text
_description = Maybe Text
forall a. Maybe a
Nothing
    , _contentTypes :: [MediaType]
_contentTypes = MediaType -> [MediaType]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MediaType -> [MediaType]) -> MediaType -> [MediaType]
forall a b. (a -> b) -> a -> b
$ Proxy ct -> MediaType
forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ct)
    }

instance HasRelationLink b => HasRelationLink (BasicAuth realm userData :> b) where
  toRelationLink :: Proxy (BasicAuth realm userData :> b) -> RelationLink
toRelationLink Proxy (BasicAuth realm userData :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (KnownSymbol sym, HasRelationLink b) => HasRelationLink (Description sym :> b) where
  toRelationLink :: Proxy (Description sym :> b) -> RelationLink
toRelationLink Proxy (Description sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _description = Just descr }
    where
      descr :: Text
descr = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)

instance (KnownSymbol sym, HasRelationLink b) => HasRelationLink (Summary sym :> b) where
  toRelationLink :: Proxy (Summary sym :> b) -> RelationLink
toRelationLink Proxy (Summary sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _summary = Just summary }
    where
      summary :: Text
summary = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym)