SqliteInit.hs 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. {-# LANGUAGE OverloadedStrings #-}
  2. module SqliteInit (
  3. (@/=), (@==), (==@)
  4. , asIO
  5. , assertNotEqual
  6. , assertNotEmpty
  7. , assertEmpty
  8. , isTravis
  9. , BackendMonad
  10. , runConn
  11. , MonadIO
  12. , persistSettings
  13. , MkPersistSettings (..)
  14. , db
  15. , sqlite_database
  16. , sqlite_database_file
  17. , BackendKey(..)
  18. , GenerateKey(..)
  19. , RunDb
  20. -- re-exports
  21. , module Database.Persist
  22. , module Test.Hspec
  23. , module Test.HUnit
  24. , liftIO
  25. , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
  26. , Int32, Int64
  27. , Text
  28. , module Control.Monad.Trans.Reader
  29. , module Control.Monad
  30. , module Database.Persist.Sql
  31. , BS.ByteString
  32. , SomeException
  33. , TestFn(..)
  34. , truncateTimeOfDay
  35. , truncateToMicro
  36. , truncateUTCTime
  37. , arbText
  38. , liftA2
  39. , MonadFail
  40. ) where
  41. import Init
  42. ( TestFn(..), truncateTimeOfDay, truncateUTCTime
  43. , truncateToMicro, arbText, liftA2, GenerateKey(..)
  44. , (@/=), (@==), (==@), MonadFail
  45. , assertNotEqual, assertNotEmpty, assertEmpty, asIO
  46. , isTravis, RunDb
  47. )
  48. -- re-exports
  49. import Control.Exception (SomeException)
  50. import Control.Monad (void, replicateM, liftM, when, forM_)
  51. import Control.Monad.Trans.Reader
  52. import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..))
  53. import Test.Hspec
  54. -- testing
  55. import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)
  56. import Control.Monad (unless, (>=>))
  57. import Control.Monad.IO.Unlift (MonadUnliftIO)
  58. import Control.Monad.Logger
  59. import Control.Monad.Trans.Resource (ResourceT, runResourceT)
  60. import qualified Data.ByteString as BS
  61. import Data.Text (Text)
  62. import System.Log.FastLogger (fromLogStr)
  63. import Database.Persist
  64. import Database.Persist.Sql
  65. import Database.Persist.Sqlite
  66. import Database.Persist.TH ()
  67. -- Data types
  68. import Control.Monad.IO.Class
  69. import Data.Int (Int32, Int64)
  70. _debugOn :: Bool
  71. _debugOn = False
  72. persistSettings :: MkPersistSettings
  73. persistSettings = sqlSettings { mpsGeneric = True }
  74. type BackendMonad = SqlBackend
  75. sqlite_database_file :: Text
  76. sqlite_database_file = "testdb.sqlite3"
  77. sqlite_database :: SqliteConnectionInfo
  78. sqlite_database = mkSqliteConnectionInfo sqlite_database_file
  79. runConn :: MonadUnliftIO m => SqlPersistT (LoggingT m) t -> m ()
  80. runConn f = do
  81. travis <- liftIO isTravis
  82. let debugPrint = not travis && _debugOn
  83. let printDebug = if debugPrint then print . fromLogStr else void . return
  84. flip runLoggingT (\_ _ _ s -> printDebug s) $ do
  85. _<-withSqlitePoolInfo sqlite_database 1 $ runSqlPool f
  86. return ()
  87. db :: SqlPersistT (LoggingT (ResourceT IO)) () -> Assertion
  88. db actions = do
  89. runResourceT $ runConn $ actions >> transactionUndo