{-# 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) = Tree DocNode -> SwaggerHandler m (With Request ts) (Either () ())
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode -> SwaggerHandler m (With Request ts) (Either () ()))
-> Tree DocNode
-> SwaggerHandler m (With Request ts) (Either () ())
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
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 =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName = fromString $ symbolVal $ Proxy @tag
            , _paramRequired = Just True
            , _paramSchema =
                ParamOther
                  $ ParamOtherSchema
                    { _paramOtherSchemaIn = ParamPath
                    , _paramOtherSchemaParamSchema = mempty
                    , _paramOtherSchemaAllowEmptyValue = Nothing
                    }
            }
     in Tree DocNode
-> SwaggerHandler m (With Request ts) (Either PathVarError val)
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode
 -> SwaggerHandler m (With Request ts) (Either PathVarError val))
-> Tree DocNode
-> SwaggerHandler m (With Request ts) (Either PathVarError val)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
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 = Tree DocNode -> SwaggerHandler m (With Request ts) (Either () ())
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode -> SwaggerHandler m (With Request ts) (Either () ()))
-> Tree DocNode
-> SwaggerHandler m (With Request ts) (Either () ())
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> DocNode
DocPathElem Text
"/")