{-# 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 = mt -> MediaType
forall mt. MIMEType mt => mt -> MediaType
mimeType mt
mt
        (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy val -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy val -> Declare (Definitions Schema) (Referenced Schema))
-> Proxy val -> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Definitions Schema
forall a. Monoid a => a
mempty
        body :: RequestBody
body =
          (forall a. Monoid a => a
mempty @RequestBody)
            RequestBody -> (RequestBody -> RequestBody) -> RequestBody
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
 -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> RequestBody -> Identity RequestBody
forall s a. HasContent s a => Lens' s a
Lens' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
content ((InsOrdHashMap MediaType MediaTypeObject
  -> Identity (InsOrdHashMap MediaType MediaTypeObject))
 -> RequestBody -> Identity RequestBody)
-> InsOrdHashMap MediaType MediaTypeObject
-> RequestBody
-> RequestBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (InsOrdHashMap MediaType MediaTypeObject)]
-> InsOrdHashMap MediaType MediaTypeObject
forall l. IsList l => [Item l] -> l
fromList [(MediaType
mediaType, forall a. Monoid a => a
mempty @MediaTypeObject MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
Lens' MediaTypeObject (Maybe (Referenced Schema))
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref)]
     in Tree DocNode
-> OpenApiHandler m (With Request ts) (Either Text val)
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (With Request ts) (Either Text val))
-> Tree DocNode
-> OpenApiHandler m (With Request ts) (Either Text val)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
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 = mt -> MediaType
forall mt. MIMEType mt => mt -> MediaType
mimeType mt
mt
        (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy val -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy val -> Declare (Definitions Schema) (Referenced Schema))
-> Proxy val -> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Definitions Schema
forall a. Monoid a => a
mempty
        body :: MediaTypeObject
body = forall a. Monoid a => a
mempty @MediaTypeObject MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
Lens' MediaTypeObject (Maybe (Referenced Schema))
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref
     in Tree DocNode
-> OpenApiHandler
     m (With Response ts, val) (With Response (Body mt val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m (With Response ts, val) (With Response (Body mt val : ts)))
-> Tree DocNode
-> OpenApiHandler
     m (With Response ts, val) (With Response (Body mt val : ts))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Definitions Schema
-> InsOrdHashMap MediaType MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
defs (InsOrdHashMap MediaType MediaTypeObject -> DocNode)
-> InsOrdHashMap MediaType MediaTypeObject -> DocNode
forall a b. (a -> b) -> a -> b
$ [Item (InsOrdHashMap MediaType MediaTypeObject)]
-> InsOrdHashMap MediaType MediaTypeObject
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)
_ = Tree DocNode
-> OpenApiHandler
     m
     (With Response ts, ResponseBody)
     (With Response (UnknownContentBody : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m
      (With Response ts, ResponseBody)
      (With Response (UnknownContentBody : ts)))
-> Tree DocNode
-> OpenApiHandler
     m
     (With Response ts, ResponseBody)
     (With Response (UnknownContentBody : ts))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Definitions Schema
-> InsOrdHashMap MediaType MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
forall a. Monoid a => a
mempty InsOrdHashMap MediaType MediaTypeObject
forall a. Monoid a => a
mempty)