{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (<>~))
import Control.Monad.State.Strict (MonadState)
import Data.OpenApi (
  OpenApi,
  Param (..),
  ParamLocation (ParamQuery),
  Referenced (Inline),
  ToSchema,
  allOperations,
  description,
  parameters,
  toSchema,
 )
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Handler (Description (..))
import WebGear.Core.Modifiers (Existence (..))
import WebGear.Core.Trait (Get (..))
import WebGear.Core.Trait.QueryParam (QueryParam (..))
import WebGear.OpenApi.Handler (Documentation (..), OpenApiHandler (..), consumeDescription)

instance (KnownSymbol name, ToSchema val) => Get (OpenApiHandler m) (QueryParam Required ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (QueryParam 'Required ps name val) ts =>
QueryParam 'Required ps name val
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Required ps name val))
        (Attribute (QueryParam 'Required ps name val) Request))
getTrait QueryParam 'Required ps name val
_ =
    let param :: Param
param =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName = fromString $ symbolVal $ Proxy @name
            , _paramIn = ParamQuery
            , _paramRequired = Just True
            , _paramSchema = Just $ Inline $ toSchema $ Proxy @val
            }
     in (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Required ps name val))
        (Attribute (QueryParam 'Required ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Request ts)
      (Either
         (Absence (QueryParam 'Required ps name val))
         (Attribute (QueryParam 'Required ps name val) Request)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Required ps name val))
        (Attribute (QueryParam 'Required ps name val) Request))
forall a b. (a -> b) -> a -> b
$ Param -> OpenApi -> State Documentation OpenApi
forall (m :: * -> *).
MonadState Documentation m =>
Param -> OpenApi -> m OpenApi
addParam Param
param

instance (KnownSymbol name, ToSchema val) => Get (OpenApiHandler m) (QueryParam Optional ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (QueryParam 'Optional ps name val) ts =>
QueryParam 'Optional ps name val
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Optional ps name val))
        (Attribute (QueryParam 'Optional ps name val) Request))
getTrait QueryParam 'Optional ps name val
_ =
    let param :: Param
param =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName = fromString $ symbolVal $ Proxy @name
            , _paramIn = ParamQuery
            , _paramRequired = Just False
            , _paramSchema = Just $ Inline $ toSchema $ Proxy @val
            }
     in (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Optional ps name val))
        (Attribute (QueryParam 'Optional ps name val) Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m
      (With Request ts)
      (Either
         (Absence (QueryParam 'Optional ps name val))
         (Attribute (QueryParam 'Optional ps name val) Request)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m
     (With Request ts)
     (Either
        (Absence (QueryParam 'Optional ps name val))
        (Attribute (QueryParam 'Optional ps name val) Request))
forall a b. (a -> b) -> a -> b
$ Param -> OpenApi -> State Documentation OpenApi
forall (m :: * -> *).
MonadState Documentation m =>
Param -> OpenApi -> m OpenApi
addParam Param
param

addParam :: (MonadState Documentation m) => Param -> OpenApi -> m OpenApi
addParam :: forall (m :: * -> *).
MonadState Documentation m =>
Param -> OpenApi -> m OpenApi
addParam Param
param OpenApi
doc = do
  Maybe Description
desc <- m (Maybe Description)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription
  let param' :: Param
param' = Param
param Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Description -> Text) -> Maybe Description -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
desc
  OpenApi -> m OpenApi
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenApi -> m OpenApi) -> OpenApi -> m OpenApi
forall a b. (a -> b) -> a -> b
$ OpenApi
doc OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
Lens' Operation [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> OpenApi -> Identity OpenApi)
-> [Referenced Param] -> OpenApi -> OpenApi
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param']