{-# OPTIONS_GHC -Wno-orphans #-}

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

import Data.Data (Proxy (Proxy))
import Data.String (fromString)
import Data.Swagger (
  Param (..),
  ParamAnySchema (ParamOther),
  ParamLocation (ParamPath),
  ParamOtherSchema (..),
 )
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 (
  DocNode (DocPathElem, DocPathVar),
  SwaggerHandler (..),
  singletonNode,
 )

instance Get (SwaggerHandler m) Path Request 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) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Text -> DocNode
DocPathElem Text
p)

instance (KnownSymbol tag) => Get (SwaggerHandler m) (PathVar tag val) Request 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 param :: Param
param =
          (forall a. Monoid a => a
mempty :: Param)
            { _paramName :: Text
_paramName = 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 @tag
            , _paramRequired :: Maybe Bool
_paramRequired = forall a. a -> Maybe a
Just Bool
True
            , _paramSchema :: ParamAnySchema
_paramSchema =
                ParamOtherSchema -> ParamAnySchema
ParamOther
                  forall a b. (a -> b) -> a -> b
$ ParamOtherSchema
                    { _paramOtherSchemaIn :: ParamLocation
_paramOtherSchemaIn = ParamLocation
ParamPath
                    , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
_paramOtherSchemaParamSchema = forall a. Monoid a => a
mempty
                    , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
_paramOtherSchemaAllowEmptyValue = forall a. Maybe a
Nothing
                    }
            }
     in forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Param -> DocNode
DocPathVar Param
param)

instance Get (SwaggerHandler m) PathEnd Request where
  {-# INLINE getTrait #-}
  getTrait :: PathEnd -> SwaggerHandler m (Request `With` ts) (Either () ())
  getTrait :: forall (ts :: [*]).
PathEnd -> SwaggerHandler m (With Request ts) (Either () ())
getTrait PathEnd
PathEnd = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ forall a. a -> Tree a
singletonNode (Text -> DocNode
DocPathElem Text
"/")