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

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

  -- *** Creation
  fromLink,
  fromURI,

  -- *** Operations
  (<<<),
  getHref,
  getPath,
  getParams,
  prependSeg,
  prependSegs,
  addParam,
  addParams,
  mkPlaceHolder,

  -- ** Class
  HasTemplatedLink(..),
  HasRelationLink(..),
  RightLink,

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

import Prelude hiding (drop, dropWhile, break)
import Servant
import Servant.API.ContentTypes (AllMime(..))
import Servant.API.Modifiers (FoldRequired)
import Servant.Hateoas.Internal.Polyvariadic
import Network.URI (unEscapeString, pathSegments)
import Network.HTTP.Media (MediaType)
import Network.HTTP.Types (parseMethod, Method)
import Data.Foldable (foldl')
import Data.Maybe
import Data.String (fromString)
import Data.Aeson
import Data.Text (Text, intercalate, dropWhile, split, break, drop, isPrefixOf, isSuffixOf)
import Data.Singletons.Bool
import Control.Applicative ((<|>))
import GHC.TypeLits

-- | Link data-type for hypermedia-links in HATEOAS with potentially templated URIs.
data RelationLink = RelationLink
  { RelationLink -> [Text]
_segs         :: [Text]
  , RelationLink -> [RelationParam]
_params       :: [RelationParam]
  , RelationLink -> Maybe Text
_fragment     :: Maybe Text
  , RelationLink -> Bool
_templated    :: Bool
  , RelationLink -> StdMethod
_method       :: StdMethod
  , RelationLink -> [MediaType]
_contentTypes :: [MediaType]
  , RelationLink -> Maybe Text
_summary      :: Maybe Text
  , RelationLink -> Maybe Text
_description  :: Maybe Text
  , RelationLink -> Maybe Text
_title        :: 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
  , RelationParam -> Maybe Text
_value       :: Maybe Text
  } 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)

-- | Shifting append-operator for 'RelationLink'.
--
-- This operator can be seen as a monoidal append for 'RelationLink' with a right-bias for meta information
-- e.g. '_method', '_contentTypes', '_summary' and '_description'.
(<<<) :: RelationLink -> RelationLink -> RelationLink
RelationLink
l1 <<< :: RelationLink -> RelationLink -> RelationLink
<<< RelationLink
l2 =
  RelationLink
l1 { _segs         = _segs         l1  <> _segs        l2
     , _params       = _params       l1  <> _params      l2
     , _fragment     = _fragment     l1 <|> _fragment    l2
     , _templated    = _templated    l1  || _templated   l2
     , _method       = _method       l2
     , _contentTypes = _contentTypes l2
     , _summary      = _summary      l2 <|> _summary     l1
     , _description  = _description  l2 <|> _description l1
     }

-- | Get the hypermedia-reference of a 'RelationLink'.
getHref :: RelationLink -> Text
getHref :: RelationLink -> Text
getHref RelationLink
l = RelationLink -> Text
getPath RelationLink
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelationLink -> Text
getParams RelationLink
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
f -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f) (RelationLink -> Maybe Text
_fragment RelationLink
l)

-- | Get the path of a 'RelationLink' as in 'getHref'.
getPath :: RelationLink -> Text
getPath :: RelationLink -> Text
getPath = (Text
"/" <>) (Text -> Text) -> (RelationLink -> Text) -> RelationLink -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> [Text] -> Text
intercalate Text
"/" ([Text] -> Text)
-> (RelationLink -> [Text]) -> RelationLink -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationLink -> [Text]
_segs

