{-# LANGUAGE TemplateHaskell #-}

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

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

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

import Data.Aeson
import Data.Function (on)
import qualified Data.Set as Set
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

-- | 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
  }
  deriving (Int -> Route -> ShowS
[Route] -> ShowS
Route -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Route] -> ShowS
$cshowList :: [Route] -> ShowS
show :: Route -> String
$cshow :: Route -> String
showsPrec :: Int -> Route -> ShowS
$cshowsPrec :: Int -> Route -> ShowS
Show, Route -> Route -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Route -> Route -> Bool
$c/= :: Route -> Route -> Bool
== :: Route -> Route -> Bool
$c== :: Route -> Route -> Bool
Eq)

makeLenses ''Route

instance Ord Route where
  compare :: Route -> Route -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \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
..} -> (Path
_routePath, Method
_routeMethod)

instance ToJSON Route where
  toJSON :: Route -> Value
toJSON 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
..} =
    [Pair] -> Value
object
      [ Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method -> Text
TE.decodeUtf8 Method
_routeMethod
      , Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Path
_routePath
      , Key
"params" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Set Param
_routeParams
      , Key
"request_headers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Set HeaderRep
_routeRequestHeaders
      , Key
"request_body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Request
_routeRequestBody
      , Key
"response" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Responses
_routeResponse
      , Key
"auths" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Set Auth
_routeAuths
      ]