{-# OPTIONS_GHC -Wno-orphans #-}

-- | Swagger implementation of 'Header' trait.
module WebGear.Swagger.Trait.Header () where

import Control.Lens ((&), (.~), (?~))
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import Data.Swagger hiding (Response)
import Data.Text (Text)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Modifiers (Existence (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Get (..), Set (..), TraitAbsence)
import qualified WebGear.Core.Trait.Header as WG
import WebGear.Swagger.Handler (DocNode (..), SwaggerHandler (..), nullNode, singletonNode)

mkParam ::
  forall name val.
  (KnownSymbol name, ToParamSchema val) =>
  Proxy name ->
  Proxy val ->
  Bool ->
  Param
mkParam :: forall (name :: Symbol) val.
(KnownSymbol name, ToParamSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam Proxy name
proxyName Proxy val
proxyVal Bool
isRequired =
  (Param
forall a. Monoid a => a
mempty :: Param)
    Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
Lens' Param Text
name ((Text -> Identity Text) -> Param -> Identity Param)
-> Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. IsString a => String -> a
fromString @Text (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
proxyName)
    Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
Lens' Param (Maybe Bool)
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
isRequired
    Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
Lens' Param ParamAnySchema
schema
      ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther
        ( ParamOtherSchema
            { _paramOtherSchemaIn :: ParamLocation
_paramOtherSchemaIn = ParamLocation
ParamHeader
            , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
_paramOtherSchemaAllowEmptyValue = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Bool
not Bool
isRequired)
            , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
_paramOtherSchemaParamSchema = Proxy val -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
forall (t :: SwaggerKind (*)). Proxy val -> ParamSchema t
toParamSchema Proxy val
proxyVal
            }
        )

instance
  ( KnownSymbol name
  , ToParamSchema val
  , TraitAbsence (WG.RequestHeader Required ps name val) Request
  ) =>
  Get (SwaggerHandler m) (WG.RequestHeader Required ps name val) Request
  where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (RequestHeader 'Required ps name val) ts Request =>
RequestHeader 'Required ps name val
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val) Request)
        (Attribute (RequestHeader 'Required ps name val) Request))
getTrait RequestHeader 'Required ps name val
WG.RequestHeader =
    Tree DocNode
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val) Request)
        (Attribute (RequestHeader 'Required ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode
 -> SwaggerHandler
      m
      (With Request ts)
      (Either
         (Absence (RequestHeader 'Required ps name val) Request)
         (Attribute (RequestHeader 'Required ps name val) Request)))
-> Tree DocNode
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Required ps name val) Request)
        (Attribute (RequestHeader 'Required ps name val) Request))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Param -> DocNode
DocRequestHeader (Param -> DocNode) -> Param -> DocNode
forall a b. (a -> b) -> a -> b
$ Proxy name -> Proxy val -> Bool -> Param
forall (name :: Symbol) val.
(KnownSymbol name, ToParamSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
True)

instance
  ( KnownSymbol name
  , ToParamSchema val
  , TraitAbsence (WG.RequestHeader Optional ps name val) Request
  ) =>
  Get (SwaggerHandler m) (WG.RequestHeader Optional ps name val) Request
  where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (RequestHeader 'Optional ps name val) ts Request =>
RequestHeader 'Optional ps name val
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val) Request)
        (Attribute (RequestHeader 'Optional ps name val) Request))
getTrait RequestHeader 'Optional ps name val
WG.RequestHeader =
    Tree DocNode
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val) Request)
        (Attribute (RequestHeader 'Optional ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode
 -> SwaggerHandler
      m
      (With Request ts)
      (Either
         (Absence (RequestHeader 'Optional ps name val) Request)
         (Attribute (RequestHeader 'Optional ps name val) Request)))
-> Tree DocNode
-> SwaggerHandler
     m
     (With Request ts)
     (Either
        (Absence (RequestHeader 'Optional ps name val) Request)
        (Attribute (RequestHeader 'Optional ps name val) Request))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Param -> DocNode
DocRequestHeader (Param -> DocNode) -> Param -> DocNode
forall a b. (a -> b) -> a -> b
$ Proxy name -> Proxy val -> Bool -> Param
forall (name :: Symbol) val.
(KnownSymbol name, ToParamSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val) Bool
False)

instance (KnownSymbol name) => Set (SwaggerHandler m) (WG.ResponseHeader Required name val) Response where
  {-# INLINE setTrait #-}
  setTrait :: forall (ts :: [*]).
ResponseHeader 'Required name val
-> (With Response ts
    -> Response
    -> Attribute (ResponseHeader 'Required name val) Response
    -> With Response (ResponseHeader 'Required name val : ts))
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
setTrait ResponseHeader 'Required name val
WG.ResponseHeader With Response ts
-> Response
-> Attribute (ResponseHeader 'Required name val) Response
-> With Response (ResponseHeader 'Required name val : ts)
_ =
    let headerName :: Text
headerName = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name
        header :: Header
header = forall a. Monoid a => a
mempty @Header
     in if Text
headerName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Content-Type"
          then Tree DocNode
-> SwaggerHandler
     m
     (With Response ts, val)
     (With Response (ResponseHeader 'Required name val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler Tree DocNode
forall a. Tree a
nullNode
          else Tree DocNode
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode
 -> SwaggerHandler
      m
      (With Response ts,
       Attribute (ResponseHeader 'Required name val) Response)
      (With Response (ResponseHeader 'Required name val : ts)))
-> Tree DocNode
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Required name val) Response)
     (With Response (ResponseHeader 'Required name val : ts))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)

instance (KnownSymbol name) => Set (SwaggerHandler m) (WG.ResponseHeader Optional name val) Response where
  {-# INLINE setTrait #-}
  setTrait :: forall (ts :: [*]).
ResponseHeader 'Optional name val
-> (With Response ts
    -> Response
    -> Attribute (ResponseHeader 'Optional name val) Response
    -> With Response (ResponseHeader 'Optional name val : ts))
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
setTrait ResponseHeader 'Optional name val
WG.ResponseHeader With Response ts
-> Response
-> Attribute (ResponseHeader 'Optional name val) Response
-> With Response (ResponseHeader 'Optional name val : ts)
_ =
    let headerName :: Text
headerName = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name
        header :: Header
header = forall a. Monoid a => a
mempty @Header
     in Tree DocNode
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode
 -> SwaggerHandler
      m
      (With Response ts,
       Attribute (ResponseHeader 'Optional name val) Response)
      (With Response (ResponseHeader 'Optional name val : ts)))
-> Tree DocNode
-> SwaggerHandler
     m
     (With Response ts,
      Attribute (ResponseHeader 'Optional name val) Response)
     (With Response (ResponseHeader 'Optional name val : ts))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)