main.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

import SqliteInit

import qualified CompositeTest
import qualified CustomPersistFieldTest
import qualified CustomPrimaryKeyReferenceTest
import qualified DataTypeTest
import qualified EmbedOrderTest
import qualified EmbedTest
import qualified EmptyEntityTest
import qualified EquivalentTypeTest
import qualified ForeignKey
import qualified GeneratedColumnTestSQL
import qualified HtmlTest
import qualified LargeNumberTest
import qualified LongIdentifierTest
import qualified MaxLenTest
import qualified MaybeFieldDefsTest
import qualified MigrationColumnLengthTest
import qualified MigrationOnlyTest
import qualified MpsCustomPrefixTest
import qualified MpsNoPrefixTest
import qualified PersistUniqueTest
import qualified PersistentTest
import qualified PrimaryTest
import qualified RawSqlTest
import qualified ReadWriteTest
import qualified Recursive
import qualified RenameTest
import qualified SchemaTest
import qualified SumTypeTest
import qualified TransactionLevelTest
import qualified TypeLitFieldDefsTest
import qualified UniqueTest
import qualified UpsertTest

import Control.Exception (IOException, handle, throwIO)
import Control.Monad.Catch (catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString as BS
import Data.Conduit (runConduit, (.|))
import qualified Data.Conduit.List as CL
import Data.Fixed
import Data.IntMap (IntMap)
import qualified Data.Text as T
import Data.Time
import Filesystem (removeFile)
import Filesystem.Path.CurrentOS (fromText)
import qualified Lens.Micro as Lens
import System.IO (hClose)
import System.IO.Temp (withSystemTempFile)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)

import Database.Persist.Sqlite
import qualified Database.Sqlite as Sqlite
import PersistentTestModels

import qualified Database.Persist.Sqlite.CompositeSpec as CompositeSpec
import qualified MigrationTest

type Tuple = (,)

-- Test lower case names
share [mkPersist persistSettings, mkMigrate "dataTypeMigrate"] [persistLowerCase|
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
    pico Pico
    time TimeOfDay
    utc UTCTime
|]

share [mkPersist sqlSettings, mkMigrate "idSetup"] [persistLowerCase|
Simple
    text Text
    deriving Show Eq

SimpleReference
    simpleCompositeId SimpleId
    text Text
    deriving Show Eq
|]

share [mkPersist sqlSettings, mkMigrate "idMigrateTest"] [persistLowerCase|
Simple2 sql=simple
    text Text
    int Int default=0
    deriving Show Eq

SimpleReference2 sql=simple_reference
    simpleCompositeId Simple2Id
    text Text
    deriving Show Eq
|]

instance Arbitrary DataTypeTable where
  arbitrary = DataTypeTable
     <$> arbText                -- text
     <*> (T.take 100 <$> arbText)          -- textManLen
     <*> arbitrary              -- bytes
     <*> liftA2 (,) arbitrary arbText      -- bytesTextTuple
     <*> (BS.take 100 <$> arbitrary)       -- bytesMaxLen
     <*> arbitrary              -- int
     <*> arbitrary              -- intList
     <*> arbitrary              -- intMap
     <*> arbitrary              -- double
     <*> arbitrary              -- bool
     <*> arbitrary              -- day
     <*> arbitrary              -- pico
     <*> (truncateTimeOfDay =<< arbitrary) -- time
     <*> (truncateUTCTime   =<< arbitrary) -- utc

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Test
  time UTCTime
|]

setup :: MonadIO m => Migration -> ReaderT SqlBackend m ()
setup migration = do
  printMigration migration
  runMigrationUnsafe migration

