{-# LANGUAGE TemplateHaskell #-}

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

Internal module, subject to change.
-}
module Servant.API.Routes.Internal.Route
  ( -- * API routes
    Route (..)
  , RouteDescription (..)
  , RouteSummary (..)

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

import Data.Aeson
import Data.Function (on)
import qualified Data.Set as Set
import Data.String (IsString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Lens.Micro.TH
import Network.HTTP.Types.Method (Method)
import "this" Servant.API.Routes.Auth
import "this" Servant.API.Routes.Header
import "this" Servant.API.Routes.Internal.Request
import "this" Servant.API.Routes.Internal.Response
import "this" Servant.API.Routes.Param
import "this" Servant.API.Routes.Path

{- | Description of a route. This will correspond to the Servant @Description@ combinator.

It should  be noted that the 'HasRoutes' behaviour for @Description@ diverges from that in
@servant-openapi3@, in the case that one EP has multiple @Description@ combinators.
For example, given the following API:

@
type MyAPI =
  "transaction" :> TransactionAPI
    :\<|> "user" :> Description "User sub-API"
          :> ( Description "Get my user" :> Get '[JSON] User
              :\<|> "list" :> Get '[JSON] [User]
             )
@

The @Operation@ that @servant-openapi@ generates for the @GET /user@ endpoint will have the two
@Description@s 'mappend'-ed together: @"User sub-APIGet my user"@.

The corresponding 'Route' will take the most specific 'RouteDescription': @"Get my user"@.
-}
newtype RouteDescription = RouteDescription {RouteDescription -> Text
unDescription :: T.Text}
  deriving (Int -> RouteDescription -> ShowS
[RouteDescription] -> ShowS
RouteDescription -> String
(Int -> RouteDescription -> ShowS)
-> (RouteDescription -> String)
-> ([RouteDescription] -> ShowS)
-> Show RouteDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RouteDescription -> ShowS
showsPrec :: Int -> RouteDescription -> ShowS
$cshow :: RouteDescription -> String
show :: RouteDescription -> String
$cshowList :: [RouteDescription] -> ShowS
showList :: [RouteDescription] -> ShowS
Show)
  deriving (RouteDescription -> RouteDescription -> Bool
(RouteDescription -> RouteDescription -> Bool)
-> (RouteDescription -> RouteDescription -> Bool)
-> Eq RouteDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RouteDescription -> RouteDescription -> Bool
== :: RouteDescription -> RouteDescription -> Bool
$c/= :: RouteDescription -> RouteDescription -> Bool
/= :: RouteDescription -> RouteDescription -> Bool
Eq, String -> RouteDescription
(String -> RouteDescription) -> IsString RouteDescription
forall a. (String -> a) -> IsString a
$cfromString :: String -> RouteDescription
fromString :: String -> RouteDescription
IsString, Eq RouteDescription
Eq RouteDescription =>
(RouteDescription -> RouteDescription -> Ordering)
-> (RouteDescription -> RouteDescription -> Bool)
-> (RouteDescription -> RouteDescription -> Bool)
-> (RouteDescription -> RouteDescription -> Bool)
-> (RouteDescription -> RouteDescription -> Bool)
-> (RouteDescription -> RouteDescription -> RouteDescription)
-> (RouteDescription -> RouteDescription -> RouteDescription)
-> Ord RouteDescription
RouteDescription -> RouteDescription -> Bool
RouteDescription -> RouteDescription -> Ordering
RouteDescription -> RouteDescription -> RouteDescription
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
$ccompare :: RouteDescription -> RouteDescription -> Ordering
compare :: RouteDescription -> RouteDescription -> Ordering
$c< :: RouteDescription -> RouteDescription -> Bool
< :: RouteDescription -> RouteDescription -> Bool
$c<= :: RouteDescription -> RouteDescription -> Bool
<= :: RouteDescription -> RouteDescription -> Bool
$c> :: RouteDescription -> RouteDescription -> Bool
> :: RouteDescription -> RouteDescription -> Bool
$c>= :: RouteDescription -> RouteDescription -> Bool
>= :: RouteDescription -> RouteDescription -> Bool
$cmax :: RouteDescription -> RouteDescription -> RouteDescription
max :: RouteDescription -> RouteDescription -> RouteDescription
$cmin :: RouteDescription -> RouteDescription -> RouteDescription
min :: RouteDescription -> RouteDescription -> RouteDescription
Ord, NonEmpty RouteDescription -> RouteDescription
RouteDescription -> RouteDescription -> RouteDescription
(RouteDescription -> RouteDescription -> RouteDescription)
-> (NonEmpty RouteDescription -> RouteDescription)
-> (forall b.
    Integral b =>
    b -> RouteDescription -> RouteDescription)
-> Semigroup RouteDescription
forall b. Integral b => b -> RouteDescription -> RouteDescription
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RouteDescription -> RouteDescription -> RouteDescription
<> :: RouteDescription -> RouteDescription -> RouteDescription
$csconcat :: NonEmpty RouteDescription -> RouteDescription
sconcat :: NonEmpty RouteDescription -> RouteDescription
$cstimes :: forall b. Integral b => b -> RouteDescription -> RouteDescription
stimes :: forall b. Integral b => b -> RouteDescription -> RouteDescription
Semigroup, Semigroup RouteDescription
RouteDescription
Semigroup RouteDescription =>
RouteDescription
-> (RouteDescription -> RouteDescription -> RouteDescription)
-> ([RouteDescription] -> RouteDescription)
-> Monoid RouteDescription
[RouteDescription] -> RouteDescription
RouteDescription -> RouteDescription -> RouteDescription
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RouteDescription
mempty :: RouteDescription
$cmappend :: RouteDescription -> RouteDescription -> RouteDescription
mappend :: RouteDescription -> RouteDescription -> RouteDescription
$cmconcat :: [RouteDescription] -> RouteDescription
mconcat :: [RouteDescription] -> RouteDescription
Monoid, [RouteDescription] -> Value
[RouteDescription] -> Encoding
RouteDescription -> Bool
RouteDescription -> Value
RouteDescription -> Encoding
(RouteDescription -> Value)
-> (RouteDescription -> Encoding)
-> ([RouteDescription] -> Value)
-> ([RouteDescription] -> Encoding)
-> (RouteDescription -> Bool)
-> ToJSON RouteDescription
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RouteDescription -> Value
toJSON :: RouteDescription -> Value
$ctoEncoding :: RouteDescription -> Encoding
toEncoding :: RouteDescription -> Encoding
$ctoJSONList :: [RouteDescription] -> Value
toJSONList :: [RouteDescription] -> Value
$ctoEncodingList :: [RouteDescription] -> Encoding
toEncodingList :: [RouteDescription] -> Encoding
$comitField :: RouteDescription -> Bool
omitField :: RouteDescription -> Bool
ToJSON, Maybe RouteDescription
Value -> Parser [RouteDescription]
Value -> Parser RouteDescription
(Value -> Parser RouteDescription)
-> (Value -> Parser [RouteDescription])
-> Maybe RouteDescription
-> FromJSON RouteDescription
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RouteDescription
parseJSON :: Value -> Parser RouteDescription
$cparseJSONList :: Value -> Parser [RouteDescription]
parseJSONList :: Value -> Parser [RouteDescription]
$comittedField :: Maybe RouteDescription
omittedField :: Maybe RouteDescription
FromJSON) via T.Text

{- | Short summary of a route. This will correspond to the Servant @Summary@ combinator.
The behaviour described for 'RouteDescription' is the same for 'RouteSummary'.
-}
newtype RouteSummary = RouteSummary {RouteSummary -> Text
unSummary :: T.Text}
  deriving (Int -> RouteSummary -> ShowS
[RouteSummary] -> ShowS
RouteSummary -> String
(Int -> RouteSummary -> ShowS)
-> (RouteSummary -> String)
-> ([RouteSummary] -> ShowS)
-> Show RouteSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RouteSummary -> ShowS
showsPrec :: Int -> RouteSummary -> ShowS
$cshow :: RouteSummary -> String
show :: RouteSummary -> String
$cshowList :: [RouteSummary] -> ShowS
showList :: [RouteSummary] -> ShowS
Show)
  deriving (RouteSummary -> RouteSummary -> Bool
(RouteSummary -> RouteSummary -> Bool)
-> (RouteSummary -> RouteSummary -> Bool) -> Eq RouteSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RouteSummary -> RouteSummary -> Bool
== :: RouteSummary -> RouteSummary -> Bool
$c/= :: RouteSummary -> RouteSummary -> Bool
/= :: RouteSummary -> RouteSummary -> Bool
Eq, String -> RouteSummary
(String -> RouteSummary) -> IsString RouteSummary
forall a. (String -> a) -> IsString a
$cfromString :: String -> RouteSummary
fromString :: String -> RouteSummary
IsString, Eq RouteSummary
Eq RouteSummary =>
(RouteSummary -> RouteSummary -> Ordering)
-> (RouteSummary -> RouteSummary -> Bool)
-> (RouteSummary -> RouteSummary -> Bool)
-> (RouteSummary -> RouteSummary -> Bool)
-> (RouteSummary -> RouteSummary -> Bool)
-> (RouteSummary -> RouteSummary -> RouteSummary)
-> (RouteSummary -> RouteSummary -> RouteSummary)
-> Ord RouteSummary
RouteSummary -> RouteSummary -> Bool
RouteSummary -> RouteSummary -> Ordering
RouteSummary -> RouteSummary -> RouteSummary
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
$ccompare :: RouteSummary -> RouteSummary -> Ordering
compare :: RouteSummary -> RouteSummary -> Ordering
$c< :: RouteSummary -> RouteSummary -> Bool
< :: RouteSummary -> RouteSummary -> Bool
$c<= :: RouteSummary -> RouteSummary -> Bool
<= :: RouteSummary -> RouteSummary -> Bool
$c> :: RouteSummary -> RouteSummary -> Bool
> :: RouteSummary -> RouteSummary -> Bool
$c>= :: RouteSummary -> RouteSummary -> Bool
>= :: RouteSummary -> RouteSummary -> Bool
$cmax :: RouteSummary -> RouteSummary -> RouteSummary
max :: RouteSummary -> RouteSummary -> RouteSummary
$cmin :: RouteSummary -> RouteSummary -> RouteSummary
min :: RouteSummary -> RouteSummary -> RouteSummary
Ord, NonEmpty RouteSummary -> RouteSummary
RouteSummary -> RouteSummary -> RouteSummary
(RouteSummary -> RouteSummary -> RouteSummary)
-> (NonEmpty RouteSummary -> RouteSummary)
-> (forall b. Integral b => b -> RouteSummary -> RouteSummary)
-> Semigroup RouteSummary
forall b. Integral b => b -> RouteSummary -> RouteSummary
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RouteSummary -> RouteSummary -> RouteSummary
<> :: RouteSummary -> RouteSummary -> RouteSummary
$csconcat :: NonEmpty RouteSummary -> RouteSummary
sconcat :: NonEmpty RouteSummary -> RouteSummary
$cstimes :: forall b. Integral b => b -> RouteSummary -> RouteSummary
stimes :: forall b. Integral b => b -> RouteSummary -> RouteSummary
Semigroup, Semigroup RouteSummary
RouteSummary
Semigroup RouteSummary =>
RouteSummary
-> (RouteSummary -> RouteSummary -> RouteSummary)
-> ([RouteSummary] -> RouteSummary)
-> Monoid RouteSummary
[RouteSummary] -> RouteSummary
RouteSummary -> RouteSummary -> RouteSummary
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RouteSummary
mempty :: RouteSummary
$cmappend :: RouteSummary -> RouteSummary -> RouteSummary
mappend :: RouteSummary -> RouteSummary -> RouteSummary
$cmconcat :: [RouteSummary] -> RouteSummary
mconcat :: [RouteSummary] -> RouteSummary
Monoid, [RouteSummary] -> Value
[RouteSummary] -> Encoding
RouteSummary -> Bool
RouteSummary -> Value
RouteSummary -> Encoding
(RouteSummary -> Value)
-> (RouteSummary -> Encoding)
-> ([RouteSummary] -> Value)
-> ([RouteSummary] -> Encoding)
-> (RouteSummary -> Bool)
-> ToJSON RouteSummary
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RouteSummary -> Value
toJSON :: RouteSummary -> Value
$ctoEncoding :: RouteSummary -> Encoding
toEncoding :: RouteSummary -> Encoding
$ctoJSONList :: [RouteSummary] -> Value
toJSONList :: [RouteSummary] -> Value
$ctoEncodingList :: [RouteSummary] -> Encoding
toEncodingList :: [RouteSummary] -> Encoding
$comitField :: RouteSummary -> Bool
omitField :: RouteSummary -> Bool
ToJSON, Maybe RouteSummary
Value -> Parser [RouteSummary]
Value -> Parser RouteSummary
(Value -> Parser RouteSummary)
-> (Value -> Parser [RouteSummary])
-> Maybe RouteSummary
-> FromJSON RouteSummary
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RouteSummary
parseJSON :: Value -> Parser RouteSummary
$cparseJSONList :: Value -> Parser [RouteSummary]
parseJSONList :: Value -> Parser [RouteSummary]
$comittedField :: Maybe RouteSummary
omittedField :: Maybe RouteSummary
FromJSON) via T.Text

-- | A simple representation of a single endpoint of an API.
data Route = Route
  { Route -> Method
_routeMethod :: Method
  , Route -> Path
_routePath :: Path
  , Route -> Set Param
_routeParams :: Set.Set Param
  , Route -> Set HeaderRep
_routeRequestHeaders :: Set.Set HeaderRep
  , Route -> Request
_routeRequestBody :: Request
  , Route -> Responses
_routeResponse :: Responses
  , Route -> Set Auth
_routeAuths :: Set.Set Auth
  , Route -> Maybe RouteDescription
_routeDescription :: Maybe RouteDescription
  , Route -> Maybe RouteSummary
_routeSummary :: Maybe RouteSummary
  }
  deriving (Int -> Route -> ShowS
[Route] -> ShowS
Route -> String
(Int -> Route -> ShowS)
-> (Route -> String) -> ([Route] -> ShowS) -> Show Route
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Route -> ShowS
showsPrec :: Int -> Route -> ShowS
$cshow :: Route -> String
show :: Route -> String
$cshowList :: [Route] -> ShowS
showList :: [Route] -> ShowS
Show, Route -> Route -> Bool
(Route -> Route -> Bool) -> (Route -> Route -> Bool) -> Eq Route
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Route -> Route -> Bool
== :: Route -> Route -> Bool
$c/= :: Route -> Route -> Bool
/= :: Route -> Route -> Bool
Eq)

makeLenses ''Route

instance Ord Route where
  compare :: Route -> Route -> Ordering
compare = (Path, Method) -> (Path, Method) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Path, Method) -> (Path, Method) -> Ordering)
-> (Route -> (Path, Method)) -> Route -> Route -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \Route {Maybe RouteDescription
Maybe RouteSummary
Method
Set Auth
Set Param
Set HeaderRep
Path
Request
Responses
_routeMethod :: Route -> Method
_routePath :: Route -> Path
_routeParams :: Route -> Set Param
_routeRequestHeaders :: Route -> Set HeaderRep
_routeRequestBody :: Route -> Request
_routeResponse :: Route -> Responses
_routeAuths :: Route -> Set Auth
_routeDescription :: Route -> Maybe RouteDescription
_routeSummary :: Route -> Maybe RouteSummary
_routeMethod :: Method
_routePath :: Path
_routeParams :: Set Param
_routeRequestHeaders :: Set HeaderRep
_routeRequestBody :: Request
_routeResponse :: Responses
_routeAuths :: Set Auth
_routeDescription :: Maybe RouteDescription
_routeSummary :: Maybe RouteSummary
..} -> (Path
_routePath, Method
_routeMethod)

