{-# 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 :: forall (ts :: [*]).
Body val -> OpenApiHandler m (Linked ts Request) (Either Text val)
getTrait (Body Maybe MediaType
maybeMediaType) =
    let mediaType :: MediaType
mediaType = forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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
.~ [(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 => 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 :: forall (ts :: [*]).
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 = forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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 -> 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 :: forall (ts :: [*]).
JSONBody val
-> OpenApiHandler m (Linked ts Request) (Either Text val)
getTrait (JSONBody Maybe MediaType
maybeMediaType) = forall (h :: * -> * -> *) t a (ts :: [*]).
Get h t a =>
t -> h (Linked ts a) (Either (Absence t a) (Attribute t a))
getTrait (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 :: forall (ts :: [*]) t.
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 = forall a. a -> Maybe a -> a
fromMaybe MediaType
"*/*" Maybe MediaType
maybeMediaType
        (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 -> MediaType -> MediaTypeObject -> DocNode
DocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
body)