{-# LANGUAGE TemplateHaskell #-}

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

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

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

import Data.Aeson
import qualified Data.Aeson.Key as AK (fromText)
import Data.Function (on)
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.Header
import "this" Servant.API.Routes.Internal.Body
import "this" Servant.API.Routes.Param
import "this" Servant.API.Routes.Path
import "this" Servant.API.Routes.Utils

{- | A simple representation of a single endpoint of an API.

The 'Route' type is not sophisticated, and its internals are hidden.
Create 'Route's using 'defRoute', and update its fields using the provided [lenses](#g:optics).
-}
data Route = Route
  { Route -> Method
_routeMethod :: Method
  , Route -> Path
_routePath :: Path
  , Route -> [Param]
_routeParams :: [Param]
  , Route -> [HeaderRep]
_routeRequestHeaders :: [HeaderRep]
  , Route -> Body
_routeRequestBody :: Body
  , Route -> [HeaderRep]
_routeResponseHeaders :: [HeaderRep]
  , Route -> Body
_routeResponseType :: Body
  , Route -> [Text]
_routeAuths :: [T.Text]
  }
  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 {[Text]
[Param]
[HeaderRep]
Method
Path
Body
_routeAuths :: [Text]
_routeResponseType :: Body
_routeResponseHeaders :: [HeaderRep]
_routeRequestBody :: Body
_routeRequestHeaders :: [HeaderRep]
_routeParams :: [Param]
_routePath :: Path
_routeMethod :: Method
_routeAuths :: Route -> [Text]
_routeResponseType :: Route -> Body
_routeResponseHeaders :: Route -> [HeaderRep]
_routeRequestBody :: Route -> Body
_routeRequestHeaders :: Route -> [HeaderRep]
_routeParams :: Route -> [Param]
_routePath :: Route -> Path
_routeMethod :: Route -> Method
..} -> (Path
_routePath, Method
_routeMethod)

{- | 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 :: [Param]
_routeParams = forall a. Monoid a => a
mempty
    , _routeRequestHeaders :: [HeaderRep]
_routeRequestHeaders = forall a. Monoid a => a
mempty
    , _routeRequestBody :: Body
_routeRequestBody = forall a. Monoid a => a
mempty
    , _routeResponseHeaders :: [HeaderRep]
_routeResponseHeaders = forall a. Monoid a => a
mempty
    , _routeResponseType :: Body
_routeResponseType = forall a. Monoid a => a
mempty
    , _routeAuths :: [Text]
_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 'ToJSON' instance.

> ghci> showRoute $ defRoute \"POST\"
> "POST /"
> ghci> :{
> ghci| showRoute $
> 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]>"
-}
showRoute :: Route -> T.Text
showRoute :: Route -> Text
showRoute Route {[Text]
[Param]
[HeaderRep]
Method
Path
Body
_routeAuths :: [Text]
_routeResponseType :: Body
_routeResponseHeaders :: [HeaderRep]
_routeRequestBody :: Body
_routeRequestHeaders :: [HeaderRep]
_routeParams :: [Param]
_routePath :: Path
_routeMethod :: Method
_routeAuths :: Route -> [Text]
_routeResponseType :: Route -> Body
_routeResponseHeaders :: Route -> [HeaderRep]
_routeRequestBody :: Route -> Body
_routeRequestHeaders :: Route -> [HeaderRep]
_routeParams :: Route -> [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 [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
<$> [Param]
_routeParams)

bodyToJSONAs :: T.Text -> Body -> Value
bodyToJSONAs :: Text -> Body -> Value
bodyToJSONAs Text
lbl = \case
  Body
NoBody -> Value
Null
  OneType TypeRep
tRep -> TypeRep -> Value
typeRepToJSON TypeRep
tRep
  ManyTypes [TypeRep]
tReps ->
    [Pair] -> Value
object [Text -> Key
AK.fromText Text
lbl forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeRep -> Value
typeRepToJSON [TypeRep]
tReps]

instance ToJSON Route where
  toJSON :: Route -> Value
toJSON Route {[Text]
[Param]
[HeaderRep]
Method
Path
Body
_routeAuths :: [Text]
_routeResponseType :: Body
_routeResponseHeaders :: [HeaderRep]
_routeRequestBody :: Body
_routeRequestHeaders :: [HeaderRep]
_routeParams :: [Param]
_routePath :: Path
_routeMethod :: Method
_routeAuths :: Route -> [Text]
_routeResponseType :: Route -> Body
_routeResponseHeaders :: Route -> [HeaderRep]
_routeRequestBody :: Route -> Body
_routeRequestHeaders :: Route -> [HeaderRep]
_routeParams :: Route -> [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
.= [Param]
_routeParams
      , Key
"request_headers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [HeaderRep]
_routeRequestHeaders
      , Key
"request_body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Body -> Value
bodyToJSONAs Text
"all_of" Body
_routeRequestBody
      , Key
"response_headers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [HeaderRep]
_routeResponseHeaders
      , Key
"response" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Body -> Value
bodyToJSONAs Text
"one_of" Body
_routeResponseType
      , Key
"auths" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
_routeAuths
      ]