instance ToJSON Route where
  toJSON :: Route -> Value
toJSON Route {Maybe RouteDescription
Maybe RouteSummary
Method
Set Auth
Set Param
Set HeaderRep
Path
Request
Responses
_routeMethod :: Route -> Method
_routePath :: Route -> Path
_routeParams :: Route -> Set Param
_routeRequestHeaders :: Route -> Set HeaderRep
_routeRequestBody :: Route -> Request
_routeResponse :: Route -> Responses
_routeAuths :: Route -> Set Auth
_routeDescription :: Route -> Maybe RouteDescription
_routeSummary :: Route -> Maybe RouteSummary
_routeMethod :: Method
_routePath :: Path
_routeParams :: Set Param
_routeRequestHeaders :: Set HeaderRep
_routeRequestBody :: Request
_routeResponse :: Responses
_routeAuths :: Set Auth
_routeDescription :: Maybe RouteDescription
_routeSummary :: Maybe RouteSummary
..} =
    [Pair] -> Value
object
      [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Method -> Text
TE.decodeUtf8 Method
_routeMethod
      , Key
"path" Key -> Path -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Path
_routePath
      , Key
"params" Key -> Set Param -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Param
_routeParams
      , Key
"request_headers" Key -> Set HeaderRep -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set HeaderRep
_routeRequestHeaders
      , Key
"request_body" Key -> Request -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Request
_routeRequestBody
      , Key
"response" Key -> Responses -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Responses
_routeResponse
      , Key
"auths" Key -> Set Auth -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Auth
_routeAuths
      , Key
"description" Key -> Maybe RouteDescription -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe RouteDescription
_routeDescription
      , Key
"summary" Key -> Maybe RouteSummary -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe RouteSummary
_routeSummary
      ]