{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      : Servant.API.Routes
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : frederick.pringle@fpringle.com

This package provides two things:

  1. A simple, and probably incomplete, way to represent APIs at the term level.
     This is achieved by the 'Route', t'Routes', 'Path', 'Param', 'HeaderRep',
     'Request', 'Response' and 'Responses' types.
  2. More interestingly, a way to automatically generate the routes from any Servant API.  This is
     accomplished using the 'HasRoutes' typeclass. You can think of this as being a less sophisticated
     version of @HasOpenApi@ from [servant-openapi3](https://hackage.haskell.org/package/servant-openapi3),
     or a more sophisticated version of @layout@ from
     [servant-server](https://hackage.haskell.org/package/servant-server).

= Motivation

Refactoring Servant API types is quite error-prone, especially when you have to move
around lots of ':<|>' and ':>'.  So it's very possible that the route structure could
change in that refactoring, /without being caught by the type-checker/.

The 'HasRoutes' class could help as a golden test - run 'getRoutes' before and after
the refactor, and if they give the same result you can be much more confident that the
refactor didn't introduce difficult bugs.

- Note that 'printRoutes' only includes the path, method and query parameters.
  For more detailed comparison, use the JSON instance of t'Routes', encode the routes to
  a file (before and after the refactoring), and use [jdiff](https://github.com/networktocode/jdiff).

Another use-case is in testing: some Haskellers use type families to modify Servant APIs, for example
to add endpoints or authorisation headers. Types are hard to test, but terms are easy. Use 'HasRoutes'
and run your tests on t'Routes'.
-}
module Servant.API.Routes
  ( -- * API routes
    Route
  , defRoute
  , renderRoute
  , Routes
  , unRoutes
  , pattern Routes

    -- * Automatic generation of routes for Servant API types

    -- | Now we can automatically generate a t'Routes' for any Servant combinator. In most cases
    -- the user should never need to implement 'HasRoutes' unless they're hacking on Servant or
    -- defining their own combinators.
  , HasRoutes (..)
  , printRoutes
  , printRoutesSorted
  , printRoutesJSON
  , printRoutesJSONPretty

    -- * Types and helper functions

    -- ** URL paths
  , Path
  , rootPath
  , prependPathPart
  , prependCapturePart
  , prependCaptureAllPart
  , renderPath

    -- ** Request/response bodies

    -- *** Requests
  , Request
  , noRequest
  , oneRequest
  , allOfRequests

    -- *** Responses
  , Response
  , responseType
  , responseHeaders
  , Responses
  , noResponse
  , oneResponse
  , oneOfResponses

    -- ** Request/response headers
  , HeaderRep
  , mkHeaderRep

    -- ** Query parameters
  , Param
  , singleParam
  , arrayElemParam
  , flagParam
  , renderParam

    -- ** Auth schemes
  , Auth
  , basicAuth
  , customAuth
  )
where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Encode.Pretty
import qualified Data.Aeson.Key as AK (fromText)
import qualified Data.Aeson.Types as A (Pair)
import Data.Bifunctor (bimap)
import Data.Foldable (foldl', traverse_)
import Data.List (sort)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Data.Typeable
import GHC.TypeLits (KnownSymbol, Symbol)
import Lens.Micro
import Network.HTTP.Types.Method (Method)
import Servant.API
import Servant.API.Modifiers (RequiredArgument)
import "this" Servant.API.Routes.Auth
import "this" Servant.API.Routes.Header
import "this" Servant.API.Routes.Param
import "this" Servant.API.Routes.Path
import "this" Servant.API.Routes.Request
import "this" Servant.API.Routes.Response
import "this" Servant.API.Routes.Route
import "this" Servant.API.Routes.Utils

{- | To render all of an API's 'Route's as JSON, we need to identify each route by its
 path AND its method (since 2 routes can have the same path but different method).
 This newtype lets us represent this nested structure.
-}
newtype Routes = MkRoutes
  { Routes -> Map Path (Map Method Route)
unRoutes :: Map.Map Path (Map.Map Method Route)
  -- ^ Get the underlying 'Map.Map' of a t'Routes'.
  }
  deriving (Int -> Routes -> ShowS
[Routes] -> ShowS
Routes -> String
(Int -> Routes -> ShowS)
-> (Routes -> String) -> ([Routes] -> ShowS) -> Show Routes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Routes -> ShowS
showsPrec :: Int -> Routes -> ShowS
$cshow :: Routes -> String
show :: Routes -> String
$cshowList :: [Routes] -> ShowS
showList :: [Routes] -> ShowS
Show, Routes -> Routes -> Bool
(Routes -> Routes -> Bool)
-> (Routes -> Routes -> Bool) -> Eq Routes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Routes -> Routes -> Bool
== :: Routes -> Routes -> Bool
$c/= :: Routes -> Routes -> Bool
/= :: Routes -> Routes -> Bool
Eq)

makeRoutes :: [Route] -> Routes
makeRoutes :: [Route] -> Routes
makeRoutes = Map Path (Map Method Route) -> Routes
MkRoutes (Map Path (Map Method Route) -> Routes)
-> ([Route] -> Map Path (Map Method Route)) -> [Route] -> Routes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Path (Map Method Route)
 -> Route -> Map Path (Map Method Route))
-> Map Path (Map Method Route)
-> [Route]
-> Map Path (Map Method Route)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Path (Map Method Route) -> Route -> Map Path (Map Method Route)
insert Map Path (Map Method Route)
forall a. Monoid a => a
mempty
  where
    insert :: Map Path (Map Method Route) -> Route -> Map Path (Map Method Route)
insert Map Path (Map Method Route)
acc Route
r = (Map Method Route -> Map Method Route -> Map Method Route)
-> Path
-> Map Method Route
-> Map Path (Map Method Route)
-> Map Path (Map Method Route)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Map Method Route -> Map Method Route -> Map Method Route
forall a. Semigroup a => a -> a -> a
(<>) Path
path Map Method Route
subMap Map Path (Map Method Route)
acc
      where
        path :: Path
path = Route
r Route -> Getting Path Route Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path Route Path
Lens' Route Path
routePath
        method :: Method
method = Route
r Route -> Getting Method Route Method -> Method
forall s a. s -> Getting a s a -> a
^. Getting Method Route Method
Lens' Route Method
routeMethod
        subMap :: Map Method Route
subMap = Method -> Route -> Map Method Route
forall k a. k -> a -> Map k a
Map.singleton Method
method Route
r

unmakeRoutes :: Routes -> [Route]
unmakeRoutes :: Routes -> [Route]
unmakeRoutes = (Map Method Route -> [Route]) -> [Map Method Route] -> [Route]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map Method Route -> [Route]
forall k a. Map k a -> [a]
Map.elems ([Map Method Route] -> [Route])
-> (Routes -> [Map Method Route]) -> Routes -> [Route]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Path (Map Method Route) -> [Map Method Route]
forall k a. Map k a -> [a]
Map.elems (Map Path (Map Method Route) -> [Map Method Route])
-> (Routes -> Map Path (Map Method Route))
-> Routes
-> [Map Method Route]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Routes -> Map Path (Map Method Route)
unRoutes

{- | A smart constructor that allows us to think of a t'Routes' as simply a list of
'Route's, whereas it's actually a 'Map.Map'.
-}
pattern Routes :: [Route] -> Routes
pattern $bRoutes :: [Route] -> Routes
$mRoutes :: forall {r}. Routes -> ([Route] -> r) -> ((# #) -> r) -> r
Routes rs <- (unmakeRoutes -> rs)
  where
    Routes = [Route] -> Routes
makeRoutes

{-# COMPLETE Routes #-}

instance ToJSON Routes where
  toJSON :: Routes -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Routes -> [Pair]) -> Routes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path, Map Method Route) -> Pair)
-> [(Path, Map Method Route)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path, Map Method Route) -> Pair
mkPair ([(Path, Map Method Route)] -> [Pair])
-> (Routes -> [(Path, Map Method Route)]) -> Routes -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Path (Map Method Route) -> [(Path, Map Method Route)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map Path (Map Method Route) -> [(Path, Map Method Route)])
-> (Routes -> Map Path (Map Method Route))
-> Routes
-> [(Path, Map Method Route)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Routes -> Map Path (Map Method Route)
unRoutes
    where
      mkPair :: (Path, Map.Map Method Route) -> A.Pair
      mkPair :: (Path, Map Method Route) -> Pair
mkPair = (Path -> Key)
-> (Map Method Route -> Value) -> (Path, Map Method Route) -> Pair
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Key
AK.fromText (Text -> Key) -> (Path -> Text) -> Path -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
renderPath) Map Method Route -> Value
subMapToJSON

      subMapToJSON :: Map.Map Method Route -> Value
      subMapToJSON :: Map Method Route -> Value
subMapToJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (Map Method Route -> [Pair]) -> Map Method Route -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Method, Route) -> Pair) -> [(Method, Route)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Method, Route) -> Pair
forall {e} {kv} {v}. (KeyValue e kv, ToJSON v) => (Method, v) -> kv
mkSubPair ([(Method, Route)] -> [Pair])
-> (Map Method Route -> [(Method, Route)])
-> Map Method Route
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Method Route -> [(Method, Route)]
forall k a. Map k a -> [(k, a)]
Map.assocs

      mkSubPair :: (Method, v) -> kv
mkSubPair (Method
method, v
r) =
        let key :: Key
key = Text -> Key
AK.fromText (Text -> Key) -> (Method -> Text) -> Method -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
TE.decodeUtf8 (Method -> Key) -> Method -> Key
forall a b. (a -> b) -> a -> b
$ Method
method
        in  Key
key Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
r

{- | Get a simple list of all the routes in an API.

One use-case, which was the original motivation for the class, is refactoring Servant APIs
to use 'NamedRoutes'. It's a fiddly, repetitive, and error-prone process, and it's very
easy to make small mistakes. A lot of these errors will be caught by the type-checker, e.g.
if the type signature of a handler function doesn't match the @ServerT@ of its API type.
However there are some errrors that wouldn't be caught by the type-checker, such as missing
out path parts.

For example, if our original API looked like

> type API =
>   "api"
>     :> "v2"
>     :> ( "users" :> Get '[JSON] [User]
>           :<|> "user" :> ReqBody '[JSON] UserData :> Post '[JSON] UserId
>        )
>
> server :: Server API
> server = listUsers :<|> createUser
>   where ...

and we refactored to

> data RefactoredAPI mode = RefactoredAPI
>   { listUsers :: mode :- "api" :> "v2" :> "users" :> Get '[JSON] [User]
>   , createUser :: mode :- "user" :> ReqBody '[JSON] UserData :> Post '[JSON] UserId
>   }
>   deriving Generic
>
> server :: Server (NamedRoutes RefactoredAPI)
> server = RefactoredAPI {listUsers, createUser}
>   where ...

Oops! We forgot the @"api" :> "v2" :>@ in the 2nd sub-endpoint. However, since the @ServerT@ type
is unaffected by adding or remove path parts, this will still compile.

However, if we use 'HasRoutes' as a sanity check:

> ghci> printRoutes @API
> GET /api/v2/users
> POST /api/v2/user
>
> ghci> printRoutes @(NamedRoutes RefactoredAPI)
> GET /api/v2/users
> POST /user

Much clearer to see the mistake. For more detailed output, use the 'ToJSON' instance:

> ghci> BL.putStrLn . encodePretty $ getRoutes @API
> [
>     {
>         "auths": [],
>         "method": "GET",
>         "params": [],
>         "path": "/api/v2/users",
>         "request_body": null,
>         "request_headers": [],
>         "response": "[User]",
>         "response_headers": []
>     },
>     {
>         "auths": [],
>         "method": "POST",
>         "params": [],
>         "path": "/api/v2/user",
>         "request_body": "UserData",
>         "request_headers": [],
>         "response": "UserId",
>         "response_headers": []
>     }
> ]
>
> ghci> BL.putStrLn . encodePretty $ getRoutes @(NamedRoutes RefactoredAPI)
> [
>     {
>         "auths": [],
>         "method": "GET",
>         "params": [],
>         "path": "/api/v2/users",
>         "request_body": null,
>         "request_headers": [],
>         "response": "[User]",
>         "response_headers": []
>     },
>     {
>         "auths": [],
>         "method": "POST",
>         "params": [],
>         "path": "/user",              -- oops!
>         "request_body": "UserData",
>         "request_headers": [],
>         "response": "UserId",
>         "response_headers": []
>     }
> ]
-}
class HasRoutes api where
  -- | Type-level list of API routes for the given API.
  --
  -- Since @TypeApplications@ is becoming pervasive, we forego @Proxy@ here in favour
  -- of @getRoutes \@API@.
  getRoutes :: [Route]

-- | Get all the routes of an API and print them to stdout. See 'renderRoute' for examples.
printRoutes :: forall api. (HasRoutes api) => IO ()
printRoutes :: forall api. HasRoutes api => IO ()
printRoutes = (Route -> IO ()) -> [Route] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Route -> IO ()
printRoute ([Route] -> IO ()) -> [Route] -> IO ()
forall a b. (a -> b) -> a -> b
$ forall api. HasRoutes api => [Route]
getRoutes @api
  where
    printRoute :: Route -> IO ()
printRoute = Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Route -> Text) -> Route -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route -> Text
renderRoute

