e924625 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Use OrdHashMap

e924625Oleg Grenrus11 years ago

src/Data/Swagger/Internal.hs+18−11

compare with master

unifiedsplit

@@ -38,10 +38,13 @@ import Network (HostName, PortNumber)

38import Network.HTTP.Media (MediaType)

39import Text.Read (readMaybe)

41+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

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

43+

41import Data.Swagger.Internal.Utils

44import Data.Swagger.Internal.Utils

43-- | A list of definitions that can be used in references.

46-- | A list of definitions that can be used in references.

44−type Definitions = HashMap Text

47+type Definitions = InsOrdHashMap Text

46-- | This is the root document object for the API specification.

49-- | This is the root document object for the API specification.

47data Swagger = Swagger

50data Swagger = Swagger

@@ -73,7 +76,7 @@ data Swagger = Swagger

73 -- | The available paths and operations for the API.

76 -- | The available paths and operations for the API.

74 -- Holds the relative paths to the individual endpoints.

77 -- Holds the relative paths to the individual endpoints.

75 -- The path is appended to the @'basePath'@ in order to construct the full URL.

78 -- The path is appended to the @'basePath'@ in order to construct the full URL.

76− , _swaggerPaths :: HashMap FilePath PathItem

79+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem

78 -- | An object to hold data types produced and consumed by operations.

81 -- | An object to hold data types produced and consumed by operations.

79 , _swaggerDefinitions :: Definitions Schema

82 , _swaggerDefinitions :: Definitions Schema

@@ -482,7 +485,7 @@ data Schema = Schema

482 , _schemaRequired :: [ParamName]

485 , _schemaRequired :: [ParamName]

483

486

484 , _schemaAllOf :: Maybe [Schema]

487 , _schemaAllOf :: Maybe [Schema]

485− , _schemaProperties :: HashMap Text (Referenced Schema)

488+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)

486 , _schemaAdditionalProperties :: Maybe (Referenced Schema)

489 , _schemaAdditionalProperties :: Maybe (Referenced Schema)

487

490

488 , _schemaDiscriminator :: Maybe Text

491 , _schemaDiscriminator :: Maybe Text

@@ -574,7 +577,7 @@ data Responses = Responses

574

577

575 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).

578 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).

576 -- Describes the expected response for those HTTP status codes.

579 -- Describes the expected response for those HTTP status codes.

577− , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)

580+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)

578 } deriving (Eq, Show, Generic, Data, Typeable)

581 } deriving (Eq, Show, Generic, Data, Typeable)

579

582

580type HttpStatusCode = Int

583type HttpStatusCode = Int

@@ -593,7 +596,7 @@ data Response = Response

593 , _responseSchema :: Maybe (Referenced Schema)

596 , _responseSchema :: Maybe (Referenced Schema)

594

597

595 -- | A list of headers that are sent with the response.

598 -- | A list of headers that are sent with the response.

596− , _responseHeaders :: HashMap HeaderName Header

599+ , _responseHeaders :: InsOrdHashMap HeaderName Header

597

600

598 -- | An example of the response message.

601 -- | An example of the response message.

599 , _responseExamples :: Maybe Example

602 , _responseExamples :: Maybe Example

@@ -659,7 +662,7 @@ data OAuth2Params = OAuth2Params

659 _oauth2Flow :: OAuth2Flow

662 _oauth2Flow :: OAuth2Flow

660

663

661 -- | The available scopes for the OAuth2 security scheme.

664 -- | The available scopes for the OAuth2 security scheme.

662− , _oauth2Scopes :: HashMap Text Text

665+ , _oauth2Scopes :: InsOrdHashMap Text Text

663 } deriving (Eq, Show, Generic, Data, Typeable)

666 } deriving (Eq, Show, Generic, Data, Typeable)

664

667

665data SecuritySchemeType

668data SecuritySchemeType

@@ -680,7 +683,7 @@ data SecurityScheme = SecurityScheme

