From 9d2ac22365168304abdf0b6dca148c5b81c8333b Mon Sep 17 00:00:00 2001
From: Gil Mizrahi <gilmi@posteo.net>
Date: Wed, 26 Jan 2022 14:17:17 +0200
Subject: [PATCH] tests-hspec - custom finally and readme toc

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3471
GitOrigin-RevId: 4a1477b7e7f175bf7b4c81405747588980c43d7b
---
 server/tests-hspec/Harness/Test/Feature.hs | 32 +++++++++++++++++++++-
 server/tests-hspec/README.md               | 20 ++++++++++++++
 2 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/server/tests-hspec/Harness/Test/Feature.hs b/server/tests-hspec/Harness/Test/Feature.hs
index 60c5fd1f3d6..1c7726895b6 100644
--- a/server/tests-hspec/Harness/Test/Feature.hs
+++ b/server/tests-hspec/Harness/Test/Feature.hs
@@ -41,7 +41,7 @@ feature Feature {backends, tests} =
           name
           ( aroundAllWith
               ( \actionWith state -> do
-                  finally
+                  finallyRethrow
                     ( do
                         setup state
                         actionWith state
@@ -51,3 +51,33 @@ feature Feature {backends, tests} =
               tests
           )
     )
+
+-- | A custom 'finally' which re-throws exceptions from both the main action and the sequel action.
+--
+--   The standard 'finally' only re-throws the @sequel@ exception.
+finallyRethrow :: IO a -> IO b -> IO a
+finallyRethrow a sequel =
+  mask $ \restore -> do
+    r <-
+      catch
+        (restore a)
+        ( \restoreEx -> do
+            _ <- sequel `catch` (throwIO . Exceptions restoreEx)
+            (throwIO restoreEx)
+        )
+    _ <- sequel
+    pure r
+
+-- | Two exceptions
+data Exceptions
+  = Exceptions SomeException SomeException
+
+instance Show Exceptions where
+  show (Exceptions e1 e2) =
+    unlines
+      [ "1. " <> show e1,
+        "",
+        "2. " <> show e2
+      ]
+
+instance Exception Exceptions
diff --git a/server/tests-hspec/README.md b/server/tests-hspec/README.md
index 76305e29bf5..9e3e8c51fa1 100644
--- a/server/tests-hspec/README.md
+++ b/server/tests-hspec/README.md
@@ -4,6 +4,19 @@ Graphql-engine integration tests written in Haskell using the [hspec](https://hs
 
 For motivation, rationale, and more, see the [test suite rfc](../../rfcs/hspec-test-suite.md).
 
+**Table of Contents**
+
+- [Running the test suite](#running-the-test-suite)
+- [Test suite structure](#test-suite-structure)
+    - [Harness](#harness)
+    - [Test](#test)
+- [Adding a new test](#adding-a-new-test)
+    - [Specifying backends](#specifying-backends)
+        - [Setup action](#setup-action)
+        - [Teardown action](#teardown-action)
+    - [Writing tests](#writing-tests)
+    - [Style guide](#style-guide)
+
 ## Running the test suite
 
 1. To run the Haskell integration test suite, we'll first need to start the backends:
@@ -55,6 +68,13 @@ For motivation, rationale, and more, see the [test suite rfc](../../rfcs/hspec-t
    cabal run tests-hspec -- --help
    ```
 
+3. The local databases presist even after shutting down docker-compose.
+   If this is undesirable, delete the databases using the following command:
+
+   ```sh
+   docker-compose down --volumes
+   ```
+
 ## Test suite structure
 
 ### Harness