{-# OPTIONS_GHC -Wno-orphans #-}

-- | OpenApi implementation of 'Body' trait.
module WebGear.OpenApi.Trait.Body where

import Control.Lens ((&), (.~), (?~))
import Data.OpenApi hiding (Response, contentType)
import Data.OpenApi.Declare (runDeclare)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import GHC.Exts (fromList)
import WebGear.Core.MIMETypes (MIMEType (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response (..), ResponseBody)
import WebGear.Core.Trait (Get (..), Set (..), With)
import WebGear.Core.Trait.Body (Body (..), UnknownContentBody (..))
import WebGear.OpenApi.Handler (
  DocNode (DocRequestBody, DocResponseBody),
  OpenApiHandler (..),
  singletonNode,
 )

instance (ToSchema val, MIMEType mt) => Get (OpenApiHandler m) (Body mt val) Request where
  {-# INLINE getTrait #-}
  getTrait :: Body mt val -> OpenApiHandler m (Request `With` ts) (Either Text val)
  getTrait :: forall (ts :: [*]).
Body mt val -> OpenApiHandler m (With Request ts) (Either Text val)
getTrait (Body mt
mt) =
    let mediaType :: MediaType
mediaType = forall mt. MIMEType mt => mt -> MediaType
mimeType mt
mt
        (Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @val) forall a. Monoid a => a
mempty
        body :: RequestBody
body =
          (forall a. Monoid a => a
mempty @RequestBody)
            forall a b. a -> (a -> b) -> b
& forall s a. HasContent s a => Lens' s a
content forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall l. IsList l => [Item l] -> l
fromList [(MediaType
mediaType, forall a. Monoid a => a
mempty @MediaTypeObject forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref)]
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema -> RequestBody -> DocNode
DocRequestBody Definitions Schema
defs RequestBody
body)

instance (ToSchema val, MIMEType mt) => Set (OpenApiHandler m) (Body mt val) Response where
  {-# INLINE setTrait #-}
  setTrait ::
    Body mt val ->
    (Response `With` ts -> Response -> val -> Response `With` (Body mt val : ts)) ->
    OpenApiHandler m (Response `With` ts, val) (Response `With` (Body mt val : ts))
  setTrait :: forall (ts :: [*]).
Body mt val
-> (With Response ts
    -> Response -> val -> With Response (Body mt val : ts))
-> OpenApiHandler
     m (With Response ts, val) (With Response (Body mt val : ts))
setTrait (Body mt
mt) With Response ts
-> Response -> val -> With Response (Body mt val : ts)
_ =
    let mediaType :: MediaType
mediaType = forall mt. MIMEType mt => mt -> MediaType
mimeType mt
mt
        (Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @val) forall a. Monoid a => a
mempty
        body :: MediaTypeObject
body = forall a. Monoid a => a
mempty @MediaTypeObject forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema
-> InsOrdHashMap MediaType MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
defs forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
fromList [(MediaType
mediaType, MediaTypeObject
body)])

instance Set (OpenApiHandler m) UnknownContentBody Response where
  {-# INLINE setTrait #-}
  setTrait ::
    UnknownContentBody ->
    (Response `With` ts -> Response -> ResponseBody -> Response `With` (UnknownContentBody : ts)) ->
    OpenApiHandler m (Response `With` ts, ResponseBody) (Response `With` (UnknownContentBody : ts))
  setTrait :: forall (ts :: [*]).
UnknownContentBody
-> (With Response ts
    -> Response
    -> ResponseBody
    -> With Response (UnknownContentBody : ts))
-> OpenApiHandler
     m
     (With Response ts, ResponseBody)
     (With Response (UnknownContentBody : ts))
setTrait UnknownContentBody
UnknownContentBody With Response ts
-> Response
-> ResponseBody
-> With Response (UnknownContentBody : ts)
_ = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema
-> InsOrdHashMap MediaType MediaTypeObject -> DocNode
DocResponseBody forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)