{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs           #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE QuantifiedConstraints    #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

{-# OPTIONS_HADDOCK not-home        #-}

-- | Type safe generation of internal links.
--
-- Given an API with a few endpoints:
--
-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
-- >>> import Servant.API
-- >>> import Servant.Links
-- >>> import Web.HttpApiData (toUrlPiece)
-- >>> import Data.Proxy
-- >>>
-- >>> type Hello = "hello" :> Get '[JSON] Int
-- >>> type Bye   = "bye"   :> QueryParam "name" String :> Delete '[JSON] NoContent
-- >>> type API   = Hello :<|> Bye
-- >>> let api = Proxy :: Proxy API
--
-- It is possible to generate links that are guaranteed to be within 'API' with
-- 'safeLink'. The first argument to 'safeLink' is a type representing the API
-- you would like to restrict links to. The second argument is the destination
-- endpoint you would like the link to point to, this will need to end with a
-- verb like GET or POST. Further arguments may be required depending on the
-- type of the endpoint. If everything lines up you will get a 'Link' out the
-- other end.
--
-- You may omit 'QueryParam's and the like should you not want to provide them,
-- but types which form part of the URL path like 'Capture' must be included.
-- The reason you may want to omit 'QueryParam's is that safeLink is a bit
-- magical: if parameters are included that could take input it will return a
-- function that accepts that input and generates a link. This is best shown
-- with an example. Here, a link is generated with no parameters:
--
-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
-- >>> toUrlPiece (safeLink api hello :: Link)
-- "hello"
--
-- If the API has an endpoint with parameters then we can generate links with
-- or without those:
--
-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
-- "bye?name=Hubert"
--
-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
-- >>> toUrlPiece $ safeLink api without
-- "bye"
--
-- If you would like to create a helper for generating links only within that API,
-- you can partially apply safeLink if you specify a correct type signature
-- like so:
--
-- >>> :set -XConstraintKinds
-- >>> :{
-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
-- >>>             => Proxy endpoint -> MkLink endpoint Link
-- >>>     apiLink = safeLink api
-- >>> :}
--
-- `safeLink'` allows you to specialise the output:
--
-- >>> safeLink' toUrlPiece api without
-- "bye"
--
-- >>> :{
-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
-- >>>                  => Proxy endpoint -> MkLink endpoint Text
-- >>>     apiTextLink = safeLink' toUrlPiece api
-- >>> :}
--
-- >>> apiTextLink without
-- "bye"
--
-- Attempting to construct a link to an endpoint that does not exist in api
-- will result in a type error like this:
--
-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] NoContent)
-- >>> safeLink api bad_link
-- ...
-- ...Could not deduce...
-- ...
--
--  This error is essentially saying that the type family couldn't find
--  bad_link under api after trying the open (but empty) type family
--  `IsElem'` as a last resort.
--
--  @since 0.14.1
module Servant.Links (
  module Servant.API.TypeLevel,

  -- * Building and using safe links
  --
  -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
    safeLink
  , safeLink'
  , allLinks
  , allLinks'
  , URI(..)
  -- * Generics
  , AsLink
  , fieldLink
  , fieldLink'
  , allFieldLinks
  , allFieldLinks'
  -- * Adding custom types
  , HasLink(..)
  , Link
  , linkURI
  , linkURI'
  , LinkArrayElementStyle (..)
  -- ** Link accessors
  , Param (..)
  , linkSegments
  , linkQueryParams
  , linkFragment
) where

import           Data.List
import           Data.Constraint
import           Data.Proxy
                 (Proxy (..))
import           Data.Singletons.Bool
                 (SBool (..), SBoolI (..))
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding            as TE
import           Data.Type.Bool
                 (If)
import           GHC.TypeLits
                 (KnownSymbol, TypeError, symbolVal)
import           Network.URI
                 (URI (..), escapeURIString, isUnreserved)
import           Prelude ()
import           Prelude.Compat

import           Servant.API.Alternative
                 ((:<|>) ((:<|>)))
import           Servant.API.BasicAuth
                 (BasicAuth)
