git.iko.soy/typeable/openapi3
on 047caac help sign in
typeable/openapi3/test/Data/Swagger/ParamSchemaSpec.hs
116 lines 3.1 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
6module Data.Swagger.ParamSchemaSpec where
8import Data.Aeson (Value)
9import Data.Aeson.QQ
10import Data.Char
11import Data.Proxy
12import GHC.Generics
14import Data.Swagger
15import Data.Swagger.Internal (SwaggerKind(..))
17import SpecCommon
18import Test.Hspec
20checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
21checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
23spec :: Spec
24spec = do
25 describe "Generic ToParamSchema" $ do
26 context "Unit" $ checkToParamSchema (Proxy :: Proxy Unit) unitSchemaJSON
27 context "Color (bounded enum)" $ checkToParamSchema (Proxy :: Proxy Color) colorSchemaJSON
28 context "Status (constructorTagModifier)" $ checkToParamSchema (Proxy :: Proxy Status) statusSchemaJSON
29 context "Unary records" $ do
30 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON
31 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON
33main :: IO ()
34main = hspec spec
36-- ========================================================================
37-- Unit type
38-- ========================================================================
40data Unit = Unit deriving (Generic)
41instance ToParamSchema Unit
43unitSchemaJSON :: Value
44unitSchemaJSON = [aesonQQ|
46 "type": "string",
47 "enum": ["Unit"]
49|]
51-- ========================================================================
52-- Color (enum)
53-- ========================================================================
54data Color
55 = Red
56 | Green
57 | Blue
58 deriving (Generic)
59instance ToParamSchema Color
61colorSchemaJSON :: Value
62colorSchemaJSON = [aesonQQ|
64 "type": "string",
65 "enum": ["Red", "Green", "Blue"]
67|]
69-- ========================================================================
70-- Status (constructorTagModifier)
71-- ========================================================================
73data Status = StatusOk | StatusError deriving (Generic)
75instance ToParamSchema Status where
76 toParamSchema = genericToParamSchema defaultSchemaOptions
77 { constructorTagModifier = map toLower . drop (length "Status") }
79statusSchemaJSON :: Value
80statusSchemaJSON = [aesonQQ|
82 "type": "string",
83 "enum": ["ok", "error"]
85|]
87-- ========================================================================
88-- Email (newtype with unwrapUnaryRecords set to True)
89-- ========================================================================
91newtype Email = Email { getEmail :: String }
92 deriving (Generic)
93instance ToParamSchema Email
95emailSchemaJSON :: Value
96emailSchemaJSON = [aesonQQ|
98 "type": "string"
100|]
102-- ========================================================================
103-- UserId (non-record newtype)
104-- ========================================================================
106newtype UserId = UserId Integer
107 deriving (Generic)
108instance ToParamSchema UserId
110userIdSchemaJSON :: Value
111userIdSchemaJSON = [aesonQQ|
113 "type": "integer"
115|]