-- | Get the parameters of a 'RelationLink' as in 'getHref'.
getParams :: RelationLink -> Text
getParams :: RelationLink -> Text
getParams RelationLink
link =
     (if [(Text, Text)]
filledParams [(Text, Text)] -> [(Text, Text)] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then Text
"" else Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"&" (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
k,Text
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v) [(Text, Text)]
filledParams))
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [Text]
templatedParams [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then Text
"" else Text
"{?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," [Text]
templatedParams Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")
  where
    ([(Text, Text)]
filledParams, [Text]
templatedParams) =
      (([(Text, Text)], [Text])
 -> RelationParam -> ([(Text, Text)], [Text]))
-> ([(Text, Text)], [Text])
-> [RelationParam]
-> ([(Text, Text)], [Text])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        (\([(Text, Text)]
fs, [Text]
ts) RelationParam
l -> case RelationParam -> Maybe Text
_value RelationParam
l of Maybe Text
Nothing -> ([(Text, Text)]
fs, RelationParam -> Text
_name RelationParam
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts) ; Just Text
v -> ((RelationParam -> Text
_name RelationParam
l, Text
v) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
fs, [Text]
ts))
        ([], []) ([RelationParam] -> ([(Text, Text)], [Text]))
-> [RelationParam] -> ([(Text, Text)], [Text])
forall a b. (a -> b) -> a -> b
$
        RelationLink -> [RelationParam]
_params RelationLink
link

-- | Prepend a path segment to a 'RelationLink'.
--
-- Takes care of potential templating.
prependSeg :: Text -> RelationLink -> RelationLink
prependSeg :: Text -> RelationLink -> RelationLink
prependSeg Text
seg RelationLink
l
  | Text
"{" Text -> Text -> Bool
`isPrefixOf` Text
seg Bool -> Bool -> Bool
&& Text
"}" Text -> Text -> Bool
`isSuffixOf` Text
seg = RelationLink
l { _segs = seg : _segs l, _templated = True }
  | Bool
otherwise = RelationLink
l { _segs = seg : _segs l }

-- | Prepend path segments to a 'RelationLink'.
--
-- Takes care of potential templating.
prependSegs :: [Text] -> RelationLink -> RelationLink
prependSegs :: [Text] -> RelationLink -> RelationLink
prependSegs [Text]
segs RelationLink
l
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
seg -> Text
"{" Text -> Text -> Bool
`isPrefixOf` Text
seg Bool -> Bool -> Bool
&& Text
"}" Text -> Text -> Bool
`isSuffixOf` Text
seg) [Text]
segs = RelationLink
l { _segs = segs <> _segs l, _templated = True }
  | Bool
otherwise                                                       = RelationLink
l { _segs = segs <> _segs l }

-- | Add a parameter to a 'RelationLink'.
--
-- Takes care of potential templating.
addParam :: RelationParam -> RelationLink -> RelationLink
addParam :: RelationParam -> RelationLink -> RelationLink
addParam RelationParam
p RelationLink
l = RelationLink
l { _params = p : _params l, _templated = _templated l || isNothing (_value p) }

-- | Add parameters to a 'RelationLink'.
--
-- Takes care of potential templating.
addParams :: [RelationParam] -> RelationLink -> RelationLink
addParams :: [RelationParam] -> RelationLink -> RelationLink
addParams [RelationParam]
ps RelationLink
l = RelationLink
l { _params = ps <> _params l, _templated = _templated l || any (isNothing . _value) ps }

-- | Create a placeholder for a template path segment.
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
"}"

-- | Creates a 'RelationLink' from a 'Link'.
fromLink :: [MediaType] -> StdMethod -> Link -> RelationLink
fromLink :: [MediaType] -> StdMethod -> Link -> RelationLink
fromLink [MediaType]
cts StdMethod
m = [MediaType] -> StdMethod -> URI -> RelationLink
fromURI [MediaType]
cts StdMethod
m (URI -> RelationLink) -> (Link -> URI) -> Link -> RelationLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> URI
linkURI

