Deterministic ordering for API methods

2024-11-26 12:46:37 +03:00 · 2022-03-09 13:35:59 +01:00 · 2022-03-09 13:35:59 +01:00 · 7dc76f36e3
commit 7dc76f36e3
parent c7a7dfa111
7 changed files with 59 additions and 54 deletions
--- a/src/Tie.hs
+++ b/src/Tie.hs
@ -132,11 +132,15 @@ generate write packageName apiName inputFile = do
          (\_ -> error "could not resolve reference")

  -- Extract all the Operations from the spec
-  operations <-
+  operations' <-
    pathItemsToOperation
      resolver
      errors
      (specPaths openApi)
+  let operations =
+        sortOn
+          (\Operation {name} -> name)
+          operations'

  -- Only extract the direct, shallow dependencies. This is used to get a precise
  -- import list for the api and schema modules.
--- a/test/golden/enum.yaml.out
+++ b/test/golden/enum.yaml.out
@ -38,8 +38,8 @@ import Test.Schemas.Package
 import Test.Schemas.Order

 import Test.Response.ListPackages
-import Test.Response.ListPackages3
 import Test.Response.ListPackages2
+import Test.Response.ListPackages3
 import Test.Response.ListPackages4

 data Api m = Api {
@ -47,14 +47,14 @@ data Api m = Api {
    listPackages ::
        m ListPackagesResponse,
    -- | List all packages
+    listPackages2 ::
+        m ListPackages2Response,
+    -- | List all packages
    listPackages3 ::
        -- @order@
        (Data.Maybe.Maybe (ListPackages3OrderParam)) ->
        m ListPackages3Response,
    -- | List all packages
-    listPackages2 ::
-        m ListPackages2Response,
-    -- | List all packages
    listPackages4 ::
        -- @order@
        (Data.Maybe.Maybe (Order)) ->
--- a/test/golden/lists.yaml.out
+++ b/test/golden/lists.yaml.out
@ -33,23 +33,23 @@ import Test.Request
 import Test.Response

 import Test.Schemas.Packages
-import Test.Schemas.Inline
 import Test.Schemas.Package
+import Test.Schemas.Inline

 import Test.Response.ListPackages
-import Test.Response.ListPackages3
 import Test.Response.ListPackages2
+import Test.Response.ListPackages3

 data Api m = Api {
    -- | List all packages
    listPackages ::
        m ListPackagesResponse,
    -- | List all packages
-    listPackages3 ::
-        m ListPackages3Response,
-    -- | List all packages
    listPackages2 ::
-        m ListPackages2Response
+        m ListPackages2Response,
+    -- | List all packages
+    listPackages3 ::
+        m ListPackages3Response
 }

 application :: (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
--- a/test/golden/oneof.yaml
+++ b/test/golden/oneof.yaml
@ -36,7 +36,7 @@ paths:
  /packages3:
    get:
      summary: List all packages
-      operationId: listPackages2
+      operationId: listPackages3
      tags:
        - packages
      responses:
--- a/test/golden/oneof.yaml.out
+++ b/test/golden/oneof.yaml.out
@ -33,12 +33,12 @@ import Test.Request
 import Test.Response

 import Test.Schemas.Packages
-import Test.Schemas.Inline2
 import Test.Schemas.Inline
+import Test.Schemas.Inline2

 import Test.Response.ListPackages
 import Test.Response.ListPackages2
-import Test.Response.ListPackages2
+import Test.Response.ListPackages3

 data Api m = Api {
    -- | List all packages
@ -48,8 +48,8 @@ data Api m = Api {
    listPackages2 ::
        m ListPackages2Response,
    -- | List all packages
-    listPackages2 ::
-        m ListPackages2Response
+    listPackages3 ::
+        m ListPackages3Response
 }

 application :: (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
@ -79,7 +79,7 @@ application run api notFound request respond =
            case Network.Wai.requestMethod request of
                "GET" ->
                    run request (do
-                        response <- Control.Monad.Catch.handle pure (listPackages2 api  )
+                        response <- Control.Monad.Catch.handle pure (listPackages3 api  )
                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
                    )
                x ->
@ -414,14 +414,14 @@ instance ToResponse ListPackages2Response where
    toResponse (ListPackages2Response200 x ) =
        Network.Wai.responseBuilder (toEnum 200) [(Network.HTTP.Types.hContentType, "application/json")] (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
 ---------------------
-Test/Response/ListPackages2.hs
+Test/Response/ListPackages3.hs

 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
-module Test.Response.ListPackages2 where
+module Test.Response.ListPackages3 where

 import qualified Control.Applicative
 import qualified Control.Exception
@ -451,14 +451,14 @@ import Test.Response



-data ListPackages2Response
-    = ListPackages2Response200 Inline2 
+data ListPackages3Response
+    = ListPackages3Response200 Inline2 
    deriving (Show)

-instance Control.Exception.Exception ListPackages2Response
+instance Control.Exception.Exception ListPackages3Response

-instance ToResponse ListPackages2Response where
-    toResponse (ListPackages2Response200 x ) =
+instance ToResponse ListPackages3Response where
+    toResponse (ListPackages3Response200 x ) =
        Network.Wai.responseBuilder (toEnum 200) [(Network.HTTP.Types.hContentType, "application/json")] (Data.Aeson.fromEncoding (Data.Aeson.toEncoding x))
 ---------------------
 Test/Schemas/Inline.hs
@ -760,6 +760,7 @@ library
    Test.Response
    Test.Response.ListPackages
    Test.Response.ListPackages2
+    Test.Response.ListPackages3
    Test.Schemas.Inline
    Test.Schemas.Inline2
    Test.Schemas.Package
--- a/test/golden/petstore.yaml.out
+++ b/test/golden/petstore.yaml.out
@ -33,24 +33,24 @@ import Test.Request
 import Test.Response

 import Test.Schemas.Error
-import Test.Schemas.Pets
 import Test.Schemas.Error
+import Test.Schemas.Pets
 import Test.Schemas.Error
 import Test.Schemas.Pet

-import Test.Response.ListPets
 import Test.Response.CreatePets
+import Test.Response.ListPets
 import Test.Response.ShowPetById

 data Api m = Api {
+    -- | Create a pet
+    createPets ::
+        m CreatePetsResponse,
    -- | List all pets
    listPets ::
        -- @limit@ How many items to return at one time (max 100)
        (Data.Maybe.Maybe (GHC.Int.Int32)) ->
        m ListPetsResponse,
-    -- | Create a pet
-    createPets ::
-        m CreatePetsResponse,
    -- | Info for a specific pet
    showPetById ::
        -- @petId@ The id of the pet to retrieve
@ -63,17 +63,17 @@ application run api notFound request respond =
    case Network.Wai.pathInfo request of
        ["pets"] ->
            case Network.Wai.requestMethod request of
-                "POST" ->
-                    run request (do
-                        response <- Control.Monad.Catch.handle pure (createPets api  )
-                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
-                    )
                "GET" ->
                    optionalQueryParameter "limit" False (\__limit request respond ->
                        run request (do
                            response <- Control.Monad.Catch.handle pure (listPets api __limit )
                            Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
                        )) request respond
+                "POST" ->
+                    run request (do
+                        response <- Control.Monad.Catch.handle pure (createPets api  )
+                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
+                    )
                x ->
                    unsupportedMethod x

--- a/test/golden/test1.yaml.out
+++ b/test/golden/test1.yaml.out
@ -32,23 +32,13 @@ import qualified Web.HttpApiData
 import Test.Request
 import Test.Response

-import Test.Schemas.Vehicle
 import Test.Schemas.NISE
+import Test.Schemas.Vehicle

-import Test.Response.GetUser
 import Test.Response.CreateUser
+import Test.Response.GetUser

 data Api m = Api {
-    getUser ::
-        -- @id@ Uniquely identifies a user
-        GHC.Int.Int ->
-        -- @name@ Name of a user
-        Data.Text.Text ->
-        -- @page@
-        GHC.Int.Int ->
-        -- @offset@
-        (Data.Maybe.Maybe (GHC.Int.Int)) ->
-        m GetUserResponse,
    -- | Adds a new user
    createUser ::
        -- @id@ Uniquely identifies a user
@ -61,7 +51,17 @@ data Api m = Api {
        (Data.Maybe.Maybe (GHC.Int.Int)) ->
        -- Some nice request body
        CreateUserRequestBody ->
-        m CreateUserResponse
+        m CreateUserResponse,
+    getUser ::
+        -- @id@ Uniquely identifies a user
+        GHC.Int.Int ->
+        -- @name@ Name of a user
+        Data.Text.Text ->
+        -- @page@
+        GHC.Int.Int ->
+        -- @offset@
+        (Data.Maybe.Maybe (GHC.Int.Int)) ->
+        m GetUserResponse
 }

 application :: (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Class.MonadIO m) => (forall a . Network.Wai.Request -> m a -> IO a) -> Api m -> Network.Wai.Application -> Network.Wai.Application
@ -71,6 +71,13 @@ application run api notFound request respond =
            pathVariable __id (\__id request respond ->
                pathVariable __name (\__name request respond ->
                    case Network.Wai.requestMethod request of
+                        "GET" ->
+                            requiredQueryParameter "page" (\__page request respond ->
+                                optionalQueryParameter "offset" False (\__offset request respond ->
+                                    run request (do
+                                        response <- Control.Monad.Catch.handle pure (getUser api __id __name __page __offset )
+                                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
+                                    )) request respond) request respond
                        "POST" ->
                            requiredQueryParameter "page" (\__page request respond ->
                                optionalQueryParameter "offset" False (\__offset request respond ->
@ -79,13 +86,6 @@ application run api notFound request respond =
                                            response <- Control.Monad.Catch.handle pure (createUser api __id __name __page __offset body)
                                            Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
                                        )) request respond) request respond) request respond
-                        "GET" ->
-                            requiredQueryParameter "page" (\__page request respond ->
-                                optionalQueryParameter "offset" False (\__offset request respond ->
-                                    run request (do
-                                        response <- Control.Monad.Catch.handle pure (getUser api __id __name __page __offset )
-                                        Control.Monad.IO.Class.liftIO (respond $! (toResponse response))
-                                    )) request respond) request respond
                        x ->
                            unsupportedMethod x) request respond) request respond