34047e1f5f
* rewriting tests * tests now run in 1.45 seconds * tests pass * fix json * fix tests * add helper for setting the database state * clean things up a bit
88 lines
2.3 KiB
Haskell
88 lines
2.3 KiB
Haskell
{-# LANGUAGE CPP, AllowAmbiguousTypes #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
{-# LANGUAGE EmptyDataDecls #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PartialTypeSignatures #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Common.Test.Import
|
|
( module Common.Test.Import
|
|
, module X
|
|
) where
|
|
|
|
import System.Environment
|
|
import Control.Applicative
|
|
import Common.Test.Models as X
|
|
import Database.Esqueleto.Experimental as X hiding (random_)
|
|
import Test.Hspec as X
|
|
import UnliftIO as X
|
|
import Control.Monad
|
|
import Test.QuickCheck
|
|
import Data.Text as X (Text)
|
|
import Control.Monad.Trans.Reader as X (ReaderT, mapReaderT, ask)
|
|
|
|
type SpecDb = SpecWith ConnectionPool
|
|
|
|
asserting :: MonadIO f => IO () -> SqlPersistT f ()
|
|
asserting a = liftIO a
|
|
|
|
noExceptions :: Expectation
|
|
noExceptions = pure ()
|
|
|
|
itDb
|
|
:: (HasCallStack)
|
|
=> String
|
|
-> SqlPersistT IO x
|
|
-> SpecDb
|
|
itDb message action = do
|
|
it message $ \connection -> do
|
|
void $ testDb connection action
|
|
|
|
propDb
|
|
:: (HasCallStack, Testable a)
|
|
=> String
|
|
-> ((SqlPersistT IO () -> IO ()) -> a )
|
|
-> SpecDb
|
|
propDb message action = do
|
|
it message $ \connection -> do
|
|
property (action (testDb connection))
|
|
|
|
testDb :: ConnectionPool -> SqlPersistT IO a -> IO a
|
|
testDb conn action =
|
|
liftIO $ flip runSqlPool conn $ do
|
|
a <- action
|
|
transactionUndo
|
|
pure a
|
|
|
|
setDatabaseState
|
|
:: SqlPersistT IO a
|
|
-> SqlPersistT IO ()
|
|
-> SpecWith ConnectionPool
|
|
-> SpecWith ConnectionPool
|
|
setDatabaseState create clean test =
|
|
beforeWith (\conn -> runSqlPool create conn >> pure conn) $
|
|
after (\conn -> runSqlPool clean conn) $
|
|
test
|
|
|
|
isCI :: IO Bool
|
|
isCI = do
|
|
env <- getEnvironment
|
|
return $ case lookup "TRAVIS" env <|> lookup "CI" env of
|
|
Just "true" -> True
|
|
_ -> False
|