Test.hs

{-# OPTIONS_GHC -fno-cse #-}

-- | Write tests that require a Postgres connection.
module Postgres.Test (test) where

import qualified Control.Concurrent.MVar as MVar
import qualified Environment
import qualified Expect
import qualified GHC.Stack as Stack
import qualified Platform
import qualified Postgres
import qualified Postgres.Connection as Connection
import qualified Postgres.Settings as Settings
import qualified System.IO.Unsafe
import qualified Test
import qualified Prelude

-- | A variant of `Test.test` that is passed a Postgres connection, for doing tests
-- that require access to Postgres. The test body is run within a transaction that
-- gets rolled back after the test completes.
--
-- Usage:
--
--     Postgres.Test.test "My Postgres test" <| \Postgres -> do
--        -- test stuff!
test ::
  Stack.HasCallStack =>
  Text ->
  (Postgres.Connection -> Expect.Expectation) ->
  Test.Test
test description body =
  Stack.withFrozenCallStack Test.test description <| \_ ->
    Expect.around
      ( \task' -> do
          conn <- getTestConnection
          Postgres.inTestTransaction conn task'
      )
      body

-- Obtain a Postgres connection for use in tests.
getTestConnection :: Task e Postgres.Connection
getTestConnection =
  -- The MVar exists to allow this function to be called by multiple tests
  -- running in parallel, and only the first test calling it will create a
  -- connection pool. The other tests will block until the pool is created, then
  -- share it.
  --
  -- This works because `MVar.modifyMVar` ensures the function we pass it is
  -- not called concurrently.
  MVar.modifyMVar
    testConnectionVar
    ( \maybeConn -> do
        conn <-
          case maybeConn of
            Just conn -> Prelude.pure conn
            Nothing -> do
              testSettings <- Environment.decode (Settings.decoderWithPrefix "TEST_")
              settings <-
                if Settings.pgConnection Settings.defaultSettings == Settings.pgConnection testSettings
                  then Environment.decode Settings.decoder
                  else Prelude.pure testSettings
              Connection.connectionIO settings
        Prelude.pure (Just conn, conn)
    )
    |> map Ok
    |> Platform.doAnything testDoAnything

-- | Create a 'global' variable containing the connection we want to use in
-- tests.
--
-- It's not truly global, only functions in this module can access it (because
-- we do not expose it). But it is a bit global in the sense that they'll be
-- able to access this variable without needing to be passed a reference to it
-- from outside.
--
-- The `NOINLINE` is instruction to Haskell not to try be efficient and inline
-- this function in where it's called. If Haskell did that it would result
-- in a new `MVar` being created every time we use `testConnectionVar`, instead
-- of a single `MVar` being shared between all these calls.
{-# NOINLINE testConnectionVar #-}
testConnectionVar :: MVar.MVar (Maybe Postgres.Connection)
testConnectionVar = System.IO.Unsafe.unsafePerformIO (MVar.newMVar Nothing)

-- | Creates a unpacked `DoAnythingHandler`, allowing us to use it without
-- to turn `IO` into `Task` types without needing to pass it in as an argument,
-- in the context of this test helper.
{-# NOINLINE testDoAnything #-}
testDoAnything :: Platform.DoAnythingHandler
testDoAnything = System.IO.Unsafe.unsafePerformIO Platform.doAnythingHandler