{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Proto3.Suite.DotProto.Generate.Swagger
( ppSchema
, OverrideToSchema(..)
, asProxy
, insOrdFromList
)
where
#if MIN_VERSION_swagger2(2,4,0)
import Control.Lens ((&), (?~))
#else
import Control.Lens ((&), (.~), (?~))
#endif
import Data.Aeson (Value (String), ToJSONKey,
ToJSONKeyFunction(..))
import qualified Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as LC8
import Data.Hashable (Hashable)
import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd
import Data.Map (Map)
import Data.Swagger
import qualified Data.Text as T
import Data.Proxy
import qualified Data.Vector as V
import GHC.Exts (Proxy#, proxy#)
import GHC.Int
import GHC.Word
import Proto3.Suite (Enumerated (..), Finite (..),
Fixed (..), Named (..), enumerate)
import Proto3.Suite.DotProto.Generate.Swagger.Wrappers ()
insOrdFromList :: (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
insOrdFromList :: [(k, v)] -> InsOrdHashMap k v
insOrdFromList = [(k, v)] -> InsOrdHashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
Data.HashMap.Strict.InsOrd.fromList
newtype OverrideToSchema a = OverrideToSchema { OverrideToSchema a -> a
unOverride :: a }
instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema (OverrideToSchema a) where
declareNamedSchema :: Proxy (OverrideToSchema a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (OverrideToSchema a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance {-# OVERLAPPING #-} ToSchema (OverrideToSchema B.ByteString) where
declareNamedSchema :: Proxy (OverrideToSchema ByteString)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (OverrideToSchema ByteString)
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
byteSchema)
instance {-# OVERLAPPING #-} ToSchema (OverrideToSchema (V.Vector B.ByteString)) where
declareNamedSchema :: Proxy (OverrideToSchema (Vector ByteString))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (OverrideToSchema (Vector ByteString))
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
schema_)
where
schema_ :: Schema
schema_ = Schema
forall a. Monoid a => a
mempty
#if MIN_VERSION_swagger2(2,4,0)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
#else
& type_ .~ SwaggerArray
#endif
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> SwaggerItems 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsObject (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
byteSchema)
instance {-# OVERLAPPING #-} (ToJSONKey k, ToSchema k) => ToSchema (OverrideToSchema (Map k B.ByteString)) where
declareNamedSchema :: Proxy (OverrideToSchema (Map k ByteString))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (OverrideToSchema (Map k ByteString))
_ = case ToJSONKeyFunction k
forall a. ToJSONKey a => ToJSONKeyFunction a
Aeson.toJSONKey :: ToJSONKeyFunction k of
ToJSONKeyText k -> Key
_ k -> Encoding' Key
_ -> do
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
schema_)
ToJSONKeyValue k -> Value
_ k -> Encoding
_ -> do
Proxy [(k, OverrideToSchema ByteString)]
-> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [(k, OverrideToSchema ByteString)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(k, (OverrideToSchema B.ByteString))])
where
schema_ :: Schema
schema_ = Schema
forall a. Monoid a => a
mempty
#if MIN_VERSION_swagger2(2,4,0)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
#else
& type_ .~ SwaggerObject
#endif
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe AdditionalProperties
-> Identity (Maybe AdditionalProperties))
-> Schema -> Identity Schema
forall s a. HasAdditionalProperties s a => Lens' s a
additionalProperties ((Maybe AdditionalProperties
-> Identity (Maybe AdditionalProperties))
-> Schema -> Identity Schema)
-> AdditionalProperties -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
byteSchema)
asProxy :: (Proxy (OverrideToSchema a) -> b) -> Proxy a
asProxy :: (Proxy (OverrideToSchema a) -> b) -> Proxy a
asProxy Proxy (OverrideToSchema a) -> b
_ = Proxy a
forall k (t :: k). Proxy t
Proxy
ppSchema :: ToSchema a => Proxy a -> IO ()
ppSchema :: Proxy a -> IO ()
ppSchema = ByteString -> IO ()
LC8.putStrLn (ByteString -> IO ())
-> (Proxy a -> ByteString) -> Proxy a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Schema -> ByteString)
-> (Proxy a -> Schema) -> Proxy a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Schema
forall a. ToSchema a => Proxy a -> Schema
toSchema
instance (Finite e, Named e) => ToSchema (Enumerated e) where
declareNamedSchema :: Proxy (Enumerated e) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Enumerated e)
_ = do
let enumName :: Text
enumName = Proxy# e -> Text
forall a string. (Named a, IsString string) => Proxy# a -> string
nameOf (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)
let dropPrefix :: Text -> Text
dropPrefix = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
enumName)
let enumMemberNames :: [Text]
enumMemberNames = Text -> Text
dropPrefix (Text -> Text) -> ((Text, Int32) -> Text) -> (Text, Int32) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int32) -> Text
forall a b. (a, b) -> a
fst ((Text, Int32) -> Text) -> [(Text, Int32)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy# e -> [(Text, Int32)]
forall a string.
(Finite a, IsString string) =>
Proxy# a -> [(string, Int32)]
enumerate (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (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
enumName)
(Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
#if MIN_VERSION_swagger2(2,4,0)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
#else
& type_ .~ SwaggerString
#endif
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String [Text]
enumMemberNames
instance ToSchema (Fixed Int32) where
declareNamedSchema :: Proxy (Fixed Int32) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Fixed Int32)
_ = Proxy Int32 -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Int32
forall k (t :: k). Proxy t
Proxy @Int32)
instance ToSchema (Fixed Int64) where
declareNamedSchema :: Proxy (Fixed Int64) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Fixed Int64)
_ = Proxy Int64 -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Int64
forall k (t :: k). Proxy t
Proxy @Int64)
instance ToSchema (Fixed Word32) where
declareNamedSchema :: Proxy (Fixed Word32) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Fixed Word32)
_ = Proxy Word32 -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Word32
forall k (t :: k). Proxy t
Proxy @Word32)
instance ToSchema (Fixed Word64) where
declareNamedSchema :: Proxy (Fixed Word64) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Fixed Word64)
_ = Proxy Word64 -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Word64
forall k (t :: k). Proxy t
Proxy @Word64)