{-# OPTIONS_GHC -Wno-orphans #-}

-- | Swagger implementation of 'Method' trait.
module WebGear.Swagger.Trait.Method where

import Control.Lens ((%~), (&))
import qualified Data.HashMap.Strict.InsOrd as Map
import Data.Swagger (PathItem (..), paths)
import Network.HTTP.Types (StdMethod (..))
import WebGear.Core.Trait (Get (..))
import WebGear.Core.Trait.Method (Method (..))
import WebGear.Swagger.Handler (SwaggerHandler (..), addRouteDocumentation)

instance Get (SwaggerHandler m) Method where
  {-# INLINE getTrait #-}
  getTrait :: forall (ts :: [*]).
Prerequisite Method ts =>
Method
-> SwaggerHandler
     m
     (With Request ts)
     (Either (Absence Method) (Attribute Method Request))
getTrait (Method StdMethod
method) = (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     m
     (With Request ts)
     (Either (Absence Method) (Attribute Method Request))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler ((Swagger -> State Documentation Swagger)
 -> SwaggerHandler
      m
      (With Request ts)
      (Either (Absence Method) (Attribute Method Request)))
-> (Swagger -> State Documentation Swagger)
-> SwaggerHandler
     m
     (With Request ts)
     (Either (Absence Method) (Attribute Method Request))
forall a b. (a -> b) -> a -> b
$ \Swagger
doc -> do
    Swagger -> State Documentation Swagger
forall (m :: * -> *).
MonadState Documentation m =>
Swagger -> m Swagger
addRouteDocumentation (Swagger -> State Documentation Swagger)
-> Swagger -> State Documentation Swagger
forall a b. (a -> b) -> a -> b
$ Swagger
doc Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashMap FilePath PathItem
    -> InsOrdHashMap FilePath PathItem)
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (StdMethod -> PathItem -> PathItem
removeOtherMethods StdMethod
method)

removeOtherMethods :: StdMethod -> PathItem -> PathItem
removeOtherMethods :: StdMethod -> PathItem -> PathItem
removeOtherMethods StdMethod
method PathItem{[Referenced Param]
Maybe Operation
_pathItemGet :: Maybe Operation
_pathItemPut :: Maybe Operation
_pathItemPost :: Maybe Operation
_pathItemDelete :: Maybe Operation
_pathItemOptions :: Maybe Operation
_pathItemHead :: Maybe Operation
_pathItemPatch :: Maybe Operation
_pathItemParameters :: [Referenced Param]
_pathItemGet :: PathItem -> Maybe Operation
_pathItemPut :: PathItem -> Maybe Operation
_pathItemPost :: PathItem -> Maybe Operation
_pathItemDelete :: PathItem -> Maybe Operation
_pathItemOptions :: PathItem -> Maybe Operation
_pathItemHead :: PathItem -> Maybe Operation
_pathItemPatch :: PathItem -> Maybe Operation
_pathItemParameters :: PathItem -> [Referenced Param]
..} =
  case StdMethod
method of
    StdMethod
GET -> PathItem
forall a. Monoid a => a
mempty{_pathItemGet, _pathItemParameters}
    StdMethod
PUT -> PathItem
forall a. Monoid a => a
mempty{_pathItemPut, _pathItemParameters}
    StdMethod
POST -> PathItem
forall a. Monoid a => a
mempty{_pathItemPost, _pathItemParameters}
    StdMethod
DELETE -> PathItem
forall a. Monoid a => a
mempty{_pathItemDelete, _pathItemParameters}
    StdMethod
HEAD -> PathItem
forall a. Monoid a => a
mempty{_pathItemHead, _pathItemParameters}
    StdMethod
OPTIONS -> PathItem
forall a. Monoid a => a
mempty{_pathItemOptions, _pathItemParameters}
    StdMethod
PATCH -> PathItem
forall a. Monoid a => a
mempty{_pathItemPatch, _pathItemParameters}
    -- Swagger does not support CONNECT and TRACE
    StdMethod
CONNECT -> PathItem
forall a. Monoid a => a
mempty{_pathItemParameters}
    StdMethod
TRACE -> PathItem
forall a. Monoid a => a
mempty{_pathItemParameters}