{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (?~))
import Data.Proxy (Proxy (..))
import Data.Swagger hiding (Response)
import Data.Swagger.Declare (runDeclare)
import Data.Text (Text)
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.Swagger.Handler (
  DocNode (DocRequestBody, DocResponseBody),
  SwaggerHandler (..),
  singletonNode,
 )

instance (ToSchema val, MIMEType mt) => Get (SwaggerHandler m) (Body mt val) Request where
  {-# INLINE getTrait #-}
  getTrait :: Body mt val -> SwaggerHandler m (Request `With` ts) (Either Text val)
  getTrait :: forall (ts :: [*]).
Body mt val -> SwaggerHandler m (With Request ts) (Either Text val)
getTrait (Body mt
mt) =
    let mimeList :: MimeList
mimeList = [MediaType] -> MimeList
MimeList [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 :: Param
body =
          forall a. Monoid a => a
mempty @Param
            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 b -> b -> s -> t
.~ Referenced Schema -> ParamAnySchema
ParamBody Referenced Schema
ref
            forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
            forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"body"
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema -> MimeList -> Param -> DocNode
DocRequestBody Definitions Schema
defs MimeList
mimeList Param
body)

instance (ToSchema val, MIMEType mt) => Set (SwaggerHandler m) (Body mt val) Response where
  {-# INLINE setTrait #-}
  setTrait ::
    Body mt val ->
    (Response `With` ts -> Response -> val -> Response `With` (Body mt val : ts)) ->
    SwaggerHandler 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))
-> SwaggerHandler
     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 mimeList :: MimeList
mimeList = [MediaType] -> MimeList
MimeList [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
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema
-> MimeList -> Maybe (Referenced Schema) -> DocNode
DocResponseBody Definitions Schema
defs MimeList
mimeList (forall a. a -> Maybe a
Just Referenced Schema
ref))

instance Set (SwaggerHandler m) UnknownContentBody Response where
  {-# INLINE setTrait #-}
  setTrait ::
    UnknownContentBody ->
    (Response `With` ts -> Response -> ResponseBody -> Response `With` (UnknownContentBody : ts)) ->
    SwaggerHandler m (Response `With` ts, ResponseBody) (Response `With` (UnknownContentBody : ts))
  setTrait :: forall (ts :: [*]).
UnknownContentBody
-> (With Response ts
    -> Response
    -> ResponseBody
    -> With Response (UnknownContentBody : ts))
-> SwaggerHandler
     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 -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Definitions Schema
-> MimeList -> Maybe (Referenced Schema) -> DocNode
DocResponseBody forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Maybe a
Nothing)