-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The documented operation view of a route, as plain OpenAPI-free data.

'specsOf' erases an "Ecluse.Core.Server.Route".'Route' into the operations the
capability manifest needs. A write route contributes @PUT@. A read route contributes
both @GET@ and its derived bodiless @HEAD@ operation. The capture type, builder, and
typed response value disappear, but each operation's 'ResponseDoc's are projected from
the same 'Ecluse.Core.Server.Contract.ResponseContract' runtime dispatch uses.
-}
module Ecluse.Core.Server.RouteSpec (
    -- * The documented view
    RouteSpec (..),
    PathSeg (..),
    ParamSpec (..),

    -- * Projection from a route
    specsOf,
) where

import Network.HTTP.Types.Method (StdMethod (GET, HEAD, PUT))

import Ecluse.Core.Server.Contract (RequestSpec, ResponseDoc, bodilessContract, responseDocs)
import Ecluse.Core.Server.Route (
    Capture (capDescription, capName),
    MethodMatch (MethodPut, MethodRead),
    PatternSeg (SegCap, SegLit),
    Route (Route, routeContract, routeDescription, routeMethod, routeName, routeRequest, routeSegs, routeSummary),
    RouteName (RouteName, unRouteName),
 )

{- | One served HTTP operation: its name, exact method, path template, prose, request,
and response documents.

Not 'Eq'\/ 'Show': response and request schemas may carry @autodocodec@ codecs, which
are functions.
-}
data RouteSpec = RouteSpec
    { RouteSpec -> RouteName
rsName :: RouteName
    -- ^ The operation name within its ecosystem; @HEAD@ projections carry a @.head@ suffix.
    , RouteSpec -> StdMethod
rsMethod :: StdMethod
    -- ^ The exact HTTP method this operation serves.
    , RouteSpec -> [PathSeg]
rsPattern :: [PathSeg]
    -- ^ The mount-relative path template.
    , RouteSpec -> Text
rsSummary :: Text
    -- ^ A one-line summary.
    , RouteSpec -> Text
rsDescription :: Text
    -- ^ The fuller operation description.
    , RouteSpec -> Maybe RequestSpec
rsRequest :: Maybe RequestSpec
    -- ^ The accepted request body, when any.
    , RouteSpec -> [ResponseDoc]
rsOutcomes :: [ResponseDoc]
    -- ^ The responses projected from the operation's runtime contract.
    }

-- | One literal or captured path segment.
data PathSeg
    = Lit Text
    | Param ParamSpec
    deriving stock (PathSeg -> PathSeg -> Bool
(PathSeg -> PathSeg -> Bool)
-> (PathSeg -> PathSeg -> Bool) -> Eq PathSeg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathSeg -> PathSeg -> Bool
== :: PathSeg -> PathSeg -> Bool
$c/= :: PathSeg -> PathSeg -> Bool
/= :: PathSeg -> PathSeg -> Bool
Eq, Int -> PathSeg -> ShowS
[PathSeg] -> ShowS
PathSeg -> String
(Int -> PathSeg -> ShowS)
-> (PathSeg -> String) -> ([PathSeg] -> ShowS) -> Show PathSeg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathSeg -> ShowS
showsPrec :: Int -> PathSeg -> ShowS
$cshow :: PathSeg -> String
show :: PathSeg -> String
$cshowList :: [PathSeg] -> ShowS
showList :: [PathSeg] -> ShowS
Show)

-- | A named path parameter and its human-facing description.
data ParamSpec = ParamSpec
    { ParamSpec -> Text
psName :: Text
    -- ^ The name as it appears in the template.
    , ParamSpec -> Text
psDescription :: Text
    -- ^ A one-line description.
    }
    deriving stock (ParamSpec -> ParamSpec -> Bool
(ParamSpec -> ParamSpec -> Bool)
-> (ParamSpec -> ParamSpec -> Bool) -> Eq ParamSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamSpec -> ParamSpec -> Bool
== :: ParamSpec -> ParamSpec -> Bool
$c/= :: ParamSpec -> ParamSpec -> Bool
/= :: ParamSpec -> ParamSpec -> Bool
Eq, Int -> ParamSpec -> ShowS
[ParamSpec] -> ShowS
ParamSpec -> String
(Int -> ParamSpec -> ShowS)
-> (ParamSpec -> String)
-> ([ParamSpec] -> ShowS)
-> Show ParamSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamSpec -> ShowS
showsPrec :: Int -> ParamSpec -> ShowS
$cshow :: ParamSpec -> String
show :: ParamSpec -> String
$cshowList :: [ParamSpec] -> ShowS
showList :: [ParamSpec] -> ShowS
Show)