680-- The object can have multiple security schemes declared in it which are all required

683-- The object can have multiple security schemes declared in it which are all required

681-- (that is, there is a logical AND between the schemes).

684-- (that is, there is a logical AND between the schemes).

682newtype SecurityRequirement = SecurityRequirement

685newtype SecurityRequirement = SecurityRequirement

683− { getSecurityRequirement :: HashMap Text [Text]

686+ { getSecurityRequirement :: InsOrdHashMap Text [Text]

684 } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)

687 } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)

685

688

686-- | Tag name.

689-- | Tag name.

@@ -818,6 +821,10 @@ instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where

818 swaggerMempty = HashMap.empty

821 swaggerMempty = HashMap.empty

819 swaggerMappend = HashMap.unionWith mappend

822 swaggerMappend = HashMap.unionWith mappend

820

823

824+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where

825+ swaggerMempty = InsOrdHashMap.empty

826+ swaggerMappend = InsOrdHashMap.unionWith mappend

827+

821instance Monoid a => SwaggerMonoid (Referenced a) where

828instance Monoid a => SwaggerMonoid (Referenced a) where

822 swaggerMempty = Inline mempty

829 swaggerMempty = Inline mempty

823 swaggerMappend (Inline x) (Inline y) = Inline (x <> y)

830 swaggerMappend (Inline x) (Inline y) = Inline (x <> y)

@@ -972,7 +979,7 @@ instance ToJSON ParamOtherSchema where

972

979

973instance ToJSON Responses where

980instance ToJSON Responses where

974 toJSON (Responses def rs) = omitEmpties $

981 toJSON (Responses def rs) = omitEmpties $

975− toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]

982+ toJSON (InsOrdHashMap.mapKeys show rs) <+> object [ "default" .= def ]

976

983

977instance ToJSON Response where

984instance ToJSON Response where

978 toJSON = omitEmpties . genericToJSON (jsonPrefix "response")

985 toJSON = omitEmpties . genericToJSON (jsonPrefix "response")

@@ -1071,7 +1078,7 @@ instance FromJSON SecurityScheme where

1071

1078

1072instance FromJSON Schema where

1079instance FromJSON Schema where

1073 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")

1080 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")

1074− `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)

1081+ `withDefaults` [ "properties" .= (mempty :: InsOrdHashMap Text Schema)

1075 , "required" .= ([] :: [ParamName]) ]

1082 , "required" .= ([] :: [ParamName]) ]

1076

1083

1077instance FromJSON Header where

1084instance FromJSON Header where

@@ -1118,7 +1125,7 @@ instance FromJSON ParamOtherSchema where

1118instance FromJSON Responses where

1125instance FromJSON Responses where

1119 parseJSON (Object o) = Responses

1126 parseJSON (Object o) = Responses

1120 <$> o .:? "default"

1127 <$> o .:? "default"

1121− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)

1128+ <*> (parseJSON (Object (HashMap.delete "default" o)))

1122 parseJSON _ = empty

1129 parseJSON _ = empty

1123

1130

1124instance FromJSON Example where

1131instance FromJSON Example where

@@ -1128,7 +1135,7 @@ instance FromJSON Example where

1128

1135

1129instance FromJSON Response where

1136instance FromJSON Response where

1130 parseJSON = genericParseJSON (jsonPrefix "response")

1137 parseJSON = genericParseJSON (jsonPrefix "response")

1131− `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]

1138+ `withDefaults` [ "headers" .= (mempty :: InsOrdHashMap HeaderName Header) ]

1132

1139

1133instance FromJSON Operation where

1140instance FromJSON Operation where

1134 parseJSON = genericParseJSON (jsonPrefix "operation")

1141 parseJSON = genericParseJSON (jsonPrefix "operation")

src/Data/Swagger/Internal/Schema.hs+11−8

@@ -25,6 +25,7 @@ import Control.Applicative

25import Control.Monad

26import Control.Monad.Writer

27import Data.Aeson

