@@ -1,9 +1,12 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveAnyClass #-}
3+{-# LANGUAGE DeriveGeneric #-}
24{-# LANGUAGE PackageImports #-}
35module Data.Swagger.Schema.ValidationSpec where
46
57import Control.Applicative
68import Data.Aeson
9+import Data.Aeson.Types
710import Data.Int
811import Data.IntMap (IntMap)
912import qualified Data.IntMap as IntMap
@@ -22,8 +25,10 @@ import qualified Data.Text.Lazy as TL
2225import Data.Set (Set)
2326import qualified Data.Set as Set
2427import Data.Word
28+import GHC.Generics
2529
2630import Data.Swagger
31+import Data.Swagger.Declare
2732import Data.Swagger.Schema.Validation
2833
2934import SpecCommon
@@ -34,7 +39,8 @@ import Test.QuickCheck
3439shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
3540shouldValidate proxy x = res == Passed ()
3641 where
37− res = runValidation (validateWithSchema (toJSON x)) defaultConfig (toSchema proxy)
42+ res = runValidation (validateWithSchema (toJSON x)) defaultConfig { configDefinitions = defs } schema
43+ (defs, schema) = runDeclare (declareSchema proxy) mempty
3844
3945spec :: Spec
4046spec = do
@@ -76,10 +82,79 @@ spec = do
7682 prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
7783 prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
7884 prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
85+ prop "Person" $ shouldValidate (Proxy :: Proxy Person)
86+ prop "Color" $ shouldValidate (Proxy :: Proxy Color)
87+ prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
88+ prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
89+ prop "Light" $ shouldValidate (Proxy :: Proxy Light)
7990
8091main :: IO ()
8192main = hspec spec
8293
94+-- ========================================================================
95+-- Person (simple record with optional fields)
96+-- ========================================================================
97+data Person = Person { name :: String , phone :: Integer , email :: Maybe String } deriving (Show, Generic, ToSchema, ToJSON)
98+
99+instance Arbitrary Person where
100+ arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
101+
102+-- ========================================================================
103+-- Color (enum)
104+-- ========================================================================
105+data Color = Red | Green | Blue deriving (Show, Generic, ToSchema, ToJSON, Bounded, Enum)
106+
107+instance Arbitrary Color where
108+ arbitrary = arbitraryBoundedEnum
109+
110+-- ========================================================================
111+-- Paint (record with bounded enum property)
112+-- ========================================================================
113+
114+newtype Paint = Paint { color :: Color }
115+ deriving (Show, Generic, ToSchema, ToJSON)
116+
117+instance Arbitrary Paint where
118+ arbitrary = Paint <$> arbitrary
119+
120+-- ========================================================================
121+-- MyRoseTree (custom datatypeNameModifier)
122+-- ========================================================================
123+
124+data MyRoseTree = MyRoseTree
125+ { root :: String
126+ , trees :: [MyRoseTree]
127+ } deriving (Show, Generic, ToJSON)
128+
129+instance ToSchema MyRoseTree where
130+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
131+ { datatypeNameModifier = drop (length "My") }
132+
133+instance Arbitrary MyRoseTree where
134+ arbitrary = fmap (cut limit) $ MyRoseTree <$> arbitrary <*> (take limit <$> arbitrary)
135+ where
136+ limit = 4
137+ cut 0 (MyRoseTree x _ ) = MyRoseTree x []
138+ cut n (MyRoseTree x xs) = MyRoseTree x (map (cut (n - 1)) xs)
139+
140+-- ========================================================================
141+-- Light (sum type)
142+-- ========================================================================
143+
144+data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic, ToSchema)
145+
146+instance ToJSON Light where
147+ toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
148+
149+instance Arbitrary Light where
150+ arbitrary = oneof
151+ [ return NoLight
152+ , LightFreq <$> arbitrary
153+ , LightColor <$> arbitrary
154+ ]
155+
156+-- Arbitrary instances for common types
157+
83158#if MIN_VERSION_QuickCheck(2,8,2)
84159#else
85160instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where