{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (?~))
import Data.Maybe (fromMaybe)
import Data.OpenApi hiding (Response)
import Data.OpenApi.Declare (runDeclare)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response (..))
import WebGear.Core.Trait (Get (..), Linked, Set (..))
import WebGear.Core.Trait.Body (Body (..), JSONBody (..))
import WebGear.OpenApi.Handler (
  DocNode (DocRequestBody, DocResponseBody),
  OpenApiHandler (..),
  singletonNode,
 )

instance ToSchema val => Get (OpenApiHandler m) (Body val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: Body val -> OpenApiHandler m (Linked ts Request) (Either Text val)
  getTrait :: Body val -> OpenApiHandler m (Linked ts Request) (Either Text val)
getTrait (Body Maybe MediaType
maybeMediaType) =
    let mediaType :: MediaType
mediaType = MediaType -> Maybe MediaType -> MediaType
forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val) Definitions Schema
forall a. Monoid a => a
mempty
        body :: RequestBody
body =
          (Monoid RequestBody => RequestBody
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
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
.~ [(MediaType
mediaType, Monoid MediaTypeObject => MediaTypeObject
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
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 (Linked ts Request) (Either Text val)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (Linked ts Request) (Either Text val))
-> Tree DocNode
-> OpenApiHandler m (Linked ts Request) (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 => Set (OpenApiHandler m) (Body val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait ::
    Body val ->
    (Linked ts Response -> Response -> val -> Linked (Body val : ts) Response) ->
    OpenApiHandler m (Linked ts Response, val) (Linked (Body val : ts) Response)
  setTrait :: Body val
-> (Linked ts Response
    -> Response -> val -> Linked (Body val : ts) Response)
-> OpenApiHandler
     m (Linked ts Response, val) (Linked (Body val : ts) Response)
setTrait (Body Maybe MediaType
maybeMediaType) Linked ts Response
-> Response -> val -> Linked (Body val : ts) Response
_ =
    let mediaType :: MediaType
mediaType = MediaType -> Maybe MediaType -> MediaType
forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val) Definitions Schema
forall a. Monoid a => a
mempty
        body :: MediaTypeObject
body = Monoid MediaTypeObject => MediaTypeObject
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
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 (Linked ts Response, val) (Linked (Body val : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m (Linked ts Response, val) (Linked (Body val : ts) Response))
-> Tree DocNode
-> OpenApiHandler
     m (Linked ts Response, val) (Linked (Body val : ts) Response)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Definitions Schema -> MediaType -> MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
body)

instance ToSchema val => Get (OpenApiHandler m) (JSONBody val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: JSONBody val -> OpenApiHandler m (Linked ts Request) (Either Text val)
  getTrait :: JSONBody val
-> OpenApiHandler m (Linked ts Request) (Either Text val)
getTrait (JSONBody Maybe MediaType
maybeMediaType) = Body val
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Body val) Request) (Attribute (Body val) Request))
forall (h :: * -> * -> *) t a (ts :: [*]).
Get h t a =>
t -> h (Linked ts a) (Either (Absence t a) (Attribute t a))
getTrait (Maybe MediaType -> Body val
forall t. Maybe MediaType -> Body t
Body @val Maybe MediaType
maybeMediaType)

instance ToSchema val => Set (OpenApiHandler m) (JSONBody val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait ::
    JSONBody val ->
    (Linked ts Response -> Response -> t -> Linked (JSONBody val : ts) Response) ->
    OpenApiHandler m (Linked ts Response, t) (Linked (JSONBody val : ts) Response)
  setTrait :: JSONBody val
-> (Linked ts Response
    -> Response -> t -> Linked (JSONBody val : ts) Response)
-> OpenApiHandler
     m (Linked ts Response, t) (Linked (JSONBody val : ts) Response)
setTrait (JSONBody Maybe MediaType
maybeMediaType) Linked ts Response
-> Response -> t -> Linked (JSONBody val : ts) Response
_ =
    let mediaType :: MediaType
mediaType = MediaType -> Maybe MediaType -> MediaType
forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val) Definitions Schema
forall a. Monoid a => a
mempty
        body :: MediaTypeObject
body = Monoid MediaTypeObject => MediaTypeObject
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
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 (Linked ts Response, t) (Linked (JSONBody val : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m (Linked ts Response, t) (Linked (JSONBody val : ts) Response))
-> Tree DocNode
-> OpenApiHandler
     m (Linked ts Response, t) (Linked (JSONBody val : ts) Response)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Definitions Schema -> MediaType -> MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
body)