28+import qualified Data.Aeson.Types as Aeson

28import Data.Char

29import Data.Char

29import Data.Data (Data)

30import Data.Data (Data)

30import Data.Foldable (traverse_)

31import Data.Foldable (traverse_)

@@ -33,6 +34,8 @@ import Data.HashMap.Strict (HashMap)

33import qualified Data.HashMap.Strict as HashMap

34import qualified Data.HashMap.Strict as HashMap

34import "unordered-containers" Data.HashSet (HashSet)

35import "unordered-containers" Data.HashSet (HashSet)

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

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

37+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

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

36import Data.Int

39import Data.Int

37import Data.IntSet (IntSet)

40import Data.IntSet (IntSet)

38import Data.IntMap (IntMap)

41import Data.IntMap (IntMap)

@@ -194,7 +197,7 @@ declareSchemaRef proxy = do

194 -- have already declared it.

197 -- have already declared it.

195 -- If we have, we don't need to declare anything for

198 -- If we have, we don't need to declare anything for

196 -- this schema this time and thus simply return the reference.

199 -- this schema this time and thus simply return the reference.

197− known <- looks (HashMap.member name)

200+ known <- looks (InsOrdHashMap.member name)

198 when (not known) $ do

201 when (not known) $ do

199 declare [(name, schema)]

202 declare [(name, schema)]

200 void $ declareNamedSchema proxy

203 void $ declareNamedSchema proxy

@@ -213,7 +216,7 @@ inlineSchemasWhen p defs = template %~ deref

213 where

216 where

214 deref r@(Ref (Reference name))

217 deref r@(Ref (Reference name))

215 | p name =

218 | p name =

216− case HashMap.lookup name defs of

219+ case InsOrdHashMap.lookup name defs of

217 Just schema -> Inline (inlineSchemasWhen p defs schema)

220 Just schema -> Inline (inlineSchemasWhen p defs schema)

218 Nothing -> r

221 Nothing -> r

219 | otherwise = r

222 | otherwise = r

@@ -255,7 +258,7 @@ inlineNonRecursiveSchemas :: Data s => (Definitions Schema) -> s -> s

255inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

258inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

256 where

259 where

257 nonRecursive name =

260 nonRecursive name =

258− case HashMap.lookup name defs of

261+ case InsOrdHashMap.lookup name defs of

259 Just schema -> name `notElem` execDeclare (usedNames schema) mempty

262 Just schema -> name `notElem` execDeclare (usedNames schema) mempty

260 Nothing -> False

263 Nothing -> False

261

264

@@ -267,7 +270,7 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

267 seen <- looks (name `elem`)

270 seen <- looks (name `elem`)

268 when (not seen) $ do

271 when (not seen) $ do

269 declare [name]

272 declare [name]

270− traverse_ usedNames (HashMap.lookup name defs)

273+ traverse_ usedNames (InsOrdHashMap.lookup name defs)

271 Inline subschema -> usedNames subschema

274 Inline subschema -> usedNames subschema

272

275

273-- | Default schema for binary data (any sequence of octets).

276-- | Default schema for binary data (any sequence of octets).

@@ -331,7 +334,7 @@ sketchSchema = sketch . toJSON

331 go js@(Object o) = mempty

334 go js@(Object o) = mempty

332 & type_ .~ SwaggerObject

335 & type_ .~ SwaggerObject

333 & required .~ HashMap.keys o

336 & required .~ HashMap.keys o

334− & properties .~ fmap (Inline . go) o

337+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

335

338

336-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

339-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

337-- Produced schema uses as much constraints as possible.

340-- Produced schema uses as much constraints as possible.

@@ -381,7 +384,7 @@ sketchStrictSchema = go . toJSON

381 go js@(Object o) = mempty

384 go js@(Object o) = mempty

382 & type_ .~ SwaggerObject

385 & type_ .~ SwaggerObject

383 & required .~ names

386 & required .~ names

384− & properties .~ fmap (Inline . go) o

