{-# OPTIONS_GHC -Wno-orphans #-}

-- | Swagger implementation of path traits.
module WebGear.Swagger.Trait.Path where

import Control.Lens ((&), (<>~))
import Data.Data (Proxy (Proxy))
import Data.String (fromString)
import Data.Swagger (
  Param (..),
  ParamAnySchema (..),
  ParamLocation (ParamPath),
  ParamOtherSchema (..),
  Referenced (Inline),
  allOperations,
  parameters,
  prependPath,
 )
import Data.Text (unpack)
import GHC.TypeLits (KnownSymbol, symbolVal)
import WebGear.Core.Request (Request)
import WebGear.Core.Trait (Get (..), With)
import WebGear.Core.Trait.Path (Path (..), PathEnd (..), PathVar (..), PathVarError (..))
import WebGear.Swagger.Handler (SwaggerHandler (..), addRouteDocumentation)

instance Get (SwaggerHandler m) Path where
  {-# INLINE getTrait #-}
  getTrait :: Path -> SwaggerHandler m (Request `With` ts) (Either () ())
  getTrait :: forall (ts :: [*]).
Path -> SwaggerHandler m (With Request ts) (Either () ())
getTrait (Path Text
p) = (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either () ())
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 () ()))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either () ())
forall a b. (a -> b) -> a -> b
$ Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Swagger -> m Swagger
addRouteDocumentation (Swagger -> State Documentation Swagger)
-> (Swagger -> Swagger) -> Swagger -> State Documentation Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Swagger -> Swagger
prependPath (Text -> FilePath
unpack Text
p)

instance (KnownSymbol tag) => Get (SwaggerHandler m) (PathVar tag val) where
  {-# INLINE getTrait #-}
  getTrait :: PathVar tag val -> SwaggerHandler m (Request `With` ts) (Either PathVarError val)
  getTrait :: forall (ts :: [*]).
PathVar tag val
-> SwaggerHandler m (With Request ts) (Either PathVarError val)
getTrait PathVar tag val
PathVar =
    let paramName :: FilePath
paramName = Proxy tag -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy tag -> FilePath) -> Proxy tag -> FilePath
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @tag
        param :: Param
param =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName = fromString paramName
            , _paramRequired = Just True
            , _paramSchema =
                ParamOther
                  ParamOtherSchema
                    { _paramOtherSchemaIn = ParamPath
                    , _paramOtherSchemaParamSchema = mempty
                    , _paramOtherSchemaAllowEmptyValue = Nothing
                    }
            }
     in (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either PathVarError val)
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 PathVarError val))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either PathVarError val)
forall a b. (a -> b) -> a -> b
$ \Swagger
doc ->
          Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Swagger -> m Swagger
addRouteDocumentation (Swagger -> State Documentation Swagger)
-> Swagger -> State Documentation Swagger
forall a b. (a -> b) -> a -> b
$
            FilePath -> Swagger -> Swagger
prependPath (FilePath
"{" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
paramName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"}") 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]

instance Get (SwaggerHandler m) PathEnd where
  {-# INLINE getTrait #-}
  getTrait :: PathEnd -> SwaggerHandler m (Request `With` ts) (Either () ())
  getTrait :: forall (ts :: [*]).
PathEnd -> SwaggerHandler m (With Request ts) (Either () ())
getTrait PathEnd
PathEnd = (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either () ())
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 () ()))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (With Request ts) (Either () ())
forall a b. (a -> b) -> a -> b
$ Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Swagger -> m Swagger
addRouteDocumentation (Swagger -> State Documentation Swagger)
-> (Swagger -> Swagger) -> Swagger -> State Documentation Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Swagger -> Swagger
prependPath FilePath
"/"