Skip to content

Commit d72466a

Browse files
fizrukfizruk
committed
Add ToSchema Object instance (for aeson's Object)
1 parent 4cb12af commit d72466a

File tree

4 files changed

+77
-57
lines changed

4 files changed

+77
-57
lines changed

‎src/Data/Swagger/Internal/Schema.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Data.Data.Lens (template)
3232

3333
import Control.Monad
3434
import Control.Monad.Writer
35-
import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..))
35+
import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
3636
import Data.Char
3737
import Data.Data (Data)
3838
import Data.Foldable (traverse_)
@@ -552,6 +552,12 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =
552552

553553
#endif
554554

555+
instance OVERLAPPING_ ToSchema Object where
556+
declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
557+
& type_ .~ SwaggerObject
558+
& description ?~ "Arbitrary JSON object."
559+
& additionalProperties ?~ AdditionalPropertiesAllowed True
560+
555561
instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
556562
instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
557563
instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])

‎stack.yaml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,7 @@
1-
resolver: lts-11.4
1+
resolver: lts-11.14
22
packages:
33
- '.'
44
extra-deps:
55
- aeson-1.3.1.0
66
- base-compat-0.10.1
77
- base-compat-batteries-0.10.1
8-
- insert-ordered-containers-0.2.1.0

