123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152 |
- {-# LANGUAGE EmptyDataDecls #-}
- {-# LANGUAGE ExistentialQuantification #-}
- {-# LANGUAGE FlexibleInstances #-}
- {-# LANGUAGE MultiParamTypeClasses #-}
- {-# LANGUAGE QuasiQuotes #-}
- {-# LANGUAGE TemplateHaskell #-}
- {-# LANGUAGE TypeFamilies #-}
- {-# LANGUAGE UndecidableInstances #-}
- {-# OPTIONS_GHC -Wno-unused-top-binds #-}
- import qualified Data.ByteString as BS
- import Data.IntMap (IntMap)
- import qualified Data.Text as T
- import Data.Time
- import Database.MongoDB (runCommand1)
- import Text.Blaze.Html
- import Test.QuickCheck
- import MongoInit
- import qualified EmbedTestMongo
- import qualified CustomPersistFieldTest
- import qualified DataTypeTest
- import qualified EmbedOrderTest
- import qualified EmptyEntityTest
- import qualified HtmlTest
- import qualified LargeNumberTest
- import qualified MaxLenTest
- import qualified MigrationOnlyTest
- import qualified PersistentTest
- import qualified Recursive
- import qualified RenameTest
- import qualified SumTypeTest
- import qualified UpsertTest
- type Tuple = (,)
- dbNoCleanup :: Action IO () -> Assertion
- dbNoCleanup = db' (pure ())
- share [mkPersist persistSettings, mkMigrate "htmlMigrate"] [persistLowerCase|
- HtmlTable
- html Html
- deriving
- |]
- mkPersist persistSettings [persistUpperCase|
- DataTypeTable no-json
- text Text
- textMaxLen Text maxlen=100
- bytes ByteString
- bytesTextTuple (Tuple ByteString Text)
- bytesMaxLen ByteString maxlen=100
- int Int
- intList [Int]
- intMap (IntMap Int)
- double Double
- bool Bool
- day Day
- utc UTCTime
- |]
- instance Arbitrary DataTypeTable where
- arbitrary = DataTypeTable
- <$> arbText
- <*> (T.take 100 <$> arbText)
- <*> arbitrary
- <*> liftA2 (,) arbitrary arbText
- <*> (BS.take 100 <$> arbitrary)
- <*> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> (truncateUTCTime =<< arbitrary)
- mkPersist persistSettings [persistUpperCase|
- EmptyEntity
- |]
- main :: IO ()
- main = do
- hspec $ afterAll dropDatabase $ do
- xdescribe "This test is failing for Mongo by only embedding the first thing." $ do
- RenameTest.specsWith (db' RenameTest.cleanDB)
- DataTypeTest.specsWith
- dbNoCleanup
- Nothing
- [ TestFn "Text" dataTypeTableText
- , TestFn "Text" dataTypeTableTextMaxLen
- , TestFn "Bytes" dataTypeTableBytes
- , TestFn "Bytes" dataTypeTableBytesTextTuple
- , TestFn "Bytes" dataTypeTableBytesMaxLen
- , TestFn "Int" dataTypeTableInt
- , TestFn "Int" dataTypeTableIntList
- , TestFn "Int" dataTypeTableIntMap
- , TestFn "Double" dataTypeTableDouble
- , TestFn "Bool" dataTypeTableBool
- , TestFn "Day" dataTypeTableDay
- ]
- []
- dataTypeTableDouble
- HtmlTest.specsWith (db' HtmlTest.cleanDB) Nothing
- EmbedTestMongo.specs
- EmbedOrderTest.specsWith (db' EmbedOrderTest.cleanDB)
- LargeNumberTest.specsWith
- (db' (deleteWhere ([] :: [Filter (LargeNumberTest.NumberGeneric backend)])))
- MaxLenTest.specsWith dbNoCleanup
- Recursive.specsWith (db' Recursive.cleanup)
- SumTypeTest.specsWith (dbNoCleanup) Nothing
- MigrationOnlyTest.specsWith
- dbNoCleanup
- Nothing
- PersistentTest.specsWith (db' PersistentTest.cleanDB)
-
-
- xdescribe "UpsertTest is currently failing for Mongo due to differing behavior" $ do
- UpsertTest.specsWith
- (db' PersistentTest.cleanDB)
- UpsertTest.AssumeNullIsZero
- UpsertTest.UpsertGenerateNewKey
- EmptyEntityTest.specsWith
- (db' EmptyEntityTest.cleanDB)
- Nothing
- CustomPersistFieldTest.specsWith
- dbNoCleanup
-
-
- where
- dropDatabase () = dbNoCleanup (void (runCommand1 $ T.pack "dropDatabase()"))
|