{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
{-# 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 Data.ByteString (ByteString)
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)
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 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 (Maybe ByteString)) where
declareNamedSchema :: Proxy (OverrideToSchema (Maybe ByteString))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (OverrideToSchema (Maybe 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 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 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 -> Text
_ k -> Encoding' Text
_ -> 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 ByteString))])
where
schema_ :: Schema
schema_ = Schema
forall a. Monoid a => a
mempty
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
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)