{-# 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 :: Text -> (Connection -> Expectation) -> Test
test Text
description Connection -> Expectation
body =
  (HasCallStack => Text -> (() -> Expectation) -> Test)
-> Text -> (() -> Expectation) -> Test
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Text -> (() -> Expectation) -> Test
Test.test Text
description ((() -> Expectation) -> Test) -> (() -> Expectation) -> Test
forall a b. (a -> b) -> a -> b
<| \()
_ ->
    (forall e a. (Connection -> Task e a) -> Task e a)
-> (Connection -> Expectation) -> Expectation
forall arg.
(forall e a. (arg -> Task e a) -> Task e a)
-> (arg -> Expectation) -> Expectation
Expect.around
      ( \Connection -> Task e a
task' -> do
          Connection
conn <- Task e Connection
forall e. Task e Connection
getTestConnection
          Connection -> (Connection -> Task e a) -> Task e a
forall x a. Connection -> (Connection -> Task x a) -> Task x a
Postgres.inTestTransaction Connection
conn Connection -> Task e a
task'
      )
      Connection -> Expectation
body

-- Obtain a Postgres connection for use in tests.
getTestConnection :: Task e Postgres.Connection
getTestConnection :: Task e 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 (Maybe Connection)
-> (Maybe Connection -> IO (Maybe Connection, Connection))
-> IO Connection
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MVar.modifyMVar
    MVar (Maybe Connection)
testConnectionVar
    ( \Maybe Connection
maybeConn -> do
        Connection
conn <-
          case Maybe Connection
maybeConn of
            Just Connection
conn -> Connection -> IO Connection
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Connection
conn
            Maybe Connection
Nothing -> do
              Settings
testSettings <- Decoder Settings -> IO Settings
forall a. Decoder a -> IO a
Environment.decode (Text -> Decoder Settings
Settings.decoderWithPrefix Text
"TEST_")
              Settings
settings <-
                if Settings -> ConnectionSettings
Settings.pgConnection Settings
Settings.defaultSettings ConnectionSettings -> ConnectionSettings -> Bool
forall a. Eq a => a -> a -> Bool
== Settings -> ConnectionSettings
Settings.pgConnection Settings
testSettings
                  then Decoder Settings -> IO Settings
forall a. Decoder a -> IO a
Environment.decode Decoder Settings
Settings.decoder
                  else Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Settings
testSettings
              Settings -> IO Connection
Connection.connectionIO Settings
settings
        (Maybe Connection, Connection) -> IO (Maybe Connection, Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
conn, Connection
conn)
    )
    IO Connection
-> (IO Connection -> IO (Result e Connection))
-> IO (Result e Connection)
forall a b. a -> (a -> b) -> b
|> (Connection -> Result e Connection)
-> IO Connection -> IO (Result e Connection)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Connection -> Result e Connection
forall error value. value -> Result error value
Ok
    IO (Result e Connection)
-> (IO (Result e Connection) -> Task e Connection)
-> Task e Connection
forall a b. a -> (a -> b) -> b
|> Handler -> IO (Result e Connection) -> Task e Connection
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
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 :: MVar (Maybe Connection)
testConnectionVar = IO (MVar (Maybe Connection)) -> MVar (Maybe Connection)
forall a. IO a -> a
System.IO.Unsafe.unsafePerformIO (Maybe Connection -> IO (MVar (Maybe Connection))
forall a. a -> IO (MVar a)
MVar.newMVar Maybe Connection
forall a. Maybe a
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 :: Handler
testDoAnything = IO Handler -> Handler
forall a. IO a -> a
System.IO.Unsafe.unsafePerformIO IO Handler
Platform.doAnythingHandler