main :: IO ()
main = do
    handle (\(_ :: IOException) -> return ())
        $ removeFile $ fromText sqlite_database_file

    runConn $ do
        mapM_ setup
            [ ForeignKey.compositeMigrate
            , PersistentTest.testMigrate
            , PersistentTest.noPrefixMigrate
            , PersistentTest.customPrefixMigrate
            , EmbedTest.embedMigrate
            , EmbedOrderTest.embedOrderMigrate
            , LargeNumberTest.numberMigrate
            , UniqueTest.uniqueMigrate
            , MaxLenTest.maxlenMigrate
            , MaybeFieldDefsTest.maybeFieldDefMigrate
            , TypeLitFieldDefsTest.typeLitFieldDefsMigrate
            , Recursive.recursiveMigrate
            , CompositeTest.compositeMigrate
            , MigrationTest.migrationMigrate
            , PersistUniqueTest.migration
            , RenameTest.migration
            , CustomPersistFieldTest.customFieldMigrate
            , PrimaryTest.migration
            , CustomPrimaryKeyReferenceTest.migration
            , MigrationColumnLengthTest.migration
            , TransactionLevelTest.migration
            , LongIdentifierTest.migration
            , SchemaTest.migration
            ]
        PersistentTest.cleanDB
        ForeignKey.cleanDB


    hspec $ do
        describe "Database" $ describe "Persist" $ describe "Sqlite" $ do
            CompositeSpec.spec
        RenameTest.specsWith db
        DataTypeTest.specsWith
            db
            (Just (runMigrationSilent dataTypeMigrate))
            [ TestFn "text" dataTypeTableText
            , TestFn "textMaxLen" dataTypeTableTextMaxLen
            , TestFn "bytes" dataTypeTableBytes
            , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
            , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
            , TestFn "int" dataTypeTableInt
            , TestFn "intList" dataTypeTableIntList
            , TestFn "intMap" dataTypeTableIntMap
            , TestFn "bool" dataTypeTableBool
            , TestFn "day" dataTypeTableDay
            , TestFn "time" (DataTypeTest.roundTime . dataTypeTableTime)
            , TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)
            ]
            [ ("pico", dataTypeTablePico) ]
            dataTypeTableDouble
        HtmlTest.specsWith
            db
            (Just (runMigrationSilent HtmlTest.htmlMigrate))
        EmbedTest.specsWith db
        EmbedOrderTest.specsWith db
        LargeNumberTest.specsWith db
        UniqueTest.specsWith db
        MaxLenTest.specsWith db
        MaybeFieldDefsTest.specsWith db
        TypeLitFieldDefsTest.specsWith db
        Recursive.specsWith db
        SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
        MigrationOnlyTest.specsWith db
            (Just
                $ runMigrationSilent MigrationOnlyTest.migrateAll1
                >> runMigrationSilent MigrationOnlyTest.migrateAll2
            )
        PersistentTest.specsWith db
        PersistentTest.filterOrSpecs db
        ReadWriteTest.specsWith db
        RawSqlTest.specsWith db
        UpsertTest.specsWith
            db
            UpsertTest.Don'tUpdateNull
            UpsertTest.UpsertPreserveOldKey

        MpsNoPrefixTest.specsWith db
        MpsCustomPrefixTest.specsWith db
        EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))
        CompositeTest.specsWith db
        PersistUniqueTest.specsWith db
        PrimaryTest.specsWith db
        CustomPersistFieldTest.specsWith db
        CustomPrimaryKeyReferenceTest.specsWith db
        MigrationColumnLengthTest.specsWith db
        EquivalentTypeTest.specsWith db
        ForeignKey.specsWith db
        TransactionLevelTest.specsWith db
        MigrationTest.specsWith db
        LongIdentifierTest.specsWith db
        GeneratedColumnTestSQL.specsWith db
        SchemaTest.specsWith db

        it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
            void $ runMigrationSilent migrateAll
            insert_ . Test $ read "2014-11-30 05:15:25.123Z"
            [Single x] <- rawSql "select strftime('%s%f',time) from test" []
            liftIO $ x `shouldBe` Just ("141732452525.123" :: String)
        it "issue #339" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
            void $ runMigrationSilent migrateAll
            now <- liftIO getCurrentTime
            tid <- insert $ Test now
            Just (Test now') <- get tid
            liftIO $ now' `shouldBe` now
        it "issue #564" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do
            hClose h
            conn <- Sqlite.open (T.pack fp)
            Sqlite.close conn
            return ()
        it "issue #527" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
            void $ runMigrationSilent migrateAll
            insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123Z")

        it "afterException" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
            void $ runMigrationSilent testMigrate
            let catcher :: forall m. Monad m => SomeException -> m ()
                catcher _ = return ()
            insert_ $ Person "A" 0 Nothing
            insert_ (Person "A" 1 Nothing) `catch` catcher
            insert_ $ Person "B" 0 Nothing
            return ()