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
|
{-# LANGUAGE TypeApplications, DeriveGeneric #-}
{-# LANGUAGE DataKinds, ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
module Database.Persist.TH.SharedPrimaryKeyImportedSpec where
import TemplateTestImports
import Data.Proxy
import Test.Hspec
import Database.Persist
import Database.Persist.Sql
import Database.Persist.Sql.Util
import Database.Persist.TH
import Language.Haskell.TH
import Control.Monad.IO.Class
import Database.Persist.TH.SharedPrimaryKeySpec (User, UserId)
mkPersistWith sqlSettings $(discoverEntities) [persistLowerCase|
ProfileX
Id UserId
email String
|]
-- This test is very similar to the one in SharedPrimaryKeyTest, but it is
-- able to use 'UserId' directly, since the type is imported from another
-- module.
spec :: Spec
spec = describe "Shared Primary Keys Imported" $ do
describe "PersistFieldSql" $ do
it "should match underlying key" $ do
sqlType (Proxy @UserId)
`shouldBe`
sqlType (Proxy @ProfileXId)
describe "getEntityId FieldDef" $ do
it "should match underlying primary key" $ do
let
getSqlType :: PersistEntity a => Proxy a -> SqlType
getSqlType p =
case getEntityId (entityDef p) of
EntityIdField fd ->
fieldSqlType fd
_ ->
SqlOther "Composite Key"
getSqlType (Proxy @User)
`shouldBe`
getSqlType (Proxy @ProfileX)
describe "foreign reference should work" $ do
it "should have a foreign reference" $ do
pendingWith "issue #1289"
let
Just fd =
getEntityIdField (entityDef (Proxy @ProfileX))
fieldReference fd
`shouldBe`
ForeignRef (EntityNameHS "User")
|
