1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module Database.Persist.Sqlite.CompositeSpec where
import SqliteInit
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.Conduit.List as CL
import Conduit
import Database.Persist.Sqlite
import System.IO (hClose)
import Control.Exception (handle, IOException, throwIO)
import System.IO.Temp (withSystemTempFile)
import qualified Data.Text as T
import qualified Lens.Micro as Lens
share [mkPersist sqlSettings, mkMigrate "compositeSetup"] [persistLowerCase|
SimpleComposite
int Int
text Text
Primary text int
deriving Show Eq
SimpleCompositeReference
int Int
text Text
label Text
Foreign SimpleComposite fk_simple_composite text int
deriving Show Eq
|]
share [mkPersist sqlSettings, mkMigrate "compositeMigrateTest"] [persistLowerCase|
SimpleComposite2 sql=simple_composite
int Int
text Text
new Int default=0
Primary text int
deriving Show Eq
SimpleCompositeReference2 sql=simple_composite_reference
int Int
text Text
label Text
Foreign SimpleComposite2 fk_simple_composite text int
deriving Show Eq
|]
spec :: Spec
spec = describe "CompositeSpec" $ do
it "properly migrates to a composite primary key (issue #669)" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
void $ runMigrationSilent compositeSetup
void $ runMigrationSilent compositeMigrateTest
pure ()
it "test migrating sparse composite primary keys (issue #1184)" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do
hClose h
let connInfo = Lens.set fkEnabled False $ mkSqliteConnectionInfo (T.pack fp)
runSqliteInfo connInfo $ do
void $ runMigrationSilent compositeSetup
forM_ [(1,"foo"),(3,"bar")] $ \(intKey, strKey) -> do
let key = SimpleCompositeKey strKey intKey
insertKey key (SimpleComposite intKey strKey)
insert (SimpleCompositeReference intKey strKey "test")
validateForeignKeys
runSqliteInfo connInfo $ do
void $ runMigrationSilent compositeMigrateTest
validateForeignKeys
validateForeignKeys
:: (MonadResource m, MonadReader env m, BackendCompatible SqlBackend env)
=> m ()
validateForeignKeys = do
violations <- map (T.pack . show) <$> runConduit (checkForeignKeys .| CL.consume)
unless (null violations) . liftIO . throwIO $
PersistForeignConstraintUnmet (T.unlines violations)
|
