git.iko.soy/typeable/swagger2
on master help sign in
Add tests for declareSchemaBoundedEnumMapping
commitc09a11d17f579f67c8142b65c3d0717be75f3133 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateSat 7 Oct 2017, 21:07 (9 years ago) parent1d106c9
2 files changed+82−5
compare with master
unifiedsplit
test/Data/Swagger/Schema/ValidationSpec.hs+38−4 test/Data/Swagger/SchemaSpec.hs+44−1
test/Data/Swagger/Schema/ValidationSpec.hs+38−4
@@ -85,12 +85,14 @@ spec = do
8585 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
8686 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
8787 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
88+ prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
8889
8990 describe "invalid cases" $ do
90− prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON
91− prop "invalidColorToJSON" $ shouldNotValidate invalidColorToJSON
92− prop "invalidPaintToJSON" $ shouldNotValidate invalidPaintToJSON
93− prop "invalidLightToJSON" $ shouldNotValidate invalidLightToJSON
91+ prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON
92+ prop "invalidColorToJSON" $ shouldNotValidate invalidColorToJSON
93+ prop "invalidPaintToJSON" $ shouldNotValidate invalidPaintToJSON
94+ prop "invalidLightToJSON" $ shouldNotValidate invalidLightToJSON
95+ prop "invalidButtonImagesToJSON" $ shouldNotValidate invalidButtonImagesToJSON
9496
9597main :: IO ()
9698main = hspec spec
@@ -193,6 +195,38 @@ instance Arbitrary Light where
193195invalidLightToJSON :: Light -> Value
194196invalidLightToJSON = genericToJSON defaultOptions
195197
198+-- ========================================================================
199+-- ButtonImages (bounded enum key mapping)
200+-- ========================================================================
201+
202+data ButtonState = Neutral | Focus | Active | Hover | Disabled
203+ deriving (Show, Eq, Ord, Bounded, Enum, Generic)
204+
205+instance ToJSON ButtonState
206+instance ToSchema ButtonState
207+instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
208+
209+instance Arbitrary ButtonState where
210+ arbitrary = arbitraryBoundedEnum
211+
212+type ImageUrl = T.Text
213+
214+newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
215+ deriving (Show, Generic)
216+
217+instance ToJSON ButtonImages where
218+ toJSON = toJSON . getButtonImages
219+
220+instance ToSchema ButtonImages where
221+ declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
222+ declareSchemaBoundedEnumKeyMapping
223+
224+invalidButtonImagesToJSON :: ButtonImages -> Value
225+invalidButtonImagesToJSON = genericToJSON defaultOptions
226+
227+instance Arbitrary ButtonImages where
228+ arbitrary = ButtonImages <$> arbitrary
229+
196230-- Arbitrary instances for common types
197231
198232instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
test/Data/Swagger/SchemaSpec.hs+44−1
@@ -8,12 +8,14 @@ import Prelude ()
88import Prelude.Compat
99
1010import Control.Lens ((^.))
11−import Data.Aeson (Value)
11+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
12+import Data.Aeson.Types (toJSONKeyText)
1213import Data.Aeson.QQ
1314import Data.Char
1415import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
1516import Data.Proxy
1617import Data.Set (Set)
18+import Data.Map (Map)
1719import qualified Data.Text as Text
1820import GHC.Generics
1921
@@ -101,6 +103,8 @@ spec = do
101103 context "Character (inlining only Player)" $ checkInlinedSchemas ["Player"] (Proxy :: Proxy Character) characterInlinedPlayerSchemaJSON
102104 context "Light" $ checkInlinedSchema (Proxy :: Proxy Light) lightInlinedSchemaJSON
103105 context "MyRoseTree (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
106+ describe "Bounded Enum key mapping" $ do
107+ context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
104108
105109main :: IO ()
106110main = hspec spec
@@ -647,3 +651,42 @@ instance ToSchema Id
647651
648652newtype ResourceId = ResourceId Id deriving (Generic)
649653instance ToSchema ResourceId
654+
655+-- ========================================================================
656+-- ButtonImages (bounded enum key mapping)
657+-- ========================================================================
658+
659+data ButtonState = Neutral | Focus | Active | Hover | Disabled
660+ deriving (Show, Bounded, Enum, Generic)
661+
662+instance ToJSON ButtonState
663+instance ToSchema ButtonState
664+instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (Text.pack . show)
665+
666+type ImageUrl = Text.Text
667+
668+newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
669+ deriving (Generic)
670+
671+instance ToJSON ButtonImages where
672+ toJSON = toJSON . getButtonImages
673+
674+instance ToSchema ButtonImages where
675+ declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
676+ declareSchemaBoundedEnumKeyMapping
677+
678+buttonImagesSchemaJSON :: Value
679+buttonImagesSchemaJSON = [aesonQQ|
680+{
681+ "type": "object",
682+ "properties":
683+ {
684+ "Neutral": { "type": "string" },
685+ "Focus": { "type": "string" },
686+ "Active": { "type": "string" },
687+ "Hover": { "type": "string" },
688+ "Disabled": { "type": "string" }
689+ }
690+}
691+|]
692+