{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (.~), (<>~))
import Control.Monad.State.Strict (MonadState)
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import Data.Swagger (
  Param (..),
  ParamAnySchema (..),
  ParamLocation (ParamQuery),
  ParamOtherSchema (..),
  Referenced (Inline),
  Swagger,
  allOperations,
  description,
  parameters,
 )
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.Swagger.Handler (Documentation (..), SwaggerHandler (..), consumeDescription)

instance (KnownSymbol name) => Get (SwaggerHandler m) (QueryParam Required ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (QueryParam 'Required ps name val) ts =>
QueryParam 'Required ps name val
-> SwaggerHandler
     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
            , _paramRequired = Just True
            , _paramSchema =
                ParamOther
                  ParamOtherSchema
                    { _paramOtherSchemaIn = ParamQuery
                    , _paramOtherSchemaAllowEmptyValue = Just True
                    , _paramOtherSchemaParamSchema = mempty
                    }
            }
     in (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     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).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler ((Swagger -> State Documentation Swagger)
 -> SwaggerHandler
      m
      (With Request ts)
      (Either
         (Absence (QueryParam 'Required ps name val))
         (Attribute (QueryParam 'Required ps name val) Request)))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     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 -> Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Param -> Swagger -> m Swagger
addParam Param
param

instance (KnownSymbol name) => Get (SwaggerHandler m) (QueryParam Optional ps name val) where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite (QueryParam 'Optional ps name val) ts =>
QueryParam 'Optional ps name val
-> SwaggerHandler
     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
            , _paramRequired = Just False
            , _paramSchema =
                ParamOther
                  ParamOtherSchema
                    { _paramOtherSchemaIn = ParamQuery
                    , _paramOtherSchemaAllowEmptyValue = Just True
                    , _paramOtherSchemaParamSchema = mempty
                    }
            }
     in (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     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).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler ((Swagger -> State Documentation Swagger)
 -> SwaggerHandler
      m
      (With Request ts)
      (Either
         (Absence (QueryParam 'Optional ps name val))
         (Attribute (QueryParam 'Optional ps name val) Request)))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     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 -> Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Param -> Swagger -> m Swagger
addParam Param
param

addParam :: (MonadState Documentation m) => Param -> Swagger -> m Swagger
addParam :: forall (m :: * -> *).
MonadState Documentation m =>
Param -> Swagger -> m Swagger
addParam Param
param Swagger
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
  Swagger -> m Swagger
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Swagger -> m Swagger) -> Swagger -> m Swagger
forall a b. (a -> b) -> a -> b
$ Swagger
doc Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> Swagger
-> Identity Swagger
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])
 -> Swagger -> Identity Swagger)
-> [Referenced Param] -> Swagger -> Swagger
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']