387+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

385 & maxProperties ?~ fromIntegral (length names)

388 & maxProperties ?~ fromIntegral (length names)

386 & minProperties ?~ fromIntegral (length names)

389 & minProperties ?~ fromIntegral (length names)

387 & enum_ ?~ [js]

390 & enum_ ?~ [js]

@@ -605,7 +608,7 @@ gdeclareSchemaRef opts proxy = do

605 -- have already declared it.

608 -- have already declared it.

606 -- If we have, we don't need to declare anything for

609 -- If we have, we don't need to declare anything for

607 -- this schema this time and thus simply return the reference.

610 -- this schema this time and thus simply return the reference.

608− known <- looks (HashMap.member name)

611+ known <- looks (InsOrdHashMap.member name)

609 when (not known) $ do

612 when (not known) $ do

610 declare [(name, schema)]

613 declare [(name, schema)]

611 void $ gdeclareNamedSchema opts proxy mempty

614 void $ gdeclareNamedSchema opts proxy mempty

@@ -662,7 +665,7 @@ gdeclareNamedSumSchema opts proxy s

662

665

663 toStringTag schema = mempty

666 toStringTag schema = mempty

664 & type_ .~ SwaggerString

667 & type_ .~ SwaggerString

665− & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

668+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

666

669

667type AllNullary = All

670type AllNullary = All

668

671

src/Data/Swagger/Internal/Schema/Validation.hs+4−2

@@ -30,6 +30,8 @@ import Data.Foldable (traverse_, for_, sequenceA_)

30import Data.HashMap.Strict (HashMap)

31import qualified Data.HashMap.Strict as HashMap

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

33+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

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

33import Data.Monoid

35import Data.Monoid

34import Data.Proxy

36import Data.Proxy

35import Data.Scientific (Scientific, isInteger)

37import Data.Scientific (Scientific, isInteger)

@@ -174,7 +176,7 @@ sub_ = lmap . view

174-- | Validate value against a schema given schema reference and validation function.

176-- | Validate value against a schema given schema reference and validation function.

175withRef :: Reference -> (Schema -> Validation s a) -> Validation s a

177withRef :: Reference -> (Schema -> Validation s a) -> Validation s a

176withRef (Reference ref) f = withConfig $ \cfg ->

178withRef (Reference ref) f = withConfig $ \cfg ->

177− case HashMap.lookup ref (configDefinitions cfg) of

179+ case InsOrdHashMap.lookup ref (configDefinitions cfg) of

178 Nothing -> invalid $ "unknown schema " ++ show ref

180 Nothing -> invalid $ "unknown schema " ++ show ref

179 Just s -> f s

181 Just s -> f s

180

182

@@ -290,7 +292,7 @@ validateObject o = withSchema $ \schema ->

290 case v of

292 case v of

291 Null | not (k `elem` (schema ^. required)) -> valid -- null is fine for non-required property

293 Null | not (k `elem` (schema ^. required)) -> valid -- null is fine for non-required property

292 _ ->

294 _ ->

293− case HashMap.lookup k (schema ^. properties) of

295+ case InsOrdHashMap.lookup k (schema ^. properties) of

294 Nothing -> check additionalProperties $ \s -> validateWithSchemaRef s v

296 Nothing -> check additionalProperties $ \s -> validateWithSchemaRef s v

295 Just s -> validateWithSchemaRef s v

297 Just s -> validateWithSchemaRef s v

296

298

src/Data/Swagger/Internal/Utils.hs+6

@@ -20,6 +20,8 @@ import Data.Data

20import Data.Hashable (Hashable)

21import Data.HashMap.Strict (HashMap)

22import qualified Data.HashMap.Strict as HashMap

23+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

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

23import Data.Map (Map)

25import Data.Map (Map)

24import Data.Monoid

26import Data.Monoid

25import Data.Set (Set)

27import Data.Set (Set)

