{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Lens ((&), (<>~))
import Data.Data (Proxy (Proxy))
import Data.OpenApi (
  Param (..),
  ParamLocation (ParamPath),
  Referenced (Inline),
  ToSchema,
  allOperations,
  parameters,
  prependPath,
  toSchema,
 )
import Data.String (fromString)
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.OpenApi.Handler (OpenApiHandler (..), addRouteDocumentation)

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

instance (KnownSymbol tag, ToSchema val) => Get (OpenApiHandler m) (PathVar tag val) where
  {-# INLINE getTrait #-}
  getTrait :: PathVar tag val -> OpenApiHandler m (Request `With` ts) (Either PathVarError val)
  getTrait :: forall (ts :: [*]).
PathVar tag val
-> OpenApiHandler 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
            , _paramIn = ParamPath
            , _paramRequired = Just True
            , _paramSchema = Just $ Inline $ toSchema $ Proxy @val
            }
     in (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler m (With Request ts) (Either PathVarError val)
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 PathVarError val))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler m (With Request ts) (Either PathVarError val)
forall a b. (a -> b) -> a -> b
$ \OpenApi
doc ->
          OpenApi -> State Documentation OpenApi
forall (m :: * -> *).
MonadState Documentation m =>
OpenApi -> m OpenApi
addRouteDocumentation (OpenApi -> State Documentation OpenApi)
-> OpenApi -> State Documentation OpenApi
forall a b. (a -> b) -> a -> b
$
            FilePath -> OpenApi -> OpenApi
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
"}") 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]

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