{-# 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 (..), Linked)
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
  {-# INLINEABLE getTrait #-}
  getTrait :: Path -> OpenApiHandler m (Linked ts Request) (Either () ())
  getTrait :: Path -> OpenApiHandler m (Linked ts Request) (Either () ())
getTrait (Path Text
p) = Tree DocNode -> OpenApiHandler m (Linked ts Request) (Either () ())
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (Linked ts Request) (Either () ()))
-> Tree DocNode
-> OpenApiHandler m (Linked ts Request) (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
  {-# INLINEABLE getTrait #-}
  getTrait :: PathVar tag val -> OpenApiHandler m (Linked ts Request) (Either PathVarError val)
  getTrait :: PathVar tag val
-> OpenApiHandler m (Linked ts Request) (Either PathVarError val)
getTrait PathVar tag val
PathVar =
    let param :: Param
param =
          (Param
forall a. Monoid a => a
mempty :: Param)
            { _paramName :: Text
_paramName = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy tag -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy tag -> String) -> Proxy tag -> String
forall a b. (a -> b) -> a -> b
$ Proxy tag
forall k (t :: k). Proxy t
Proxy @tag
            , _paramIn :: ParamLocation
_paramIn = ParamLocation
ParamPath
            , _paramRequired :: Maybe Bool
_paramRequired = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            , _paramSchema :: Maybe (Referenced Schema)
_paramSchema = Referenced Schema -> Maybe (Referenced Schema)
forall a. a -> Maybe a
Just (Referenced Schema -> Maybe (Referenced Schema))
-> Referenced Schema -> Maybe (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Proxy val -> Schema
forall a. ToSchema a => Proxy a -> Schema
toSchema (Proxy val -> Schema) -> Proxy val -> Schema
forall a b. (a -> b) -> a -> b
$ Proxy val
forall k (t :: k). Proxy t
Proxy @val
            }
     in Tree DocNode
-> OpenApiHandler m (Linked ts Request) (Either PathVarError val)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (Linked ts Request) (Either PathVarError val))
-> Tree DocNode
-> OpenApiHandler m (Linked ts Request) (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
  {-# INLINEABLE getTrait #-}
  getTrait :: PathEnd -> OpenApiHandler m (Linked ts Request) (Either () ())
  getTrait :: PathEnd -> OpenApiHandler m (Linked ts Request) (Either () ())
getTrait PathEnd
PathEnd = Tree DocNode -> OpenApiHandler m (Linked ts Request) (Either () ())
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler m (Linked ts Request) (Either () ()))
-> Tree DocNode
-> OpenApiHandler m (Linked ts Request) (Either () ())
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Text -> DocNode
DocPathElem Text
"/")