0d54ac1 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Add inferSchemaTypes

0d54ac1Nickolay Kudasov8 years ago

src/Data/Swagger/Internal/Schema/Validation.hs+69−31

compare with master

unifiedsplit

@@ -1,15 +1,16 @@

1+{-# LANGUAGE DataKinds #-}

1−{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE DeriveFunctor #-}

2−{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE FunctionalDependencies #-}

4+{-# LANGUAGE FunctionalDependencies #-}

4−{-# LANGUAGE GADTs #-}

5+{-# LANGUAGE GADTs #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6−{-# LANGUAGE LambdaCase #-}

7+{-# LANGUAGE LambdaCase #-}

7−{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE PackageImports #-}

9+{-# LANGUAGE PackageImports #-}

9−{-# LANGUAGE RankNTypes #-}

10+{-# LANGUAGE RankNTypes #-}

10−{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

11−{-# LANGUAGE TemplateHaskell #-}

12+{-# LANGUAGE TemplateHaskell #-}

12−{-# LANGUAGE UndecidableInstances #-}

13+{-# LANGUAGE UndecidableInstances #-}

13-- |

14-- |

14-- Module: Data.Swagger.Internal.Schema.Validation

15-- Module: Data.Swagger.Internal.Schema.Validation

@@ -20,28 +21,29 @@

20-- Validate JSON values with Swagger Schema.

21-- Validate JSON values with Swagger Schema.

21module Data.Swagger.Internal.Schema.Validation where

22module Data.Swagger.Internal.Schema.Validation where

23−import Control.Applicative

24+import Control.Applicative

24−import Control.Lens

25+import Control.Lens

25−import Control.Monad (when)

26+import Control.Monad (when)

27−import Data.Aeson hiding (Result)

28+import Data.Aeson hiding (Result)

28−import Data.Foldable (traverse_, for_, sequenceA_)

29+import Data.Foldable (for_, sequenceA_,

30+ traverse_)

29−import Data.HashMap.Strict (HashMap)

31+import Data.HashMap.Strict (HashMap)

30−import qualified Data.HashMap.Strict as HashMap

32+import qualified Data.HashMap.Strict as HashMap

33+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

31import qualified "unordered-containers" Data.HashSet as HashSet

34import qualified "unordered-containers" Data.HashSet as HashSet

32−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

33−import Data.Monoid

35+import Data.Monoid

34−import Data.Proxy

36+import Data.Proxy

35−import Data.Scientific (Scientific, isInteger)

37+import Data.Scientific (Scientific, isInteger)

36−import Data.Text (Text)

38+import Data.Text (Text)

37−import qualified Data.Text as Text

39+import qualified Data.Text as Text

38−import Data.Vector (Vector)

40+import Data.Vector (Vector)

39−import qualified Data.Vector as Vector

41+import qualified Data.Vector as Vector

40−

42+

41−import Data.Swagger.Declare

43+import Data.Swagger.Declare

42−import Data.Swagger.Internal

44+import Data.Swagger.Internal

43−import Data.Swagger.Internal.Schema

45+import Data.Swagger.Internal.Schema

44−import Data.Swagger.Lens

46+import Data.Swagger.Lens

46-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

48-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

47-- This can be used with QuickCheck to ensure those instances are coherent:

49-- This can be used with QuickCheck to ensure those instances are coherent:

@@ -329,6 +331,42 @@ validateEnum value = do

329 when (value `notElem` xs) $

331 when (value `notElem` xs) $

330 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

332 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

331

333

334+-- | Infer schema type based on used properties.

335+--

336+-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"

337+-- Just [SwaggerString]

338+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]

339+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

340+ [ SwaggerObject | any ($ sch)

341+ [ has (additionalProperties._Just)

342+ , has (maxProperties._Just)

343+ , has (minProperties._Just)

344+ , has (properties.folded)

345+ , has (required.folded) ] ]

346+

347+-- | Infer schema type based on used properties.

348+--

349+-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"

350+-- Just [SwaggerString]

351+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]

352+inferParamSchemaTypes sch = concat

353+ [ [ SwaggerArray | any ($ sch)

354+ [ has (items._Just)

355+ , has (maxItems._Just)

356+ , has (minItems._Just)

357+ , has (uniqueItems._Just) ] ]

358+ , [ SwaggerInteger | any ($ sch)

359+ [ has (exclusiveMaximum._Just)

360+ , has (exclusiveMinimum._Just)

361+ , has (maximum_._Just)

362+ , has (minimum_._Just)

363+ , has (multipleOf._Just) ] ]

364+ , [ SwaggerString | any ($ sch)

365+ [ has (maxLength._Just)

366+ , has (minLength._Just)

367+ , has (pattern._Just) ] ]

368+ ]

369+

332validateSchemaType :: Value -> Validation Schema ()

370validateSchemaType :: Value -> Validation Schema ()

333validateSchemaType value = withSchema $ \sch ->

371validateSchemaType value = withSchema $ \sch ->

334 case (sch ^. type_, value) of

372 case (sch ^. type_, value) of