<commit_before>module TestHarness
    (
      TestContext ( .. )
    -- * re-export for convenience
    , runReaderT
    )
    where

import Control.Monad.Trans.Reader
import qualified Network.Wai as Wai

import Databrary.Has
import Databrary.Model.Id
import Databrary.Model.Identity
import Databrary.Model.Party
import Databrary.Model.Permission
import Databrary.Service.DB
import Databrary.Service.Entropy
import Databrary.Service.Types


-- |
-- "God object" that can fulfill all needed "Has" instances. This is
-- intentionally quick to use for tests. The right way to use it is to keep all
-- fields undefined except those that the test in question is using: Since
-- runtime for tests is just as good as compile time for library, any bottoms
-- encountered will be a "good crash".
data TestContext = TestContext
    { ctxRequest :: Wai.Request
    -- ^ for MonadHasRequest
    , ctxSecret :: Secret
    , ctxEntropy :: Entropy
    -- ^ Both for MonadSign
    , ctxPartyId :: Id Party
    -- ^ for MonadAudit
    , ctxConn :: DBConn
    , ctxIdentity :: Identity
    }

instance Has Identity TestContext where
    view = ctxIdentity

instance Has DBConn TestContext where
    view = ctxConn

instance Has Wai.Request TestContext where
    view = ctxRequest

instance Has Secret TestContext where
    view = ctxSecret

instance Has Entropy TestContext where
    view = ctxEntropy

-- Needed for types, but unused so far

instance Has SiteAuth TestContext where
    view = undefined

instance Has Party TestContext where
    view = undefined

instance Has (Id Party) TestContext where
    view = ctxPartyId

instance Has Access TestContext where
    view = undefined<commit_msg>Move withinTestTransaction to test harness<commit_after>module TestHarness
    (
      TestContext ( .. )
    -- * re-export for convenience
    , runReaderT
    , Wai.defaultRequest
    )
    where

import Control.Exception (bracket)
import Control.Monad.Trans.Reader
import Database.PostgreSQL.Typed.Protocol
import qualified Network.Wai as Wai

import Databrary.Has
import Databrary.Model.Id
import Databrary.Model.Identity
import Databrary.Model.Party
import Databrary.Model.Permission
import Databrary.Service.DB
import Databrary.Service.Entropy
import Databrary.Service.Types


-- |
-- "God object" that can fulfill all needed "Has" instances. This is
-- intentionally quick to use for tests. The right way to use it is to keep all
-- fields undefined except those that the test in question is using: Since
-- runtime for tests is just as good as compile time for library, any bottoms
-- encountered will be a "good crash".
data TestContext = TestContext
    { ctxRequest :: Wai.Request
    -- ^ for MonadHasRequest
    , ctxSecret :: Secret
    , ctxEntropy :: Entropy
    -- ^ Both for MonadSign
    , ctxPartyId :: Id Party
    -- ^ for MonadAudit
    , ctxConn :: DBConn
    , ctxIdentity :: Identity
    }

instance Has Identity TestContext where
    view = ctxIdentity

instance Has DBConn TestContext where
    view = ctxConn

instance Has Wai.Request TestContext where
    view = ctxRequest

instance Has Secret TestContext where
    view = ctxSecret

instance Has Entropy TestContext where
    view = ctxEntropy

-- Needed for types, but unused so far

instance Has SiteAuth TestContext where
    view = undefined

instance Has Party TestContext where
    view = undefined

instance Has (Id Party) TestContext where
    view = ctxPartyId

instance Has Access TestContext where
    view = view . ctxIdentity

withinTestTransaction :: (PGConnection -> IO a) -> IO a
withinTestTransaction act =
     bracket
         (do
              cn <- pgConnect =<< loadPGDatabase
              pgBegin cn
              pure cn)
         (\cn -> pgRollback cn >> pgDisconnect cn)
         act
{'fraction_non_alphanumeric': 0.06253312135665076, 'fraction_numerical': 0.0, 'mean_word_length': 3.0988056460369164, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 8, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5961693', 'n_tokens_mistral': 1048, 'n_tokens_neox': 1015, 'n_words': 401}