@@ -161,6 +163,10 @@ instance (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where

161 swaggerMempty = mempty

163 swaggerMempty = mempty

162 swaggerMappend = HashMap.unionWith (\_old new -> new)

164 swaggerMappend = HashMap.unionWith (\_old new -> new)

163

165

166+instance (Eq k, Hashable k) => SwaggerMonoid (InsOrdHashMap k v) where

167+ swaggerMempty = mempty

168+ swaggerMappend = InsOrdHashMap.unionWith (\_old new -> new)

169+

164instance SwaggerMonoid Text where

170instance SwaggerMonoid Text where

165 swaggerMempty = mempty

171 swaggerMempty = mempty

166 swaggerMappend x "" = x

172 swaggerMappend x "" = x

src/Data/Swagger/Operation.hs+5−4

@@ -46,6 +46,9 @@ import Data.Swagger.Internal

46import Data.Swagger.Lens

47import Data.Swagger.Schema

49+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

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

51+

49-- $setup

52-- $setup

50-- >>> import Data.Aeson

53-- >>> import Data.Aeson

51-- >>> import Data.Proxy

54-- >>> import Data.Proxy

@@ -58,10 +61,8 @@ import Data.Swagger.Schema

58-- >>> encode $ prependPath "user/{user_id}" api ^. paths

61-- >>> encode $ prependPath "user/{user_id}" api ^. paths

59-- "{\"/user/{user_id}/info\":{}}"

62-- "{\"/user/{user_id}/info\":{}}"

60prependPath :: FilePath -> Swagger -> Swagger

63prependPath :: FilePath -> Swagger -> Swagger

61−prependPath path = paths %~ mapKeys (path </>)

64+prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)

62 where

65 where

63− mapKeys f = HashMap.fromList . map (first f) . HashMap.toList

64−

65 x </> y = case trim y of

66 x </> y = case trim y of

66 "" -> "/" <> trim x

67 "" -> "/" <> trim x

67 y' -> "/" <> trim x <> "/" <> y'

68 y' -> "/" <> trim x <> "/" <> y'

@@ -88,7 +89,7 @@ operationsOf sub = paths.itraversed.withIndex.subops

88 where

89 where

89 -- | Traverse operations that correspond to paths and methods of the sub API.

90 -- | Traverse operations that correspond to paths and methods of the sub API.

90 subops :: Traversal' (FilePath, PathItem) Operation

91 subops :: Traversal' (FilePath, PathItem) Operation

91− subops f (path, item) = case HashMap.lookup path (sub ^. paths) of

92+ subops f (path, item) = case InsOrdHashMap.lookup path (sub ^. paths) of

92 Just subitem -> (,) path <$> methodsOf subitem f item

93 Just subitem -> (,) path <$> methodsOf subitem f item

93 Nothing -> pure (path, item)

94 Nothing -> pure (path, item)

test/Data/Swagger/SchemaSpec.hs+2−1

@@ -17,6 +17,7 @@ import qualified Data.Set as Set

17import qualified Data.Text as Text

18import GHC.Generics

20+import qualified Data.Swagger.OrdHashMap as OrdHashMap

20import Data.Swagger

21import Data.Swagger

21import Data.Swagger.Declare

22import Data.Swagger.Declare

@@ -34,7 +35,7 @@ checkSchemaName sname proxy =

34checkDefs :: ToSchema a => Proxy a -> [String] -> Spec

35checkDefs :: ToSchema a => Proxy a -> [String] -> Spec

35checkDefs proxy names =

36checkDefs proxy names =

36 it ("uses these definitions " ++ show names) $

37 it ("uses these definitions " ++ show names) $

37− Set.fromList (HashMap.keys defs) `shouldBe` Set.fromList (map Text.pack names)

38+ Set.fromList (OrdHashMap.keys defs) `shouldBe` Set.fromList (map Text.pack names)

38 where

39 where

39 defs = execDeclare (declareNamedSchema proxy) mempty

40 defs = execDeclare (declareNamedSchema proxy) mempty