-- | Creates a 'RelationLink' from an 'URI'.
fromURI :: [MediaType] -> StdMethod -> URI -> RelationLink
fromURI :: [MediaType] -> StdMethod -> URI -> RelationLink
fromURI [MediaType]
cts StdMethod
m uri :: URI
uri@(URI [Char]
_ Maybe URIAuth
_ [Char]
_ [Char]
query [Char]
frag) = RelationLink
  { _segs :: [Text]
_segs = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [[Char]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> [[Char]]
pathSegments URI
uri
  , _params :: [RelationParam]
_params = [RelationParam]
params
  , _fragment :: Maybe Text
_fragment = if [Char]
frag [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
frag)
  , _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
  , _title :: Maybe Text
_title = 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 -> let (Text
k, Int -> Text -> Text
drop Int
1 -> Text
v) = (Char -> Bool) -> Text -> (Text, Text)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
kv in Text -> Bool -> Maybe Text -> RelationParam
RelationParam Text
k Bool
False (Maybe Text -> RelationParam) -> Maybe Text -> RelationParam
forall a b. (a -> b) -> a -> b
$ if Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)
      ([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 = Text -> Value
String (Text -> Value) -> (RelationLink -> Text) -> RelationLink -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationLink -> Text
getHref

-- | Class for creating a templated 'RelationLink' to an endpoint.
class HasTemplatedLink endpoint where
  toTemplatedLink :: Proxy endpoint -> RelationLink

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

instance (KnownSymbol sym, HasTemplatedLink b) => HasTemplatedLink ((sym :: Symbol) :> b) where
  toTemplatedLink :: Proxy (sym :> b) -> RelationLink
toTemplatedLink Proxy (sym :> b)
_ = Text -> RelationLink -> RelationLink
prependSeg Text
prefix (RelationLink -> RelationLink) -> RelationLink -> RelationLink
forall a b. (a -> b) -> a -> b
$ Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    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, HasTemplatedLink b) => HasTemplatedLink (Capture' mods sym a :> b) where
  toTemplatedLink :: Proxy (Capture' mods sym a :> b) -> RelationLink
toTemplatedLink Proxy (Capture' mods sym a :> b)
_ = Text -> RelationLink -> RelationLink
prependSeg Text
prefix (RelationLink -> RelationLink) -> RelationLink -> RelationLink
forall a b. (a -> b) -> a -> b
$ Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    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, HasTemplatedLink b) => HasTemplatedLink (CaptureAll sym a :> b) where
  toTemplatedLink :: Proxy (CaptureAll sym a :> b) -> RelationLink
toTemplatedLink Proxy (CaptureAll sym a :> b)
_ = Text -> RelationLink -> RelationLink
prependSeg Text
prefix (RelationLink -> RelationLink) -> RelationLink -> RelationLink
forall a b. (a -> b) -> a -> b
$ Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    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 HasTemplatedLink b => HasTemplatedLink (Header' mods sym a :> b) where
  toTemplatedLink :: Proxy (Header' mods sym a :> b) -> RelationLink
toTemplatedLink Proxy (Header' mods sym a :> b)
_ = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

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

instance (HasTemplatedLink b, KnownSymbol sym, SBoolI (FoldRequired mods)) => HasTemplatedLink (QueryParam' mods sym a :> b) where
  toTemplatedLink :: Proxy (QueryParam' mods sym a :> b) -> RelationLink
toTemplatedLink Proxy (QueryParam' mods sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (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)
        , _value :: Maybe Text
_value = Maybe Text
forall a. Maybe a
Nothing
        }

instance (HasTemplatedLink b, KnownSymbol sym) => HasTemplatedLink (QueryParams sym a :> b) where
  toTemplatedLink :: Proxy (QueryParams sym a :> b) -> RelationLink
toTemplatedLink Proxy (QueryParams sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (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
        , _value :: Maybe Text
_value = Maybe Text
forall a. Maybe a
Nothing
        }

instance (HasTemplatedLink b, KnownSymbol sym) => HasTemplatedLink (QueryFlag sym :> b) where
  toTemplatedLink :: Proxy (QueryFlag sym :> b) -> RelationLink
toTemplatedLink Proxy (QueryFlag sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (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
        , _value :: Maybe Text
_value = Maybe Text
forall a. Maybe a
Nothing
        }

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

instance (HasTemplatedLink b, KnownSymbol sym) => HasTemplatedLink (DeepQuery sym a :> b) where
  toTemplatedLink :: Proxy (DeepQuery sym a :> b) -> RelationLink
toTemplatedLink Proxy (DeepQuery sym a :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (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
        , _value :: Maybe Text
_value = Maybe Text
forall a. Maybe a
Nothing
        }

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

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

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

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

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

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

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

instance (ReflectMethod m, AllMime cts) => HasTemplatedLink (Verb m s cts a) where
  toTemplatedLink :: Proxy (Verb m s cts a) -> RelationLink
toTemplatedLink Proxy (Verb m s cts a)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance ReflectMethod m => HasTemplatedLink (NoContentVerb m) where
  toTemplatedLink :: Proxy (NoContentVerb m) -> RelationLink
toTemplatedLink Proxy (NoContentVerb m)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _contentTypes :: [MediaType]
_contentTypes = [MediaType]
forall a. Monoid a => a
mempty
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance (ReflectMethod m, AllMime cts) => HasTemplatedLink (UVerb m cts as) where
  toTemplatedLink :: Proxy (UVerb m cts as) -> RelationLink
toTemplatedLink Proxy (UVerb m cts as)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance (ReflectMethod m, Accept ct) => HasTemplatedLink (Stream m s f ct a) where
  toTemplatedLink :: Proxy (Stream m s f ct a) -> RelationLink
toTemplatedLink Proxy (Stream m s f ct a)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

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

instance (KnownSymbol sym, HasTemplatedLink b) => HasTemplatedLink (Description sym :> b) where
  toTemplatedLink :: Proxy (Description sym :> b) -> RelationLink
toTemplatedLink Proxy (Description sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _description = _description rl <|> 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, HasTemplatedLink b) => HasTemplatedLink (Summary sym :> b) where
  toTemplatedLink :: Proxy (Summary sym :> b) -> RelationLink
toTemplatedLink Proxy (Summary sym :> b)
_ = let rl :: RelationLink
rl = Proxy b -> RelationLink
forall {k} (endpoint :: k).
HasTemplatedLink endpoint =>
Proxy endpoint -> RelationLink
toTemplatedLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) in RelationLink
rl { _summary = _summary rl <|> 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)

-- | Class for creating a 'RelationLink' to an endpoint.
--
-- This is highly similar to 'HasLink' but it also gathers HATEOAS meta-information for the resource a link refers to.
class HasLink endpoint => HasRelationLink endpoint where
  toRelationLink :: Proxy endpoint -> MkLink endpoint RelationLink

-- | Convenience alias-constraint for right-hand sides of @a ':>' b@ where b is some function producing a 'RelationLink'.
type RightLink b =
  ( HasRelationLink b
  , PolyvariadicComp (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
  , Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink)) ~ RelationLink
  , Replace (MkLink b RelationLink) RelationLink (IsFun (MkLink b RelationLink)) ~ MkLink b RelationLink
  )

instance (AllMime cts, ReflectMethod m) => HasRelationLink (Verb m s cts a) where
  toRelationLink :: Proxy (Verb m s cts a) -> MkLink (Verb m s cts a) RelationLink
toRelationLink Proxy (Verb m s cts a)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance (AllMime cts, ReflectMethod m) => HasRelationLink (UVerb m cts as) where
  toRelationLink :: Proxy (UVerb m cts as) -> MkLink (UVerb m cts as) RelationLink
toRelationLink Proxy (UVerb m cts as)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance ReflectMethod m => HasRelationLink (NoContentVerb m) where
  toRelationLink :: Proxy (NoContentVerb m) -> MkLink (NoContentVerb m) RelationLink
toRelationLink Proxy (NoContentVerb m)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _contentTypes :: [MediaType]
_contentTypes = [MediaType]
forall a. Monoid a => a
mempty
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance (ReflectMethod m, Accept ct) => HasRelationLink (Stream m s f ct a) where
  toRelationLink :: Proxy (Stream m s f ct a)
-> MkLink (Stream m s f ct a) RelationLink
toRelationLink Proxy (Stream m s f ct a)
_ = RelationLink
    { _segs :: [Text]
_segs = [Text]
forall a. Monoid a => a
mempty
    , _params :: [RelationParam]
_params = []
    , _fragment :: Maybe Text
_fragment = Maybe Text
forall a. Maybe a
Nothing
    , _templated :: Bool
_templated = Bool
False
    , _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)
    , _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
    , _title :: Maybe Text
_title = Maybe Text
forall a. Maybe a
Nothing
    }

instance (KnownSymbol sym, RightLink b) => HasRelationLink ((sym :: Symbol) :> b) where
  toRelationLink :: Proxy (sym :> b) -> MkLink (sym :> b) RelationLink
toRelationLink Proxy (sym :> b)
_ = Text -> RelationLink -> RelationLink
prependSeg Text
seg (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    where
      seg :: Text
seg = [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, RightLink b) => HasRelationLink (Summary sym :> b) where
  toRelationLink :: Proxy (Summary sym :> b) -> MkLink (Summary sym :> b) RelationLink
toRelationLink Proxy (Summary sym :> b)
_ = (\Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
rl -> Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
rl { _summary = _summary rl <|> Just summary }) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    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)

instance (KnownSymbol sym, RightLink b) => HasRelationLink (Description sym :> b) where
  toRelationLink :: Proxy (Description sym :> b)
-> MkLink (Description sym :> b) RelationLink
toRelationLink Proxy (Description sym :> b)
_ = (\Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
rl -> Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
rl { _description = _description rl <|> Just descr }) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    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 HasRelationLink b => HasRelationLink (HttpVersion :> b) where
  toRelationLink :: Proxy (HttpVersion :> b) -> MkLink (HttpVersion :> b) RelationLink
toRelationLink Proxy (HttpVersion :> b)
_ = Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

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

instance (KnownSymbol sym, RightLink b, ToHttpApiData a) => HasRelationLink (Capture' mods sym a :> b) where
  toRelationLink :: Proxy (Capture' mods sym a :> b)
-> MkLink (Capture' mods sym a :> b) RelationLink
toRelationLink Proxy (Capture' mods sym a :> b)
_ a
x = Text -> RelationLink -> RelationLink
prependSeg (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
x) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (KnownSymbol sym, RightLink b, ToHttpApiData a) => HasRelationLink (CaptureAll sym a :> b) where
  toRelationLink :: Proxy (CaptureAll sym a :> b)
-> MkLink (CaptureAll sym a :> b) RelationLink
toRelationLink Proxy (CaptureAll sym a :> b)
_ [a]
xs = [Text] -> RelationLink -> RelationLink
prependSegs (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (RightLink b, ToHttpApiData a) => HasRelationLink (Fragment a :> b) where
  toRelationLink :: Proxy (Fragment a :> b) -> MkLink (Fragment a :> b) RelationLink
toRelationLink Proxy (Fragment a :> b)
_ a
x = (\Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
l -> Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
l { _fragment = Just $ toQueryParam x }) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance HasRelationLink b => HasRelationLink (Header' mods sym a :> b) where
  toRelationLink :: Proxy (Header' mods sym a :> b)
-> MkLink (Header' mods sym a :> b) RelationLink
toRelationLink Proxy (Header' mods sym a :> b)
_ = Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink 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) -> MkLink (IsSecure :> b) RelationLink
toRelationLink Proxy (IsSecure :> b)
_ = Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (KnownSymbol sym, RightLink b) => HasRelationLink (QueryFlag sym :> b) where
  toRelationLink :: Proxy (QueryFlag sym :> b)
-> MkLink (QueryFlag sym :> b) RelationLink
toRelationLink Proxy (QueryFlag sym :> b)
_ Bool
False = RelationParam -> RelationLink -> RelationLink
addParam (Text -> Bool -> Maybe Text -> RelationParam
RelationParam ([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 (Proxy sym -> [Char]) -> Proxy sym -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym) Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"false")) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
  toRelationLink Proxy (QueryFlag sym :> b)
_ Bool
True  = RelationParam -> RelationLink -> RelationLink
addParam (Text -> Bool -> Maybe Text -> RelationParam
RelationParam ([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 (Proxy sym -> [Char]) -> Proxy sym -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym) Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"true")) (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

instance (KnownSymbol sym, ToHttpApiData a, RightLink b, SBoolI (FoldRequired mods)) => HasRelationLink (QueryParam' mods sym a :> b) where
  toRelationLink :: Proxy (QueryParam' mods sym a :> b)
-> MkLink (QueryParam' mods sym a :> b) RelationLink
toRelationLink Proxy (QueryParam' mods sym a :> b)
_ If (FoldRequired mods) a (Maybe a)
mv = RelationParam -> RelationLink -> RelationLink
addParam RelationParam
param (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    where
      param :: RelationParam
param = case SBool (FoldRequired mods)
forall (b :: Bool). SBoolI b => SBool b
sbool :: SBool (FoldRequired mods) of
        SBool (FoldRequired mods)
STrue  -> Text -> Bool -> Maybe Text -> RelationParam
RelationParam ([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 (Proxy sym -> [Char]) -> Proxy sym -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym) Bool
True    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
If (FoldRequired mods) a (Maybe a)
mv)
        SBool (FoldRequired mods)
SFalse -> Text -> Bool -> Maybe Text -> RelationParam
RelationParam ([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 (Proxy sym -> [Char]) -> Proxy sym -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym) Bool
False (Maybe Text -> RelationParam) -> Maybe Text -> RelationParam
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
If (FoldRequired mods) a (Maybe a)
mv

instance (KnownSymbol sym, RightLink b, ToHttpApiData a) => HasRelationLink (QueryParams sym a :> b) where
  toRelationLink :: Proxy (QueryParams sym a :> b)
-> MkLink (QueryParams sym a :> b) RelationLink
toRelationLink Proxy (QueryParams sym a :> b)
_ [a]
xs = [RelationParam] -> RelationLink -> RelationLink
addParams [RelationParam]
params (Return (MkLink b RelationLink) (IsFun (MkLink b RelationLink))
 -> RelationLink)
-> MkLink b RelationLink
-> Replace
     (MkLink b RelationLink)
     RelationLink
     (IsFun (MkLink b RelationLink))
forall f (b :: Bool) r.
(PolyvariadicComp f b, IsFun f ~ b) =>
(Return f b -> r) -> f -> Replace f r b
... Proxy b -> MkLink b RelationLink
forall {k} (endpoint :: k).
HasRelationLink endpoint =>
Proxy endpoint -> MkLink endpoint RelationLink
toRelationLink (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    where
      params :: [RelationParam]
params = (\a
x -> Text -> Bool -> Maybe Text -> RelationParam
RelationParam ([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 (Proxy sym -> [Char]) -> Proxy sym -> [Char]
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @sym) Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
x)) (a -> RelationParam) -> [a] -> [RelationParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs

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

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

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

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