{- | Get all the routes of an API, sort them by path and method, and print them to stdout.
 See 'renderRoute' for examples.
-}
printRoutesSorted :: forall api. (HasRoutes api) => IO ()
printRoutesSorted :: forall api. HasRoutes api => IO ()
printRoutesSorted = (Route -> IO ()) -> [Route] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Route -> IO ()
printRoute ([Route] -> IO ()) -> ([Route] -> [Route]) -> [Route] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Route] -> [Route]
forall a. Ord a => [a] -> [a]
sort ([Route] -> IO ()) -> [Route] -> IO ()
forall a b. (a -> b) -> a -> b
$ forall api. HasRoutes api => [Route]
getRoutes @api
  where
    printRoute :: Route -> IO ()
printRoute = Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Route -> Text) -> Route -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route -> Text
renderRoute

{- | Same as 'printRoutes`, but encode the t'Routes' as JSON before printing to stdout.
For an even prettier version, see 'printRoutesJSONPretty'.
-}
printRoutesJSON :: forall api. (HasRoutes api) => IO ()
printRoutesJSON :: forall api. HasRoutes api => IO ()
printRoutesJSON =
  Text -> IO ()
T.putStrLn
    (Text -> IO ()) -> ([Route] -> Text) -> [Route] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
TL.toStrict
    (LazyText -> Text) -> ([Route] -> LazyText) -> [Route] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyText
TLE.decodeUtf8
    (ByteString -> LazyText)
-> ([Route] -> ByteString) -> [Route] -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Routes -> ByteString
forall a. ToJSON a => a -> ByteString
encode
    (Routes -> ByteString)
-> ([Route] -> Routes) -> [Route] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Route] -> Routes
Routes
    ([Route] -> IO ()) -> [Route] -> IO ()
forall a b. (a -> b) -> a -> b
$ forall api. HasRoutes api => [Route]
getRoutes @api

-- | Pretty-encode the t'Routes' as JSON before printing to stdout.
printRoutesJSONPretty :: forall api. (HasRoutes api) => IO ()
printRoutesJSONPretty :: forall api. HasRoutes api => IO ()
printRoutesJSONPretty =
  Text -> IO ()
T.putStrLn
    (Text -> IO ()) -> ([Route] -> Text) -> [Route] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
TL.toStrict
    (LazyText -> Text) -> ([Route] -> LazyText) -> [Route] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyText
TLE.decodeUtf8
    (ByteString -> LazyText)
-> ([Route] -> ByteString) -> [Route] -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Routes -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty
    (Routes -> ByteString)
-> ([Route] -> Routes) -> [Route] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Route] -> Routes
Routes
    ([Route] -> IO ()) -> [Route] -> IO ()