‎test/Data/Swagger/CommonTestTypes.hs

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,25 @@
1-
{-# LANGUAGE DeriveGeneric #-}
1+
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE QuasiQuotes #-}
23
{-# LANGUAGE ScopedTypeVariables #-}
3-
{-# LANGUAGE QuasiQuotes #-}
44

55
module Data.Swagger.CommonTestTypes where
66

7-
import Prelude ()
8-
import Prelude.Compat
9-
10-
import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
11-
import Data.Aeson.Types (toJSONKeyText)
12-
import Data.Aeson.QQ
13-
import Data.Char
14-
import Data.Proxy
15-
import Data.Set (Set)
16-
import Data.Map (Map)
17-
import qualified Data.Text as Text
18-
import GHC.Generics
19-
20-
import Data.Swagger
21-
import Data.Swagger.Declare
22-
import Data.Swagger.Internal (SwaggerKind(..))
7+
import Prelude ()
8+
import Prelude.Compat
9+
10+
import Data.Aeson (ToJSON (..), ToJSONKey (..), Value)
11+
import Data.Aeson.QQ
12+
import Data.Aeson.Types (toJSONKeyText)
13+
import Data.Char
14+
import Data.Map (Map)
15+
import Data.Proxy
16+
import Data.Set (Set)
17+
import qualified Data.Text as Text
18+
import GHC.Generics
19+
20+
import Data.Swagger
21+
import Data.Swagger.Declare
22+
import Data.Swagger.Internal (SwaggerKind (..))
2323

2424
-- ========================================================================
2525
-- Unit type

‎test/Data/Swagger/Schema/ValidationSpec.hs

Lines changed: 51 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,41 +1,41 @@
1-
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE DeriveGeneric #-}
3-
{-# LANGUAGE PackageImports #-}
4-
{-# LANGUAGE RecordWildCards #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE PackageImports #-}
4+
{-# LANGUAGE RecordWildCards #-}
55
{-# LANGUAGE ScopedTypeVariables #-}
66
{-# OPTIONS_GHC -fno-warn-orphans #-}
77
module Data.Swagger.Schema.ValidationSpec where
88

9-
import Control.Applicative
10-
import Control.Lens ((&), (.~), (?~))
11-
import Data.Aeson
12-
import Data.Aeson.Types
13-
import Data.Int
14-
import Data.IntMap (IntMap)
15-
import Data.Hashable (Hashable)
16-
import "unordered-containers" Data.HashSet (HashSet)
9+
import Control.Applicative
10+
import Control.Lens ((&), (.~), (?~))
11+
import Data.Aeson
12+
import Data.Aeson.Types
13+
import Data.Hashable (Hashable)
14+
import Data.HashMap.Strict (HashMap)
15+
import qualified Data.HashMap.Strict as HashMap
16+
import "unordered-containers" Data.HashSet (HashSet)
1717
import qualified "unordered-containers" Data.HashSet as HashSet
18-
import Data.HashMap.Strict (HashMap)
19-
import qualified Data.HashMap.Strict as HashMap
20-
import Data.List.NonEmpty.Compat (NonEmpty(..), nonEmpty)
21-
import Data.Map (Map, fromList)
22-
import Data.Monoid (mempty)
23-
import Data.Proxy
24-
import Data.Time
25-
import qualified Data.Text as T
26-
import qualified Data.Text.Lazy as TL
27-
import Data.Version (Version)
28-
import Data.Set (Set)
29-
import Data.Word
30-
import GHC.Generics
31-
32-
import Data.Swagger
33-
import Data.Swagger.Declare
34-
35-
import Test.Hspec
36-
import Test.Hspec.QuickCheck
37-
import Test.QuickCheck
38-
import Test.QuickCheck.Instances ()
18+
import Data.Int
19+
import Data.IntMap (IntMap)
20+
import Data.List.NonEmpty.Compat (NonEmpty (..), nonEmpty)
21+
import Data.Map (Map, fromList)
22+
import Data.Monoid (mempty)
23+
import Data.Proxy
24+
import Data.Set (Set)
25+
import qualified Data.Text as T
26+
import qualified Data.Text.Lazy as TL
27+
import Data.Time
28+
import Data.Version (Version)
29+
import Data.Word
30+
import GHC.Generics
31+
32+
import Data.Swagger
33+
import Data.Swagger.Declare
34+
35+
import Test.Hspec
36+
import Test.Hspec.QuickCheck
37+
import Test.QuickCheck
38+
import Test.QuickCheck.Instances ()
3939

4040
shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
4141
shouldValidate _ x = validateToJSON x == []
@@ -83,6 +83,7 @@ spec = do
8383
prop "(HashMap String Int)" $ shouldValidate (Proxy :: Proxy (HashMap String Int))
8484
prop "(HashMap T.Text Int)" $ shouldValidate (Proxy :: Proxy (HashMap T.Text Int))
8585
prop "(HashMap TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (HashMap TL.Text Bool))
86+
prop "Object" $ shouldValidate (Proxy :: Proxy Object)
8687
prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
8788
prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
8889
prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
@@ -139,9 +140,9 @@ instance Arbitrary Color where
139140
arbitrary = arbitraryBoundedEnum
140141

141142
invalidColorToJSON :: Color -> Value
142-
invalidColorToJSON Red = toJSON "red"
143-
invalidColorToJSON Green = toJSON "green"
144-
invalidColorToJSON Blue = toJSON "blue"
143+
invalidColorToJSON Red = toJSON "red"
144+
invalidColorToJSON Green = toJSON "green"
145+
invalidColorToJSON Blue = toJSON "blue"
145146

146147
-- ========================================================================
147148
-- Paint (record with bounded enum property)
@@ -261,3 +262,17 @@ instance Arbitrary FreeForm where
261262
instance Eq ZonedTime where
262263
ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
263264

265+
-- ========================================================================
266+
-- Arbitrary instance for Data.Aeson.Value
267+
-- ========================================================================
268+
269+
instance Arbitrary Value where
270+
-- Weights are almost random
271+
-- Uniform oneof tends not to build complex objects cause of recursive call.
272+
arbitrary = resize 4 $ frequency
273+
[ (3, Object <$> arbitrary)
274+
, (3, Array <$> arbitrary)
275+
, (3, String <$> arbitrary)
276+
, (3, Number <$> arbitrary)
277+
, (3, Bool <$> arbitrary)
278+
, (1, return Null) ]

0 commit comments

Comments
 (0)