e924625 · typeable/swagger2

git.iko.soy/typeable/swagger2

Use OrdHashMap

commite924625a5d5ab3eb7f528cf1322f407002242f5c authorOleg Grenrus <oleg.grenrus@iki.fi> dateSat 5 Mar 2016, 20:16 (11 years ago) parent4cb57ea

6 files changed+46−26

compare with master

unifiedsplit

src/Data/Swagger/Internal.hs+18−11 src/Data/Swagger/Internal/Schema.hs+11−8 src/Data/Swagger/Internal/Schema/Validation.hs+4−2 src/Data/Swagger/Internal/Utils.hs+6 src/Data/Swagger/Operation.hs+5−4 test/Data/Swagger/SchemaSpec.hs+2−1

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

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

3838import Network.HTTP.Media (MediaType)

3939import Text.Read (readMaybe)

4040

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

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

43+

4144import Data.Swagger.Internal.Utils

4245

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

44−type Definitions = HashMap Text

47+type Definitions = InsOrdHashMap Text

4548

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

4750data Swagger = Swagger

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

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

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

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

76− , _swaggerPaths :: HashMap FilePath PathItem

79+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem

7780

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

7982 , _swaggerDefinitions :: Definitions Schema

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

482485 , _schemaRequired :: [ParamName]

483486

484487 , _schemaAllOf :: Maybe [Schema]

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

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

486489 , _schemaAdditionalProperties :: Maybe (Referenced Schema)

487490

488491 , _schemaDiscriminator :: Maybe Text

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

574577

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

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

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

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

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

579582

580583type HttpStatusCode = Int

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

593596 , _responseSchema :: Maybe (Referenced Schema)

594597

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

596− , _responseHeaders :: HashMap HeaderName Header

599+ , _responseHeaders :: InsOrdHashMap HeaderName Header

597600

598601 -- | An example of the response message.

599602 , _responseExamples :: Maybe Example

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

659662 _oauth2Flow :: OAuth2Flow

660663

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

662− , _oauth2Scopes :: HashMap Text Text

665+ , _oauth2Scopes :: InsOrdHashMap Text Text

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

664667

665668data SecuritySchemeType

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

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

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

682685newtype SecurityRequirement = SecurityRequirement

683− { getSecurityRequirement :: HashMap Text [Text]

686+ { getSecurityRequirement :: InsOrdHashMap Text [Text]

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

685688

686689-- | Tag name.

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

818821 swaggerMempty = HashMap.empty

819822 swaggerMappend = HashMap.unionWith mappend

820823

824+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where

825+ swaggerMempty = InsOrdHashMap.empty

826+ swaggerMappend = InsOrdHashMap.unionWith mappend

827+

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

822829 swaggerMempty = Inline mempty

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

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

972979

973980instance ToJSON Responses where

974981 toJSON (Responses def rs) = omitEmpties $

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

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

976983

977984instance ToJSON Response where

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

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

10711078

10721079instance FromJSON Schema where

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

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

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

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

10761083

10771084instance FromJSON Header where

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

11181125instance FromJSON Responses where

11191126 parseJSON (Object o) = Responses

11201127 <$> o .:? "default"

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

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

11221129 parseJSON _ = empty

11231130

11241131instance FromJSON Example where

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

11281135

11291136instance FromJSON Response where

11301137 parseJSON = genericParseJSON (jsonPrefix "response")

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

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

11321139

11331140instance FromJSON Operation where

11341141 parseJSON = genericParseJSON (jsonPrefix "operation")

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

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

2525import Control.Monad

2626import Control.Monad.Writer

2727import Data.Aeson

28+import qualified Data.Aeson.Types as Aeson

2829import Data.Char

2930import Data.Data (Data)

3031import Data.Foldable (traverse_)

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

3334import qualified Data.HashMap.Strict as HashMap

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

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

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

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

3639import Data.Int

3740import Data.IntSet (IntSet)

3841import Data.IntMap (IntMap)

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

194197 -- have already declared it.

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

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

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

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

198201 when (not known) $ do

199202 declare [(name, schema)]

200203 void $ declareNamedSchema proxy

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

213216 where

214217 deref r@(Ref (Reference name))

215218 | p name =

216− case HashMap.lookup name defs of

219+ case InsOrdHashMap.lookup name defs of

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

218221 Nothing -> r

219222 | otherwise = r

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

255258inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

256259 where

257260 nonRecursive name =

258− case HashMap.lookup name defs of

261+ case InsOrdHashMap.lookup name defs of

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

260263 Nothing -> False

261264

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

267270 seen <- looks (name `elem`)

268271 when (not seen) $ do

269272 declare [name]

270− traverse_ usedNames (HashMap.lookup name defs)

273+ traverse_ usedNames (InsOrdHashMap.lookup name defs)

271274 Inline subschema -> usedNames subschema

272275

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

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

331334 go js@(Object o) = mempty

332335 & type_ .~ SwaggerObject

333336 & required .~ HashMap.keys o

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

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

335338

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

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

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

381384 go js@(Object o) = mempty

382385 & type_ .~ SwaggerObject

383386 & required .~ names

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

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

385388 & maxProperties ?~ fromIntegral (length names)

386389 & minProperties ?~ fromIntegral (length names)

387390 & enum_ ?~ [js]

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

605608 -- have already declared it.

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

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

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

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

609612 when (not known) $ do

610613 declare [(name, schema)]

611614 void $ gdeclareNamedSchema opts proxy mempty

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

662665

663666 toStringTag schema = mempty

664667 & type_ .~ SwaggerString

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

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

666669

667670type AllNullary = All

668671

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

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

3030import Data.HashMap.Strict (HashMap)

3131import qualified Data.HashMap.Strict as HashMap

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

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

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

3335import Data.Monoid

3436import Data.Proxy

3537import Data.Scientific (Scientific, isInteger)

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

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

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

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

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

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

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

179181 Just s -> f s

180182

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

290292 case v of

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

292294 _ ->

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

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

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

295297 Just s -> validateWithSchemaRef s v

296298

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

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

2020import Data.Hashable (Hashable)

2121import Data.HashMap.Strict (HashMap)

2222import qualified Data.HashMap.Strict as HashMap

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

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

2325import Data.Map (Map)

2426import Data.Monoid

2527import Data.Set (Set)

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

161163 swaggerMempty = mempty

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

163165

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

167+ swaggerMempty = mempty

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

169+

164170instance SwaggerMonoid Text where

165171 swaggerMempty = mempty

166172 swaggerMappend x "" = x

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

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

4646import Data.Swagger.Lens

4747import Data.Swagger.Schema

4848

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

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

51+

4952-- $setup

5053-- >>> import Data.Aeson

5154-- >>> import Data.Proxy

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

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

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

6063prependPath :: FilePath -> Swagger -> Swagger

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

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

6265 where

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

64−

6566 x </> y = case trim y of

6667 "" -> "/" <> trim x

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

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

8889 where

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

9091 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

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

9394 Nothing -> pure (path, item)

9495

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

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

1717import qualified Data.Text as Text

1818import GHC.Generics

1919

20+import qualified Data.Swagger.OrdHashMap as OrdHashMap

2021import Data.Swagger

2122import Data.Swagger.Declare

2223

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

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

3536checkDefs proxy names =

3637 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)

3839 where

3940 defs = execDeclare (declareNamedSchema proxy) mempty

4041