module Composite.Swagger.Base where

import Control.Lens (Unwrapped, Wrapped, (&), (?~))
import Composite.Swagger.OrphanInstances ()
import Data.Proxy (Proxy (Proxy))
import Data.Swagger
  ( Definitions, NamedSchema(NamedSchema), Schema, SwaggerType(SwaggerObject), ToSchema
  , declareSchema, type_ )
import Data.Swagger.Declare (Declare)
import qualified Data.Text as Text

-- |Given a 'Control.Lens.Wrapped' and an underlying 'Data.Swagger.ToSchema' instance, create a
-- Schema with the given name surrounding the underlying instance.
wrappedSchema :: (Wrapped wrap, ToSchema (Unwrapped wrap)) => Proxy wrap -> String -> Declare (Definitions Schema) NamedSchema
wrappedSchema :: Proxy wrap -> String -> Declare (Definitions Schema) NamedSchema
wrappedSchema (Proxy wrap
Proxy :: Proxy wrap) String
name = do
  Schema
s <- Proxy (Unwrapped wrap) -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy (Unwrapped wrap)
forall k (t :: k). Proxy t
Proxy :: Proxy (Unwrapped wrap))
  NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
name) Schema
s
    NamedSchema -> (NamedSchema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> NamedSchema -> Identity NamedSchema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> NamedSchema -> Identity NamedSchema)
-> SwaggerType 'SwaggerKindSchema -> NamedSchema -> NamedSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject