{-# LANGUAGE RankNTypes #-}
module Data.Swagger.Operation (
allOperations,
operationsOf,
applyTags,
applyTagsFor,
setResponse,
setResponseWith,
setResponseFor,
setResponseForWith,
prependPath,
declareResponse,
) where
import Prelude ()
import Prelude.Compat
import Control.Lens
import Data.Data.Lens
import Data.List.Compat
import Data.Maybe (mapMaybe)
import Data.Proxy
import qualified Data.Set as Set
import Data.Swagger.Declare
import Data.Swagger.Internal
import Data.Swagger.Lens
import Data.Swagger.Schema
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import qualified Data.HashSet.InsOrd as InsOrdHS
prependPath :: FilePath -> Swagger -> Swagger
prependPath :: [Char] -> Swagger -> Swagger
prependPath [Char]
path = forall s a. HasPaths s a => Lens' s a
paths forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys ([Char]
path [Char] -> [Char] -> [Char]
</>)
where
[Char]
x </> :: [Char] -> [Char] -> [Char]
</> [Char]
y = case [Char] -> [Char]
trim [Char]
y of
[Char]
"" -> [Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
trim [Char]
x
[Char]
y' -> [Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
trim [Char]
x forall a. Semigroup a => a -> a -> a
<> [Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char]
y'
trim :: [Char] -> [Char]
trim = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'/')
allOperations :: Traversal' Swagger Operation
allOperations :: Traversal' Swagger Operation
allOperations = forall s a. HasPaths s a => Lens' s a
pathsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverseforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (Data s, Typeable a) => Traversal' s a
template
operationsOf :: Swagger -> Traversal' Swagger Operation
operationsOf :: Swagger -> Traversal' Swagger Operation
operationsOf Swagger
sub = forall s a. HasPaths s a => Lens' s a
pathsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndexforall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal' ([Char], PathItem) Operation
subops
where
subops :: Traversal' (FilePath, PathItem) Operation
subops :: Traversal' ([Char], PathItem) Operation
subops Operation -> f Operation
f ([Char]
path, PathItem
item) = case forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup [Char]
path (Swagger
sub forall s a. s -> Getting a s a -> a
^. forall s a. HasPaths s a => Lens' s a
paths) of
Just PathItem
subitem -> (,) [Char]
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathItem -> Traversal' PathItem Operation
methodsOf PathItem
subitem Operation -> f Operation
f PathItem
item
Maybe PathItem
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
path, PathItem
item)
methodsOf :: PathItem -> Traversal' PathItem Operation
methodsOf :: PathItem -> Traversal' PathItem Operation
methodsOf PathItem
pathItem = forall (f :: * -> *) s t a.
Functor f =>
Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf forall s a. (Data s, Typeable a) => Traversal' s a
template forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Applicative f) =>
(i -> Bool) -> Optical' p (Indexed i) f a a
indices (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
ns) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
where
ops :: [Maybe Operation]
ops = PathItem
pathItem forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall s a. (Data s, Typeable a) => Traversal' s a
template :: [Maybe Operation]
ns :: [Int]
ns = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Maybe Operation]
ops
applyTags :: [Tag] -> Swagger -> Swagger
applyTags :: [Tag] -> Swagger -> Swagger
applyTags = Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor Traversal' Swagger Operation
allOperations
applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor Traversal' Swagger Operation
ops [Tag]
ts Swagger
swag = Swagger
swag
forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasTags s a => Lens' s a
tags forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
InsOrdHS.fromList (forall a b. (a -> b) -> [a] -> [b]
map Tag -> TagName
_tagName [Tag]
ts))
forall a b. a -> (a -> b) -> b
& forall s a. HasTags s a => Lens' s a
tags forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
InsOrdHS.fromList [Tag]
ts)
declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
declareResponse :: forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Response
declareResponse Proxy a
proxy = do
Referenced Schema
s <- forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef Proxy a
proxy
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
s)
setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponse :: Int -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponse = Traversal' Swagger Operation
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseFor Traversal' Swagger Operation
allOperations
setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseWith :: (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseWith = Traversal' Swagger Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseForWith Traversal' Swagger Operation
allOperations
setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseFor :: Traversal' Swagger Operation
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseFor Traversal' Swagger Operation
ops Int
code Declare (Definitions Schema) Response
dres Swagger
swag = Swagger
swag
forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
code forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline Response
res
where
(Definitions Schema
defs, Response
res) = forall d a. Declare d a -> d -> (d, a)
runDeclare Declare (Definitions Schema) Response
dres forall a. Monoid a => a
mempty
setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseForWith :: Traversal' Swagger Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseForWith Traversal' Swagger Operation
ops Response -> Response -> Response
f Int
code Declare (Definitions Schema) Response
dres Swagger
swag = Swagger
swag
forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
code forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Referenced a
Inline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Referenced Response) -> Response
combine
where
(Definitions Schema
defs, Response
new) = forall d a. Declare d a -> d -> (d, a)
runDeclare Declare (Definitions Schema) Response
dres forall a. Monoid a => a
mempty
combine :: Maybe (Referenced Response) -> Response
combine (Just (Ref (Reference TagName
n))) = case Swagger
swag forall s a. s -> Getting a s a -> a
^. forall s a. HasResponses s a => Lens' s a
responsesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TagName
n of
Just Response
old -> Response -> Response -> Response
f Response
old Response
new
Maybe Response
Nothing -> Response
new
combine (Just (Inline Response
old)) = Response -> Response -> Response
f Response
old Response
new
combine Maybe (Referenced Response)
Nothing = Response
new