{-# LANGUAGE ConstraintKinds #-}

module Prolude.Swagger
  ( -- * SwaggerType re-export
    Swagger.SwaggerType(..)
  -- * Alias types
  , SwaggerToSchema
  , SwaggerToParamSchema
  -- * Functions
  , defaultDeclareNamedSchema
  , nameSchema
  )
where

import qualified Data.Swagger as Swagger
import qualified Data.Text as Text
import qualified Data.Typeable as Typeable

type SwaggerToParamSchema = Swagger.ToParamSchema

type SwaggerToSchema = Swagger.ToSchema

-- | This function makes it easy to define a 'Swagger.ToSchema' instance. Just
-- pass in a function that modifies the default empty schema and you're good to
-- go. For example:
--
-- > instance ToSchema SomeType where
-- >   declareNamedSchema = defaultDeclareNamedSchema
-- >     $ set type_ (Just SwaggerObject)
-- >     . set title (Just "some type")
defaultDeclareNamedSchema
  :: (Typeable.Typeable a, Applicative f)
  => (Swagger.Schema -> Swagger.Schema)
  -> proxy a
  -> f Swagger.NamedSchema
defaultDeclareNamedSchema :: forall a (f :: * -> *) (proxy :: * -> *).
(Typeable a, Applicative f) =>
(Schema -> Schema) -> proxy a -> f NamedSchema
defaultDeclareNamedSchema Schema -> Schema
modify proxy a
proxy =
  let
    schema :: Schema
schema = Schema -> Schema
modify forall a. Monoid a => a
mempty
    namedSchema :: NamedSchema
namedSchema = forall a (proxy :: * -> *).
Typeable a =>
proxy a -> Schema -> NamedSchema
nameSchema proxy a
proxy Schema
schema
  in forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedSchema
namedSchema

-- | Generates a unique name for the given type and adds that name to the
-- schema. The generated name will be like @ModuleName.TypeName@. For example
-- it might be @Data.Maybe.Maybe@.
nameSchema :: Typeable.Typeable a => proxy a -> Swagger.Schema -> Swagger.NamedSchema
nameSchema :: forall a (proxy :: * -> *).
Typeable a =>
proxy a -> Schema -> NamedSchema
nameSchema proxy a
proxy Schema
schema =
  let
    typeRep :: TypeRep
typeRep = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep proxy a
proxy
    tyCon :: TyCon
tyCon = TypeRep -> TyCon
Typeable.typeRepTyCon TypeRep
typeRep
    moduleName :: String
moduleName = TyCon -> String
Typeable.tyConModule TyCon
tyCon
    typeName :: String
typeName = TyCon -> String
Typeable.tyConName TyCon
tyCon
    nameString :: String
nameString = forall a. Monoid a => [a] -> a
mconcat [String
moduleName, String
".", String
typeName]
    nameText :: Text
nameText = String -> Text
Text.pack String
nameString
  in Maybe Text -> Schema -> NamedSchema
Swagger.NamedSchema (forall a. a -> Maybe a
Just Text
nameText) Schema
schema