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

Simple term-level representation of Servant API endpoints.
-}
module Servant.API.Routes.Route
  ( -- * API routes

    -- | The 'Route' type is not sophisticated, and its internals are hidden.
    -- Create 'Route's using 'Servant.API.Routes.Route.defRoute', and update its fields
    -- using the provided [lenses](#g:optics).
    Route
  , defRoute
  , renderRoute

    -- * Optics #optics#
  , routeMethod
  , routePath
  , routeParams
  , routeRequestHeaders
  , routeRequestBody
  , routeResponse
  , routeAuths
  , add
  )
where

import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Lens.Micro
import Network.HTTP.Types.Method (Method)
import "this" Servant.API.Routes.Internal.Route
import "this" Servant.API.Routes.Param
import "this" Servant.API.Routes.Path
import "this" Servant.API.Routes.Request
import "this" Servant.API.Routes.Response

{- | Given a REST 'Method', create a default 'Route': root path (@"/"@) with no params,
headers, body, auths, or response.
-}
defRoute :: Method -> Route
defRoute :: Method -> Route
defRoute Method
method =
  Route
    { _routeMethod :: Method
_routeMethod = Method
method
    , _routePath :: Path
_routePath = Path
rootPath
    , _routeParams :: Set Param
_routeParams = forall a. Set a
Set.empty
    , _routeRequestHeaders :: Set HeaderRep
_routeRequestHeaders = forall a. Monoid a => a
mempty
    , _routeRequestBody :: Request
_routeRequestBody = Request
noRequest
    , _routeResponse :: Responses
_routeResponse = Responses
noResponse
    , _routeAuths :: Set Auth
_routeAuths = forall a. Monoid a => a
mempty
    }

{- | Pretty-print a 'Route'. Note that the output is minimal and doesn't contain all the information
contained in a 'Route'. For full output, use the 'Data.Aeson.ToJSON' instance.

> ghci> renderRoute $ defRoute \"POST\"
> "POST /"
> ghci> :{
> ghci| renderRoute $
> ghci|   defRoute \"POST\"
> ghci|     & routePath %~ prependPathPart "api/v2"
> ghci|     & routeParams .~ [singleParam @"p1" @T.Text, flagParam @"flag", arrayElemParam @"p2s" @(Maybe Int)]
> ghci| :}
> "POST /api/v2?p1=<Text>&flag&p2s=<[Maybe Int]>"
-}
renderRoute :: Route -> T.Text
renderRoute :: Route -> Text
renderRoute Route {Method
Set Auth
Set Param
Set HeaderRep
Path
Request
Responses
_routeAuths :: Set Auth
_routeResponse :: Responses
_routeRequestBody :: Request
_routeRequestHeaders :: Set HeaderRep
_routeParams :: Set Param
_routePath :: Path
_routeMethod :: Method
_routeAuths :: Route -> Set Auth
_routeResponse :: Route -> Responses
_routeRequestBody :: Route -> Request
_routeRequestHeaders :: Route -> Set HeaderRep
_routeParams :: Route -> Set Param
_routePath :: Route -> Path
_routeMethod :: Route -> Method
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ Text
method
    , Text
" "
    , Text
path
    , Text
params
    ]
  where
    method :: Text
method = Method -> Text
TE.decodeUtf8 Method
_routeMethod
    path :: Text
path = Path -> Text
renderPath Path
_routePath
    params :: Text
params =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Param
_routeParams
        then Text
""
        else Text
"?" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"&" (Param -> Text
renderParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set Param
_routeParams)

add :: Ord a => ASetter s t (Set.Set a) (Set.Set a) -> a -> s -> t
add :: forall a s t. Ord a => ASetter s t (Set a) (Set a) -> a -> s -> t
add ASetter s t (Set a) (Set a)
setter = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t (Set a) (Set a)
setter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.insert