{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Proto3.Suite.DotProto.Generate.Swagger
( ppSchema
, asProxy
, insOrdFromList
)
where
#if MIN_VERSION_swagger2(2,4,0)
import Control.Lens ((&), (?~))
#else
import Control.Lens ((&), (.~), (?~))
#endif
import Data.Aeson (Value (String))
import Data.Aeson.Encode.Pretty (encodePretty)
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.Swagger
import qualified Data.Text as T
import Data.Proxy
import qualified Data.Vector as V
import GHC.Exts (Proxy#, proxy#)
import Google.Protobuf.Wrappers.Polymorphic (Wrapped(..))
import Proto3.Suite (Enumerated (..), Finite (..),
Fixed (..), Named (..),
Nested (..), NestedVec (..),
PackedVec (..), Signed (..),
UnpackedVec (..), enumerate)
import qualified Proto3.Suite.Types
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
deriving newtype instance ToSchema a => ToSchema (Fixed a)
deriving newtype instance ToSchema a => ToSchema (Signed a)
deriving via (V.Vector a) instance ToSchema a => ToSchema (NestedVec a)
deriving via (V.Vector a) instance ToSchema a => ToSchema (PackedVec a)
deriving via (V.Vector a) instance ToSchema a => ToSchema (UnpackedVec a)
deriving newtype instance ToSchema a => ToSchema (Wrapped a)
instance ToSchema (Proto3.Suite.Types.String a) where
declareNamedSchema :: Proxy (String a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (String a)
_ = Proxy String -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)
instance ToSchema (Proto3.Suite.Types.Bytes a) where
declareNamedSchema :: Proxy (Bytes a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Bytes a)
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
byteSchema)
deriving via (Maybe a) instance ToSchema (Maybe a) => ToSchema (Nested a)
asProxy :: (Proxy a -> b) -> Proxy a
asProxy :: (Proxy a -> b) -> Proxy a
asProxy Proxy 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