{- | Project a route to every exact method it serves. The @HEAD@ contract is the
'bodilessContract' interpretation of the same response value used by @GET@, so its
status set cannot drift and neither its manifest nor wire response can carry a body.
-}
specsOf :: Route v -> [RouteSpec]
specsOf :: forall v. Route v -> [RouteSpec]
specsOf
    Route
        { routeName :: forall v. Route v -> RouteName
routeName = RouteName
name
        , routeMethod :: forall v. Route v -> MethodMatch
routeMethod = MethodMatch
matchedMethod
        , routeSegs :: forall v. Route v -> [PatternSeg v]
routeSegs = [PatternSeg v]
segments
        , routeSummary :: forall v. Route v -> Text
routeSummary = Text
summary
        , routeDescription :: forall v. Route v -> Text
routeDescription = Text
description
        , routeRequest :: forall v. Route v -> Maybe RequestSpec
routeRequest = Maybe RequestSpec
request
        , routeContract :: ()
routeContract = ResponseContract response
contract
        } = ((StdMethod, RouteName, ResponseContract response) -> RouteSpec)
-> [(StdMethod, RouteName, ResponseContract response)]
-> [RouteSpec]
forall a b. (a -> b) -> [a] -> [b]
map (StdMethod, RouteName, ResponseContract response) -> RouteSpec
forall {response}.
(StdMethod, RouteName, ResponseContract response) -> RouteSpec
operationSpec [(StdMethod, RouteName, ResponseContract response)]
operations
      where
        operations :: [(StdMethod, RouteName, ResponseContract response)]
operations = case MethodMatch
matchedMethod of
            MethodMatch
MethodRead -> [(StdMethod
GET, RouteName
name, ResponseContract response
contract), (StdMethod
HEAD, RouteName -> RouteName
headName RouteName
name, ResponseContract response -> ResponseContract response
forall response.
ResponseContract response -> ResponseContract response
bodilessContract ResponseContract response
contract)]
            MethodMatch
MethodPut -> [(StdMethod
PUT, RouteName
name, ResponseContract response
contract)]

        operationSpec :: (StdMethod, RouteName, ResponseContract response) -> RouteSpec
operationSpec (StdMethod
method, RouteName
operationName, ResponseContract response
operationContract) =
            RouteSpec
                { rsName :: RouteName
rsName = RouteName
operationName
                , rsMethod :: StdMethod
rsMethod = StdMethod
method
                , rsPattern :: [PathSeg]
rsPattern = (PatternSeg v -> PathSeg) -> [PatternSeg v] -> [PathSeg]
forall a b. (a -> b) -> [a] -> [b]
map PatternSeg v -> PathSeg
forall {v}. PatternSeg v -> PathSeg
paramOf [PatternSeg v]
segments
                , rsSummary :: Text
rsSummary = Text
summary
                , rsDescription :: Text
rsDescription = Text
description
                , rsRequest :: Maybe RequestSpec
rsRequest = Maybe RequestSpec
request
                , rsOutcomes :: [ResponseDoc]
rsOutcomes = ResponseContract response -> [ResponseDoc]
forall response. ResponseContract response -> [ResponseDoc]
responseDocs ResponseContract response
operationContract
                }

        headName :: RouteName -> RouteName
headName RouteName
routeName' = Text -> RouteName
RouteName (RouteName -> Text
unRouteName RouteName
routeName' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".head")

        paramOf :: PatternSeg v -> PathSeg
paramOf (SegLit Text
text) = Text -> PathSeg
Lit Text
text
        paramOf (SegCap Capture v
capture) = ParamSpec -> PathSeg
Param (Text -> Text -> ParamSpec
ParamSpec (Capture v -> Text
forall v. Capture v -> Text
capName Capture v
capture) (Capture v -> Text
forall v. Capture v -> Text
capDescription Capture v
capture))