{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (?~))
import Data.OpenApi hiding (Response)
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
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 (..), Trait, TraitAbsence)
import qualified WebGear.Core.Trait.Header as WG
import WebGear.OpenApi.Handler (DocNode (..), OpenApiHandler (..), nullNode, singletonNode)

mkParam ::
  forall name val.
  (KnownSymbol name, ToSchema val) =>
  Proxy name ->
  Proxy val ->
  Bool ->
  Param
mkParam :: forall (name :: Symbol) val.
(KnownSymbol name, ToSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam Proxy name
_ Proxy val
_ Bool
isRequired =
  (forall a. Monoid a => a
mempty :: Param)
    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
.~ forall a. IsString a => String -> a
fromString @Text (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @name)
    forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamHeader
    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
isRequired
    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
?~ forall a. a -> Referenced a
Inline (forall a. ToSchema a => Proxy a -> Schema
toSchema forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @val)

instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Required ps name val) Request) => Get (OpenApiHandler m) (WG.Header Required ps name val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: forall (ts :: [*]).
Header 'Required ps name val
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Required ps name val) Request)
        (Attribute (Header 'Required ps name val) Request))
getTrait Header 'Required ps name val
WG.Header =
    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 (Param -> DocNode
DocRequestHeader forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) val.
(KnownSymbol name, ToSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (forall {k} (t :: k). Proxy t
Proxy @name) (forall {k} (t :: k). Proxy t
Proxy @val) Bool
True)

instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Optional ps name val) Request) => Get (OpenApiHandler m) (WG.Header Optional ps name val) Request where
  {-# INLINEABLE getTrait #-}
  getTrait :: forall (ts :: [*]).
Header 'Optional ps name val
-> OpenApiHandler
     m
     (Linked ts Request)
     (Either
        (Absence (Header 'Optional ps name val) Request)
        (Attribute (Header 'Optional ps name val) Request))
getTrait Header 'Optional ps name val
WG.Header =
    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 (Param -> DocNode
DocRequestHeader forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) val.
(KnownSymbol name, ToSchema val) =>
Proxy name -> Proxy val -> Bool -> Param
mkParam (forall {k} (t :: k). Proxy t
Proxy @name) (forall {k} (t :: k). Proxy t
Proxy @val) Bool
False)

instance (KnownSymbol name, ToSchema val, Trait (WG.Header Required ps name val) Response) => Set (OpenApiHandler m) (WG.Header Required ps name val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait :: forall (ts :: [*]).
Header 'Required ps name val
-> (Linked ts Response
    -> Response
    -> Attribute (Header 'Required ps name val) Response
    -> Linked (Header 'Required ps name val : ts) Response)
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Required ps name val) Response)
     (Linked (Header 'Required ps name val : ts) Response)
setTrait Header 'Required ps name val
WG.Header Linked ts Response
-> Response
-> Attribute (Header 'Required ps name val) Response
-> Linked (Header 'Required ps name val : ts) Response
_ =
    let headerName :: Text
headerName = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @name
        header :: Header
header =
          forall a. Monoid a => a
mempty @Header
            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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline (forall a. ToSchema a => Proxy a -> Schema
toSchema forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @val)
     in if Text
headerName forall a. Eq a => a -> a -> Bool
== Text
"Content-Type"
          then forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a. Tree a
nullNode
          else 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 (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)

instance (KnownSymbol name, ToSchema val, Trait (WG.Header Optional ps name val) Response) => Set (OpenApiHandler m) (WG.Header Optional ps name val) Response where
  {-# INLINEABLE setTrait #-}
  setTrait :: forall (ts :: [*]).
Header 'Optional ps name val
-> (Linked ts Response
    -> Response
    -> Attribute (Header 'Optional ps name val) Response
    -> Linked (Header 'Optional ps name val : ts) Response)
-> OpenApiHandler
     m
     (Linked ts Response,
      Attribute (Header 'Optional ps name val) Response)
     (Linked (Header 'Optional ps name val : ts) Response)
setTrait Header 'Optional ps name val
WG.Header Linked ts Response
-> Response
-> Attribute (Header 'Optional ps name val) Response
-> Linked (Header 'Optional ps name val : ts) Response
_ =
    let headerName :: Text
headerName = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @name
        header :: Header
header =
          forall a. Monoid a => a
mempty @Header
            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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline (forall a. ToSchema a => Proxy a -> Schema
toSchema forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @val)
     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 (Text -> Header -> DocNode
DocResponseHeader Text
headerName Header
header)