forall a b. (a -> b) -> a -> b
$ forall api. HasRoutes api => [Route]
getRoutes @api

instance HasRoutes EmptyAPI where
  getRoutes :: [Route]
getRoutes = [Route]
forall a. Monoid a => a
mempty

instance
  (ReflectMethod (method :: StdMethod)) =>
  HasRoutes (NoContentVerb method)
  where
  getRoutes :: [Route]
getRoutes = Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$ Method -> Route
defRoute Method
method
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method

instance
  {-# OVERLAPPABLE #-}
  (ReflectMethod (method :: StdMethod), Typeable a) =>
  HasRoutes (Verb method status ctypes a)
  where
  getRoutes :: [Route]
getRoutes =
    Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$
      Method -> Route
defRoute Method
method
        Route -> (Route -> Route) -> Route
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses) -> Route -> Identity Route
Lens' Route Responses
routeResponse ((Responses -> Identity Responses) -> Route -> Identity Route)
-> Responses -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Responses
response
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method
      response :: Responses
response = forall a. HasResponse a => Responses
oneResponse @a

instance
  {-# OVERLAPPING #-}
  ( ReflectMethod (method :: StdMethod)
  , GetHeaderReps hs
  , Typeable a
  ) =>
  HasRoutes (Verb method status ctypes (Headers hs a))
  where
  getRoutes :: [Route]
getRoutes =
    Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$
      Method -> Route
defRoute Method
method
        Route -> (Route -> Route) -> Route
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses) -> Route -> Identity Route
Lens' Route Responses
routeResponse ((Responses -> Identity Responses) -> Route -> Identity Route)
-> Responses -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Responses
response
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method
      response :: Responses
