{-# OPTIONS_GHC -Wno-orphans #-}

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

import Data.Data (Proxy (Proxy))
import Data.OpenApi (Param (..), ParamLocation (ParamPath), Referenced (Inline), ToSchema, toSchema)
import Data.String (fromString)
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 (
  DocNode (DocPathElem, DocPathVar),
  OpenApiHandler (..),
  singletonNode,
 )

instance Get (OpenApiHandler m) Path Request 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) = Tree DocNode -> OpenApiHandler m (With Request ts) (Either () ())
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode -> OpenApiHandler m (With Request ts) (Either () ()))
-> Tree DocNode
-> OpenApiHandler 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, ToSchema val) => Get (OpenApiHandler m) (PathVar tag val) Request 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 param :: Param
param =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName = fromString $ symbolVal $ Proxy @tag
            , _paramIn = ParamPath
            , _paramRequired = Just True
            , _paramSchema = Just $ Inline $ toSchema $ Proxy @val
            }
     in Tree DocNode
-> OpenApiHandler m (With Request ts) (Either PathVarError val)
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (With Request ts) (Either PathVarError val))
-> Tree DocNode
-> OpenApiHandler 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 (OpenApiHandler m) PathEnd Request where
  {-# INLINE getTrait #-}
  getTrait :: PathEnd -> OpenApiHandler m (Request `With` ts) (Either () ())
  getTrait :: forall (ts :: [*]).
PathEnd -> OpenApiHandler m (With Request ts) (Either () ())
getTrait PathEnd
PathEnd = Tree DocNode -> OpenApiHandler m (With Request ts) (Either () ())
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode -> OpenApiHandler m (With Request ts) (Either () ()))
-> Tree DocNode
-> OpenApiHandler 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
"/")