import           Servant.API.Capture
                 (Capture', CaptureAll)
import           Servant.API.Description
                 (Description, Summary)
import           Servant.API.Empty
                 (EmptyAPI (..))
import           Servant.API.Experimental.Auth
                 (AuthProtect)
import           Servant.API.Fragment
                 (Fragment)
import           Servant.API.Generic
import           Servant.API.Header
                 (Header')
import           Servant.API.HttpVersion
                 (HttpVersion)
import           Servant.API.IsSecure
                 (IsSecure)
import           Servant.API.Modifiers
                 (FoldRequired)
import           Servant.API.NamedRoutes
                 (NamedRoutes)
import           Servant.API.QueryParam
                 (QueryFlag, QueryParam', QueryParams)
import           Servant.API.Raw
                 (Raw)
import           Servant.API.RemoteHost
                 (RemoteHost)
import           Servant.API.ReqBody
                 (ReqBody')
import           Servant.API.Stream
                 (Stream, StreamBody')
import           Servant.API.Sub
                 (type (:>))
import           Servant.API.TypeErrors
import           Servant.API.TypeLevel
import           Servant.API.UVerb
import           Servant.API.Vault
                 (Vault)
import           Servant.API.Verbs
                 (Verb, NoContentVerb)
import           Servant.API.WithNamedContext
                 (WithNamedContext)
import           Web.HttpApiData

-- | A safe link datatype.
-- The only way of constructing a 'Link' is using 'safeLink', which means any
-- 'Link' is guaranteed to be part of the mentioned API.
data Link = Link
  { Link -> [Escaped]
_segments    :: [Escaped]
  , Link -> [Param]
_queryParams :: [Param]
  , Link -> Fragment'
_fragment    :: Fragment'
  } deriving Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show

newtype Escaped = Escaped String

type Fragment' = Maybe String

escaped :: String -> Escaped
escaped :: String -> Escaped
escaped = String -> Escaped
Escaped (String -> Escaped) -> ShowS -> String -> Escaped
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnreserved

getEscaped :: Escaped -> String
getEscaped :: Escaped -> String
getEscaped (Escaped String
s) = String
s

instance Show Escaped where
    showsPrec :: Int -> Escaped -> ShowS
showsPrec Int
d (Escaped String
s) = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d String
s
    show :: Escaped -> String
show (Escaped String
s)        = ShowS
forall a. Show a => a -> String
show String
s

linkSegments :: Link -> [String]
linkSegments :: Link -> [String]
linkSegments = (Escaped -> String) -> [Escaped] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Escaped -> String
getEscaped ([Escaped] -> [String]) -> (Link -> [Escaped]) -> Link -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> [Escaped]
_segments

linkQueryParams :: Link -> [Param]
linkQueryParams :: Link -> [Param]
linkQueryParams = Link -> [Param]
_queryParams

linkFragment :: Link -> Fragment'
linkFragment :: Link -> Fragment'
linkFragment = Link -> Fragment'
_fragment

instance ToHttpApiData Link where
    toHeader :: Link -> ByteString
toHeader   = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Link -> Text) -> Link -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece
    toUrlPiece :: Link -> Text
toUrlPiece Link
l =
        let uri :: URI
uri = Link -> URI
linkURI Link
l
        in String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
uri String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
uriQuery URI
uri String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
uriFragment URI
uri

-- | Query parameter.
data Param
    = SingleParam    String Text.Text
    | ArrayElemParam String Text.Text
    | FlagParam      String
  deriving Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> String
$cshow :: Param -> String
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show

addSegment :: Escaped -> Link -> Link
addSegment :: Escaped -> Link -> Link
addSegment Escaped
seg Link
l = Link
l { _segments :: [Escaped]
_segments = Link -> [Escaped]
_segments Link
l [Escaped] -> [Escaped] -> [Escaped]
forall a. Semigroup a => a -> a -> a
<> [Escaped
seg] }

addQueryParam :: Param -> Link -> Link
addQueryParam :: Param -> Link -> Link
addQueryParam Param
qp Link
l =
    Link
l { _queryParams :: [Param]
_queryParams = Link -> [Param]
_queryParams Link
l [Param] -> [Param] -> [Param]
forall a. Semigroup a => a -> a -> a
<> [Param
qp] }

addFragment :: Fragment' -> Link -> Link
addFragment :: Fragment' -> Link -> Link
addFragment Fragment'
fr Link
l = Link
l { _fragment :: Fragment'
_fragment = Fragment'
fr }

-- | Transform 'Link' into 'URI'.
--
-- >>> type API = "something" :> Get '[JSON] Int
-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
-- something
--
-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
-- sum?x[]=1&x[]=2&x[]=3
--
-- >>> type API = "foo/bar" :> Get '[JSON] Int
-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
-- foo%2Fbar
--
-- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
-- >>> let someRoute = Proxy :: Proxy SomeRoute
-- >>> safeLink someRoute someRoute "test@example.com"
-- Link {_segments = ["abc","test%40example.com"], _queryParams = [], _fragment = Nothing}
--
-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
-- abc/test%40example.com
--
linkURI :: Link -> URI
linkURI :: Link -> URI
linkURI = LinkArrayElementStyle -> Link -> URI
linkURI' LinkArrayElementStyle
LinkArrayElementBracket

-- | How to encode array query elements.
data LinkArrayElementStyle
    = LinkArrayElementBracket  -- ^ @foo[]=1&foo[]=2@
    | LinkArrayElementPlain    -- ^ @foo=1&foo=2@
  deriving (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
(LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> Eq LinkArrayElementStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c/= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
== :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c== :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
Eq, Eq LinkArrayElementStyle
Eq LinkArrayElementStyle
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Ordering)
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> (LinkArrayElementStyle -> LinkArrayElementStyle -> Bool)
-> (LinkArrayElementStyle
    -> LinkArrayElementStyle -> LinkArrayElementStyle)
-> (LinkArrayElementStyle
    -> LinkArrayElementStyle -> LinkArrayElementStyle)
-> Ord LinkArrayElementStyle
LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
LinkArrayElementStyle -> LinkArrayElementStyle -> Ordering
LinkArrayElementStyle
-> LinkArrayElementStyle -> LinkArrayElementStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LinkArrayElementStyle
-> LinkArrayElementStyle -> LinkArrayElementStyle
$cmin :: LinkArrayElementStyle
-> LinkArrayElementStyle -> LinkArrayElementStyle
max :: LinkArrayElementStyle
-> LinkArrayElementStyle -> LinkArrayElementStyle
$cmax :: LinkArrayElementStyle
-> LinkArrayElementStyle -> LinkArrayElementStyle
>= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c>= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
> :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c> :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
<= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c<= :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
< :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
$c< :: LinkArrayElementStyle -> LinkArrayElementStyle -> Bool
compare :: LinkArrayElementStyle -> LinkArrayElementStyle -> Ordering
$ccompare :: LinkArrayElementStyle -> LinkArrayElementStyle -> Ordering
$cp1Ord :: Eq LinkArrayElementStyle
Ord, Int -> LinkArrayElementStyle -> ShowS
[LinkArrayElementStyle] -> ShowS
LinkArrayElementStyle -> String
(Int -> LinkArrayElementStyle -> ShowS)
-> (LinkArrayElementStyle -> String)
-> ([LinkArrayElementStyle] -> ShowS)
-> Show LinkArrayElementStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkArrayElementStyle] -> ShowS
$cshowList :: [LinkArrayElementStyle] -> ShowS
show :: LinkArrayElementStyle -> String
$cshow :: LinkArrayElementStyle -> String
showsPrec :: Int -> LinkArrayElementStyle -> ShowS
$cshowsPrec :: Int -> LinkArrayElementStyle -> ShowS
Show, Int -> LinkArrayElementStyle
LinkArrayElementStyle -> Int
LinkArrayElementStyle -> [LinkArrayElementStyle]
LinkArrayElementStyle -> LinkArrayElementStyle
LinkArrayElementStyle
-> LinkArrayElementStyle -> [LinkArrayElementStyle]
LinkArrayElementStyle
-> LinkArrayElementStyle
-> LinkArrayElementStyle
-> [LinkArrayElementStyle]
(LinkArrayElementStyle -> LinkArrayElementStyle)
-> (LinkArrayElementStyle -> LinkArrayElementStyle)
-> (Int -> LinkArrayElementStyle)
-> (LinkArrayElementStyle -> Int)
-> (LinkArrayElementStyle -> [LinkArrayElementStyle])
-> (LinkArrayElementStyle
    -> LinkArrayElementStyle -> [LinkArrayElementStyle])
-> (LinkArrayElementStyle
    -> LinkArrayElementStyle -> [LinkArrayElementStyle])
-> (LinkArrayElementStyle
    -> LinkArrayElementStyle
    -> LinkArrayElementStyle
    -> [LinkArrayElementStyle])
-> Enum LinkArrayElementStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LinkArrayElementStyle
-> LinkArrayElementStyle
-> LinkArrayElementStyle
-> [LinkArrayElementStyle]
$cenumFromThenTo :: LinkArrayElementStyle
-> LinkArrayElementStyle
-> LinkArrayElementStyle
-> [LinkArrayElementStyle]
enumFromTo :: LinkArrayElementStyle
-> LinkArrayElementStyle -> [LinkArrayElementStyle]
$cenumFromTo :: LinkArrayElementStyle
-> LinkArrayElementStyle -> [LinkArrayElementStyle]
enumFromThen :: LinkArrayElementStyle
-> LinkArrayElementStyle -> [LinkArrayElementStyle]
$cenumFromThen :: LinkArrayElementStyle
-> LinkArrayElementStyle -> [LinkArrayElementStyle]
enumFrom :: LinkArrayElementStyle -> [LinkArrayElementStyle]
$cenumFrom :: LinkArrayElementStyle -> [LinkArrayElementStyle]
fromEnum :: LinkArrayElementStyle -> Int
$cfromEnum :: LinkArrayElementStyle -> Int
toEnum :: Int -> LinkArrayElementStyle
$ctoEnum :: Int -> LinkArrayElementStyle
pred :: LinkArrayElementStyle -> LinkArrayElementStyle
$cpred :: LinkArrayElementStyle -> LinkArrayElementStyle
succ :: LinkArrayElementStyle -> LinkArrayElementStyle
$csucc :: LinkArrayElementStyle -> LinkArrayElementStyle
Enum, LinkArrayElementStyle
LinkArrayElementStyle
-> LinkArrayElementStyle -> Bounded LinkArrayElementStyle
forall a. a -> a -> Bounded a
maxBound :: LinkArrayElementStyle
$cmaxBound :: LinkArrayElementStyle
minBound :: LinkArrayElementStyle
$cminBound :: LinkArrayElementStyle
Bounded)

-- | Configurable 'linkURI'.
--
-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
-- >>> linkURI' LinkArrayElementBracket $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
-- sum?x[]=1&x[]=2&x[]=3
--
-- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
-- sum?x=1&x=2&x=3
--
linkURI' :: LinkArrayElementStyle -> Link -> URI
linkURI' :: LinkArrayElementStyle -> Link -> URI
linkURI' LinkArrayElementStyle
addBrackets (Link [Escaped]
segments [Param]
q_params Fragment'
mfragment) =
    String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
forall a. Monoid a => a
mempty  -- No scheme (relative)
        Maybe URIAuth
forall a. Maybe a
Nothing -- Or authority (relative)
        (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Escaped -> String) -> [Escaped] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Escaped -> String
getEscaped [Escaped]
segments)
        ([Param] -> String
makeQueries [Param]
q_params)
        (Fragment' -> String
makeFragment Fragment'
mfragment)
  where
    makeQueries :: [Param] -> String
    makeQueries :: [Param] -> String
makeQueries [] = String
""
    makeQueries [Param]
xs =
        String
"?" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" ((Param -> String) -> [Param] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> String
makeQuery [Param]
xs)

    makeQuery :: Param -> String
    makeQuery :: Param -> String
makeQuery (ArrayElemParam String
k Text
v) = ShowS
escape String
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
style String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape (Text -> String
Text.unpack Text
v)
    makeQuery (SingleParam String
k Text
v)    = ShowS
escape String
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape (Text -> String
Text.unpack Text
v)
    makeQuery (FlagParam String
k)        = ShowS
escape String
k

    makeFragment :: Fragment' -> String
    makeFragment :: Fragment' -> String
makeFragment Fragment'
Nothing = String
""
    makeFragment (Just String
fr) = String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
escape String
fr

    style :: String
style = case LinkArrayElementStyle
addBrackets of
        LinkArrayElementStyle
LinkArrayElementBracket -> String
"[]="
        LinkArrayElementStyle
LinkArrayElementPlain -> String
"="

escape :: String -> String
escape :: ShowS
escape = (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnreserved

-- | Create a valid (by construction) relative URI with query params.
--
-- This function will only typecheck if `endpoint` is part of the API `api`
safeLink
    :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
    => Proxy api      -- ^ The whole API that this endpoint is a part of
    -> Proxy endpoint -- ^ The API endpoint you would like to point to
    -> MkLink endpoint Link
safeLink :: Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink = (Link -> Link)
-> Proxy api -> Proxy endpoint -> MkLink endpoint Link
forall endpoint api a.
(IsElem endpoint api, HasLink endpoint) =>
(Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' Link -> Link
forall a. a -> a
id

-- | More general 'safeLink'.
--
safeLink'
    :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
    => (Link -> a)
    -> Proxy api      -- ^ The whole API that this endpoint is a part of
    -> Proxy endpoint -- ^ The API endpoint you would like to point to
    -> MkLink endpoint a
safeLink' :: (Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' Link -> a
toA Proxy api
_ Proxy endpoint
endpoint = (Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA Proxy endpoint
endpoint ([Escaped] -> [Param] -> Fragment' -> Link
Link [Escaped]
forall a. Monoid a => a
mempty [Param]
forall a. Monoid a => a
mempty Fragment'
forall a. Monoid a => a
mempty)

-- | Create all links in an API.
--
-- Note that the @api@ type must be restricted to the endpoints that have
-- valid links to them.
--
-- >>> type API = "foo" :> Capture "name" Text :> Get '[JSON] Text :<|> "bar" :> Capture "name" Int :> Get '[JSON] Double
-- >>> let fooLink :<|> barLink = allLinks (Proxy :: Proxy API)
-- >>> :t fooLink
-- fooLink :: Text -> Link
-- >>> :t barLink
-- barLink :: Int -> Link
--
-- Note: nested APIs don't work well with this approach
--
-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
-- = Char -> (Int -> Link) :<|> (Double -> Link)
allLinks
    :: forall api. HasLink api
    => Proxy api
    -> MkLink api Link
allLinks :: Proxy api -> MkLink api Link
allLinks = (Link -> Link) -> Proxy api -> MkLink api Link
forall k (api :: k) a.
HasLink api =>
(Link -> a) -> Proxy api -> MkLink api a
allLinks' Link -> Link
forall a. a -> a
id

-- | More general 'allLinks'. See `safeLink'`.
allLinks'
    :: forall api a. HasLink api
    => (Link -> a)
    -> Proxy api
    -> MkLink api a
allLinks' :: (Link -> a) -> Proxy api -> MkLink api a
allLinks' Link -> a
toA Proxy api
api = (Link -> a) -> Proxy api -> Link -> MkLink api a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA Proxy api
api ([Escaped] -> [Param] -> Fragment' -> Link
Link [Escaped]
forall a. Monoid a => a
mempty [Param]
forall a. Monoid a => a
mempty Fragment'
forall a. Monoid a => a
mempty)

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

-- | Given an API record field, create a link for that route. Only the field's
-- type is used.
--
-- @
-- data Record route = Record
--     { _get :: route :- Capture "id" Int :> Get '[JSON] String
--     , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
--     }
--   deriving ('Generic')
--
-- getLink :: Int -> Link
-- getLink = 'fieldLink' _get
-- @
--
-- @since 0.14.1
fieldLink
    :: ( IsElem endpoint (ToServantApi routes), HasLink endpoint
       , GenericServant routes AsApi
       )
    => (routes AsApi -> endpoint)
    -> MkLink endpoint Link
fieldLink :: (routes AsApi -> endpoint) -> MkLink endpoint Link
fieldLink = (Link -> Link)
-> (routes AsApi -> endpoint) -> MkLink endpoint Link
forall (routes :: * -> *) endpoint a.
(IsElem endpoint (ToServantApi routes), HasLink endpoint,
 GenericServant routes AsApi) =>
(Link -> a) -> (routes AsApi -> endpoint) -> MkLink endpoint a
fieldLink' Link -> Link
forall a. a -> a
id

-- | More general version of 'fieldLink'
--
-- @since 0.14.1
fieldLink'
    :: forall routes endpoint a.
       ( IsElem endpoint (ToServantApi routes), HasLink endpoint
       , GenericServant routes AsApi
       )
    => (Link -> a)
    -> (routes AsApi -> endpoint)
    -> MkLink endpoint a
fieldLink' :: (Link -> a) -> (routes AsApi -> endpoint) -> MkLink endpoint a
fieldLink' Link -> a
toA routes AsApi -> endpoint
_ = (Link -> a)
-> Proxy (GToServant (Rep (routes AsApi)))
-> Proxy endpoint
-> MkLink endpoint a
forall endpoint api a.
(IsElem endpoint api, HasLink endpoint) =>
(Link -> a) -> Proxy api -> Proxy endpoint -> MkLink endpoint a
safeLink' Link -> a
toA (Proxy routes -> Proxy (GToServant (Rep (routes AsApi)))
forall (routes :: * -> *).
GenericServant routes AsApi =>
Proxy routes -> Proxy (ToServantApi routes)
genericApi (Proxy routes
forall k (t :: k). Proxy t
Proxy :: Proxy routes)) (Proxy endpoint
forall k (t :: k). Proxy t
Proxy :: Proxy endpoint)

-- | A type that specifies that an API record contains a set of links.
--
-- @since 0.14.1
data AsLink (a :: *)
instance GenericMode (AsLink a) where
    type (AsLink a) :- api = MkLink api a

-- | Get all links as a record.
--
-- @since 0.14.1
allFieldLinks
    :: ( HasLink (ToServantApi routes)
       , GenericServant routes (AsLink Link)
       , ToServant routes (AsLink Link) ~ MkLink (ToServantApi routes) Link
       )
    => routes (AsLink Link)
allFieldLinks :: routes (AsLink Link)
allFieldLinks = (Link -> Link) -> routes (AsLink Link)
forall (routes :: * -> *) a.
(HasLink (ToServantApi routes), GenericServant routes (AsLink a),
 ToServant routes (AsLink a) ~ MkLink (ToServantApi routes) a) =>
(Link -> a) -> routes (AsLink a)
allFieldLinks' Link -> Link
forall a. a -> a
id

-- | More general version of 'allFieldLinks'.
--
-- @since 0.14.1
allFieldLinks'
    :: forall routes a.
       ( HasLink (ToServantApi routes)
       , GenericServant routes (AsLink a)
       , ToServant routes (AsLink a) ~ MkLink (ToServantApi routes) a
       )
    => (Link -> a)
    -> routes (AsLink a)
allFieldLinks' :: (Link -> a) -> routes (AsLink a)
allFieldLinks' Link -> a
toA
    = ToServant routes (AsLink a) -> routes (AsLink a)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant
    (ToServant routes (AsLink a) -> routes (AsLink a))
-> ToServant routes (AsLink a) -> routes (AsLink a)
forall a b. (a -> b) -> a -> b
$ (Link -> a)
-> Proxy (GToServant (Rep (routes AsApi)))
-> MkLink (GToServant (Rep (routes AsApi))) a
forall k (api :: k) a.
HasLink api =>
(Link -> a) -> Proxy api -> MkLink api a
allLinks' Link -> a
toA (Proxy (GToServant (Rep (routes AsApi)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToServantApi routes))

-------------------------------------------------------------------------------
-- HasLink
-------------------------------------------------------------------------------

-- | Construct a toLink for an endpoint.
class HasLink endpoint where
    type MkLink endpoint (a :: *)
    toLink
        :: (Link -> a)
        -> Proxy endpoint -- ^ The API endpoint you would like to point to
        -> Link
        -> MkLink endpoint a

-- Naked symbol instance
instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
    type MkLink (sym :> sub) a = MkLink sub a
    toLink :: (Link -> a) -> Proxy (sym :> sub) -> Link -> MkLink (sym :> sub) a
toLink Link -> a
toA Proxy (sym :> sub)
_ =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> (Link -> Link) -> Link -> MkLink sub a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Escaped -> Link -> Link
addSegment (String -> Escaped
escaped String
seg)
      where
        seg :: String
seg = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

-- QueryParam instances
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
    => HasLink (QueryParam' mods sym v :> sub)
  where
    type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
    toLink :: (Link -> a)
-> Proxy (QueryParam' mods sym v :> sub)
-> Link
-> MkLink (QueryParam' mods sym v :> sub) a
toLink Link -> a
toA Proxy (QueryParam' mods sym v :> sub)
_ Link
l If (FoldRequired mods) v (Maybe v)
mv =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> Link -> MkLink sub a
forall a b. (a -> b) -> a -> b
$
            case SBool (FoldRequired mods)
forall (b :: Bool). SBoolI b => SBool b
sbool :: SBool (FoldRequired mods) of
                SBool (FoldRequired mods)
STrue  -> (Param -> Link -> Link
addQueryParam (Param -> Link -> Link) -> (v -> Param) -> v -> Link -> Link
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Param
SingleParam String
k (Text -> Param) -> (v -> Text) -> v -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam) v
If (FoldRequired mods) v (Maybe v)
mv Link
l
                SBool (FoldRequired mods)
SFalse -> (Link -> Link) -> (v -> Link -> Link) -> Maybe v -> Link -> Link
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Link -> Link
forall a. a -> a
id (Param -> Link -> Link
addQueryParam (Param -> Link -> Link) -> (v -> Param) -> v -> Link -> Link
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Param
SingleParam String
k (Text -> Param) -> (v -> Text) -> v -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam) Maybe v
If (FoldRequired mods) v (Maybe v)
mv Link
l
      where
        k :: String
        k :: String
k = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
    => HasLink (QueryParams sym v :> sub)
  where
    type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
    toLink :: (Link -> a)
-> Proxy (QueryParams sym v :> sub)
-> Link
-> MkLink (QueryParams sym v :> sub) a
toLink Link -> a
toA Proxy (QueryParams sym v :> sub)
_ Link
l =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> ([v] -> Link) -> [v] -> MkLink sub a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Link -> v -> Link) -> Link -> [v] -> Link
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Link
l' v
v -> Param -> Link -> Link
addQueryParam (String -> Text -> Param
ArrayElemParam String
k (v -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam v
v)) Link
l') Link
l
      where
        k :: String
k = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

instance (KnownSymbol sym, HasLink sub)
    => HasLink (QueryFlag sym :> sub)
  where
    type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
    toLink :: (Link -> a)
-> Proxy (QueryFlag sym :> sub)
-> Link
-> MkLink (QueryFlag sym :> sub) a
toLink Link -> a
toA  Proxy (QueryFlag sym :> sub)
_ Link
l Bool
False =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) Link
l
    toLink Link -> a
toA Proxy (QueryFlag sym :> sub)
_ Link
l Bool
True =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> Link -> MkLink sub a
forall a b. (a -> b) -> a -> b
$ Param -> Link -> Link
addQueryParam (String -> Param
FlagParam String
k) Link
l
      where
        k :: String
k = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

-- :<|> instance - Generate all links at once
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
    type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
    toLink :: (Link -> a) -> Proxy (a :<|> b) -> Link -> MkLink (a :<|> b) a
toLink Link -> a
toA Proxy (a :<|> b)
_ Link
l = (Link -> a) -> Proxy a -> Link -> MkLink a a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Link
l MkLink a a -> MkLink b a -> MkLink a a :<|> MkLink b a
forall a b. a -> b -> a :<|> b
:<|> (Link -> a) -> Proxy b -> Link -> MkLink b a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) Link
l

-- Misc instances
instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
    type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
    toLink :: (Link -> a)
-> Proxy (ReqBody' mods ct a :> sub)
-> Link
-> MkLink (ReqBody' mods ct a :> sub) a
toLink Link -> a
toA Proxy (ReqBody' mods ct a :> sub)
_ = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (StreamBody' mods framing ct a :> sub) where
    type MkLink (StreamBody' mods framing ct a :> sub) r = MkLink sub r
    toLink :: (Link -> a)
-> Proxy (StreamBody' mods framing ct a :> sub)
-> Link
-> MkLink (StreamBody' mods framing ct a :> sub) a
toLink Link -> a
toA Proxy (StreamBody' mods framing ct a :> sub)
_ = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance (ToHttpApiData v, HasLink sub)
    => HasLink (Capture' mods sym v :> sub)
  where
    type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
    toLink :: (Link -> a)
-> Proxy (Capture' mods sym v :> sub)
-> Link
-> MkLink (Capture' mods sym v :> sub) a
toLink Link -> a
toA Proxy (Capture' mods sym v :> sub)
_ Link
l v
v =
        (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> Link -> MkLink sub a
forall a b. (a -> b) -> a -> b
$
            Escaped -> Link -> Link
addSegment (String -> Escaped
escaped (String -> Escaped) -> (Text -> String) -> Text -> Escaped
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Escaped) -> Text -> Escaped
forall a b. (a -> b) -> a -> b
$ v -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece v
v) Link
l

instance (ToHttpApiData v, HasLink sub)
    => HasLink (CaptureAll sym v :> sub)
  where
    type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
    toLink :: (Link -> a)
-> Proxy (CaptureAll sym v :> sub)
-> Link
-> MkLink (CaptureAll sym v :> sub) a
toLink Link -> a
toA Proxy (CaptureAll sym v :> sub)
_ Link
l [v]
vs = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> Link -> MkLink sub a
forall a b. (a -> b) -> a -> b
$
        (Link -> v -> Link) -> Link -> [v] -> Link
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((v -> Link -> Link) -> Link -> v -> Link
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((v -> Link -> Link) -> Link -> v -> Link)
-> (v -> Link -> Link) -> Link -> v -> Link
forall a b. (a -> b) -> a -> b
$ Escaped -> Link -> Link
addSegment (Escaped -> Link -> Link) -> (v -> Escaped) -> v -> Link -> Link
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Escaped
escaped (String -> Escaped) -> (v -> String) -> v -> Escaped
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (v -> Text) -> v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) Link
l [v]
vs

instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
    type MkLink (Header' mods sym a :> sub) r = MkLink sub r
    toLink :: (Link -> a)
-> Proxy (Header' mods sym a :> sub)
-> Link
-> MkLink (Header' mods sym a :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (Header' mods sym a :> sub)
-> Link
-> MkLink (Header' mods sym a :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (Vault :> sub) where
    type MkLink (Vault :> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (Vault :> sub) -> Link -> MkLink (Vault :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (Vault :> sub)
-> Link
-> MkLink (Vault :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (Description s :> sub) where
    type MkLink (Description s :> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (Description s :> sub)
-> Link
-> MkLink (Description s :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (Description s :> sub)
-> Link
-> MkLink (Description s :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (Summary s :> sub) where
    type MkLink (Summary s :> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (Summary s :> sub) -> Link -> MkLink (Summary s :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (Summary s :> sub)
-> Link
-> MkLink (Summary s :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (HttpVersion :> sub) where
    type MkLink (HttpVersion:> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (HttpVersion :> sub)
-> Link
-> MkLink (HttpVersion :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (HttpVersion :> sub)
-> Link
-> MkLink (HttpVersion :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (IsSecure :> sub) where
    type MkLink (IsSecure :> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (IsSecure :> sub) -> Link -> MkLink (IsSecure :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (IsSecure :> sub)
-> Link
-> MkLink (IsSecure :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (WithNamedContext name context sub) where
    type MkLink (WithNamedContext name context sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (WithNamedContext name context sub)
-> Link
-> MkLink (WithNamedContext name context sub) a
toLink Link -> a
toA Proxy (WithNamedContext name context sub)
_ = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (RemoteHost :> sub) where
    type MkLink (RemoteHost :> sub) a = MkLink sub a
    toLink :: (Link -> a)
-> Proxy (RemoteHost :> sub)
-> Link
-> MkLink (RemoteHost :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (RemoteHost :> sub)
-> Link
-> MkLink (RemoteHost :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
    type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
    toLink :: (Link -> a)
-> Proxy (BasicAuth realm a :> sub)
-> Link
-> MkLink (BasicAuth realm a :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (BasicAuth realm a :> sub)
-> Link
-> MkLink (BasicAuth realm a :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasLink EmptyAPI where
    type MkLink EmptyAPI a = EmptyAPI
    toLink :: (Link -> a) -> Proxy EmptyAPI -> Link -> MkLink EmptyAPI a
toLink Link -> a
_ Proxy EmptyAPI
_ Link
_ = EmptyAPI
MkLink EmptyAPI a
EmptyAPI

-- Verb (terminal) instances
instance HasLink (Verb m s ct a) where
    type MkLink (Verb m s ct a) r = r
    toLink :: (Link -> a)
-> Proxy (Verb m s ct a) -> Link -> MkLink (Verb m s ct a) a
toLink Link -> a
toA Proxy (Verb m s ct a)
_ = Link -> a
Link -> MkLink (Verb m s ct a) a
toA

instance HasLink (NoContentVerb m) where
    type MkLink (NoContentVerb m) r = r
    toLink :: (Link -> a)
-> Proxy (NoContentVerb m) -> Link -> MkLink (NoContentVerb m) a
toLink Link -> a
toA Proxy (NoContentVerb m)
_ = Link -> a
Link -> MkLink (NoContentVerb m) a
toA

instance HasLink Raw where
    type MkLink Raw a = a
    toLink :: (Link -> a) -> Proxy Raw -> Link -> MkLink Raw a
toLink Link -> a
toA Proxy Raw
_ = Link -> a
Link -> MkLink Raw a
toA

instance HasLink (Stream m status fr ct a) where
    type MkLink (Stream m status fr ct a) r = r
    toLink :: (Link -> a)
-> Proxy (Stream m status fr ct a)
-> Link
-> MkLink (Stream m status fr ct a) a
toLink Link -> a
toA Proxy (Stream m status fr ct a)
_ = Link -> a
Link -> MkLink (Stream m status fr ct a) a
toA

-- UVerb instances
instance HasLink (UVerb m ct a) where
    type MkLink (UVerb m ct a) r = r
    toLink :: (Link -> a)
-> Proxy (UVerb m ct a) -> Link -> MkLink (UVerb m ct a) a
toLink Link -> a
toA Proxy (UVerb m ct a)
_ = Link -> a
Link -> MkLink (UVerb m ct a) a
toA
-- Instance for NamedRoutes combinator

type GLinkConstraints routes a =
  ( MkLink (ToServant routes AsApi) a ~ ToServant routes (AsLink a)
  , GenericServant routes (AsLink a)
  )

class GLink (routes :: * -> *) (a :: *) where
  gLinkProof :: Dict (GLinkConstraints routes a)

instance GLinkConstraints routes a => GLink routes a where
  gLinkProof :: Dict (GLinkConstraints routes a)
gLinkProof = Dict (GLinkConstraints routes a)
forall (a :: Constraint). a => Dict a
Dict

instance
  ( HasLink (ToServantApi routes)
  , forall a. GLink routes a
  ) => HasLink (NamedRoutes routes) where

  type MkLink (NamedRoutes routes) a = routes (AsLink a)

  toLink
    :: forall a. (Link -> a)
    -> Proxy (NamedRoutes routes)
    -> Link
    -> routes (AsLink a)

  toLink :: (Link -> a)
-> Proxy (NamedRoutes routes) -> Link -> routes (AsLink a)
toLink Link -> a
toA Proxy (NamedRoutes routes)
_ Link
l = case GLink routes a => Dict (GLinkConstraints routes a)
forall (routes :: * -> *) a.
GLink routes a =>
Dict (GLinkConstraints routes a)
gLinkProof @routes @a of
    Dict (GLinkConstraints routes a)
Dict -> ToServant routes (AsLink a) -> routes (AsLink a)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (ToServant routes (AsLink a) -> routes (AsLink a))
-> ToServant routes (AsLink a) -> routes (AsLink a)
forall a b. (a -> b) -> a -> b
$ (Link -> a)
-> Proxy (ToServantApi routes)
-> Link
-> MkLink (ToServantApi routes) a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy (ToServantApi routes)
forall k (t :: k). Proxy t
Proxy @(ToServantApi routes)) Link
l

-- AuthProtext instances
instance HasLink sub => HasLink (AuthProtect tag :> sub) where
  type MkLink (AuthProtect tag :> sub) a = MkLink sub a
  toLink :: (Link -> a)
-> Proxy (AuthProtect tag :> sub)
-> Link
-> MkLink (AuthProtect tag :> sub) a
toLink = Proxy sub
-> (Link -> a)
-> Proxy (AuthProtect tag :> sub)
-> Link
-> MkLink (AuthProtect tag :> sub) a
forall k sub a (combinator :: k).
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a) =>
Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)

instance (HasLink sub, ToHttpApiData v)
    => HasLink (Fragment v :> sub) where
  type MkLink (Fragment v :> sub) a = v -> MkLink sub a
  toLink :: (Link -> a)
-> Proxy (Fragment v :> sub)
-> Link
-> MkLink (Fragment v :> sub) a
toLink Link -> a
toA Proxy (Fragment v :> sub)
_ Link
l v
mv =
      (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub) (Link -> MkLink sub a) -> Link -> MkLink sub a
forall a b. (a -> b) -> a -> b
$
         Fragment' -> Link -> Link
addFragment ((String -> Fragment'
forall a. a -> Maybe a
Just (String -> Fragment') -> (v -> String) -> v -> Fragment'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (v -> Text) -> v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam) v
mv) Link
l

-- | Helper for implementing 'toLink' for combinators not affecting link
-- structure.
simpleToLink
    :: forall sub a combinator.
       (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
    => Proxy sub
    -> (Link -> a)
    -> Proxy (combinator :> sub)
    -> Link
    -> MkLink (combinator :> sub) a
simpleToLink :: Proxy sub
-> (Link -> a)
-> Proxy (combinator :> sub)
-> Link
-> MkLink (combinator :> sub) a
simpleToLink Proxy sub
_ Link -> a
toA Proxy (combinator :> sub)
_ = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall k (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)


-- $setup
-- >>> import Servant.API
-- >>> import Data.Text (Text)

-- Erroring instance for 'HasLink' when a combinator is not fully applied
instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)
  where
    type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
    toLink :: (Link -> a) -> Proxy (arr :> sub) -> Link -> MkLink (arr :> sub) a
toLink = String
-> (Link -> a) -> Proxy (arr :> sub) -> Link -> (TypeError ...)
forall a. HasCallStack => String -> a
error String
"unreachable"

-- Erroring instances for 'HasLink' for unknown API combinators
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub)

instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api