response = forall a. HasResponse a => Responses
oneResponse @(Headers hs a)

#if MIN_VERSION_servant(0,18,1)
instance
  {-# OVERLAPPING #-}
  (ReflectMethod (method :: StdMethod)) =>
  HasRoutes (UVerb method ctypes '[])
  where
  getRoutes :: [Route]
getRoutes = Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$ Method -> Route
defRoute Method
method
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method

instance
  {-# OVERLAPPING #-}
  (ReflectMethod (method :: StdMethod), Typeable a) =>
  HasRoutes (UVerb method ctypes '[a])
  where
  getRoutes :: [Route]
getRoutes =
    Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$
      Method -> Route
defRoute Method
method
        Route -> (Route -> Route) -> Route
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses) -> Route -> Identity Route
Lens' Route Responses
routeResponse ((Responses -> Identity Responses) -> Route -> Identity Route)
-> Responses -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Responses
response
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method
      response :: Responses
response = forall a. HasResponse a => Responses
oneResponse @a

instance
  (ReflectMethod (method :: StdMethod), AllHasResponse as, Unique as) =>
  HasRoutes (UVerb method ctypes as)
  where
  getRoutes :: [Route]
getRoutes =
    Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$
      Method -> Route
defRoute Method
method
        Route -> (Route -> Route) -> Route
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses) -> Route -> Identity Route
Lens' Route Responses
routeResponse ((Responses -> Identity Responses) -> Route -> Identity Route)
-> Responses -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Responses
response
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method
      response :: Responses
response = forall (as :: [*]). AllHasResponse as => Responses
oneOfResponses @as
#endif

instance (HasRoutes l, HasRoutes r) => HasRoutes (l :<|> r) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @l [Route] -> [Route] -> [Route]
forall a. Semigroup a => a -> a -> a
<> forall api. HasRoutes api => [Route]
getRoutes @r

instance (KnownSymbol path, HasRoutes api) => HasRoutes (path :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path -> Identity Path) -> Route -> Identity Route
Lens' Route Path
routePath ((Path -> Identity Path) -> Route -> Identity Route)
-> (Path -> Path) -> Route -> Route
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Path -> Path
prependPathPart Text
path
    where
      path :: Text
path = forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @path

instance
  (KnownSymbol capture, Typeable a, HasRoutes api) =>
  HasRoutes (Capture' mods capture a :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path -> Identity Path) -> Route -> Identity Route
Lens' Route Path
routePath ((Path -> Identity Path) -> Route -> Identity Route)
-> (Path -> Path) -> Route -> Route
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Typeable a => Text -> Path -> Path
prependCapturePart @a Text
capture
    where
      capture :: Text
capture = forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @capture

instance
  (KnownSymbol capture, Typeable a, HasRoutes api) =>
  HasRoutes (CaptureAll capture a :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path -> Identity Path) -> Route -> Identity Route
Lens' Route Path
routePath ((Path -> Identity Path) -> Route -> Identity Route)
-> (Path -> Path) -> Route -> Route
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Typeable a => Text -> Path -> Path
prependCaptureAllPart @a Text
capture
    where
      capture :: Text
capture = forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @capture

instance
  (KnownSymbol sym, Typeable (RequiredArgument mods a), HasRoutes api) =>
  HasRoutes (QueryParam' mods sym a :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set Param -> Identity (Set Param)) -> Route -> Identity Route
Lens' Route (Set Param)
routeParams ((Set Param -> Identity (Set Param)) -> Route -> Identity Route)
-> Param -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` Param
param
    where
      param :: Param
param = forall (s :: Symbol) a. (KnownSymbol s, Typeable a) => Param
singleParam @sym @(RequiredArgument mods a)

instance
  (KnownSymbol sym, Typeable a, HasRoutes api) =>
  HasRoutes (QueryParams sym a :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set Param -> Identity (Set Param)) -> Route -> Identity Route
Lens' Route (Set Param)
routeParams ((Set Param -> Identity (Set Param)) -> Route -> Identity Route)
-> Param -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` Param
param
    where
      param :: Param
param = forall (s :: Symbol) a. (KnownSymbol s, Typeable a) => Param
arrayElemParam @sym @a

#if MIN_VERSION_servant(0,19,0)
instance (HasRoutes (ToServantApi routes)) => HasRoutes (NamedRoutes routes) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @(ToServantApi routes)
#endif

instance (KnownSymbol sym, HasRoutes api) => HasRoutes (QueryFlag sym :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set Param -> Identity (Set Param)) -> Route -> Identity Route
Lens' Route (Set Param)
routeParams ((Set Param -> Identity (Set Param)) -> Route -> Identity Route)
-> Param -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` Param
param
    where
      param :: Param
param = forall (s :: Symbol). KnownSymbol s => Param
flagParam @sym

instance (HasRoutes api, Typeable a) => HasRoutes (ReqBody' mods list a :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Request -> Identity Request) -> Route -> Identity Route
Lens' Route Request
routeRequestBody ((Request -> Identity Request) -> Route -> Identity Route)
-> Request -> Route -> Route
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Request
reqBody
    where
      reqBody :: Request
reqBody = forall a. Typeable a => Request
oneRequest @a

instance (HasRoutes api) => HasRoutes (Vault :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance (HasRoutes api) => HasRoutes (HttpVersion :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance (HasRoutes api, KnownSymbol realm) => HasRoutes (BasicAuth realm usr :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set Auth -> Identity (Set Auth)) -> Route -> Identity Route
Lens' Route (Set Auth)
routeAuths ((Set Auth -> Identity (Set Auth)) -> Route -> Identity Route)
-> Auth -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` Auth
auth
    where
      auth :: Auth
auth = forall (realm :: Symbol). KnownSymbol realm => Auth
basicAuth @realm

instance (HasRoutes api, KnownSymbol sym) => HasRoutes (Description sym :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe RouteDescription -> Identity (Maybe RouteDescription))
-> Route -> Identity Route
Lens' Route (Maybe RouteDescription)
routeDescription ((Maybe RouteDescription -> Identity (Maybe RouteDescription))
 -> Route -> Identity Route)
-> (Maybe RouteDescription -> Maybe RouteDescription)
-> Route
-> Route
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe RouteDescription
-> Maybe RouteDescription -> Maybe RouteDescription
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RouteDescription -> Maybe RouteDescription
forall a. a -> Maybe a
Just (Text -> RouteDescription
RouteDescription (forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @sym)))

instance (HasRoutes api, KnownSymbol sym) => HasRoutes (Summary sym :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe RouteSummary -> Identity (Maybe RouteSummary))
-> Route -> Identity Route
Lens' Route (Maybe RouteSummary)
routeSummary ((Maybe RouteSummary -> Identity (Maybe RouteSummary))
 -> Route -> Identity Route)
-> (Maybe RouteSummary -> Maybe RouteSummary) -> Route -> Route
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe RouteSummary -> Maybe RouteSummary -> Maybe RouteSummary
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RouteSummary -> Maybe RouteSummary
forall a. a -> Maybe a
Just (Text -> RouteSummary
RouteSummary (forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @sym)))

instance
  (HasRoutes api, KnownSymbol tag) =>
  HasRoutes (AuthProtect (tag :: Symbol) :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set Auth -> Identity (Set Auth)) -> Route -> Identity Route
Lens' Route (Set Auth)
routeAuths ((Set Auth -> Identity (Set Auth)) -> Route -> Identity Route)
-> Auth -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` Auth
auth
    where
      auth :: Auth
auth = forall (realm :: Symbol). KnownSymbol realm => Auth
customAuth @tag

instance
  (HasRoutes api, KnownSymbol sym, Typeable (RequiredArgument mods a)) =>
  HasRoutes (Header' mods sym a :> api)
  where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set HeaderRep -> Identity (Set HeaderRep))
-> Route -> Identity Route
Lens' Route (Set HeaderRep)
routeRequestHeaders ((Set HeaderRep -> Identity (Set HeaderRep))
 -> Route -> Identity Route)
-> HeaderRep -> Route -> Route
forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
`add` HeaderRep
header
    where
      header :: HeaderRep
header = forall (sym :: Symbol) a.
(KnownSymbol sym, Typeable a) =>
HeaderRep
mkHeaderRep @sym @(RequiredArgument mods a)

instance (HasRoutes api) => HasRoutes (Fragment v :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance (HasRoutes api) => HasRoutes (IsSecure :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance (HasRoutes api) => HasRoutes (RemoteHost :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance (HasRoutes api, Typeable a) => HasRoutes (StreamBody' mods framing ct a :> api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api [Route] -> (Route -> Route) -> [Route]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Request -> Identity Request) -> Route -> Identity Route
Lens' Route Request
routeRequestBody ((Request -> Identity Request) -> Route -> Identity Route)
-> Request -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Request
reqBody
    where
      reqBody :: Request
reqBody = forall a. Typeable a => Request
oneRequest @a

instance (HasRoutes api) => HasRoutes (WithNamedContext name subContext api) where
  getRoutes :: [Route]
getRoutes = forall api. HasRoutes api => [Route]
getRoutes @api

instance
  (ReflectMethod (method :: StdMethod), Typeable a) =>
  HasRoutes (Stream method status framing ctype a)
  where
  getRoutes :: [Route]
getRoutes =
    Route -> [Route]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Route -> [Route]) -> Route -> [Route]
forall a b. (a -> b) -> a -> b
$
      Method -> Route
defRoute Method
method
        Route -> (Route -> Route) -> Route
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses) -> Route -> Identity Route
Lens' Route Responses
routeResponse ((Responses -> Identity Responses) -> Route -> Identity Route)
-> Responses -> Route -> Route
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Responses
response
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: StdMethod). Proxy t
Proxy @method
      response :: Responses
response = forall a. HasResponse a => Responses
oneResponse @a