sql - haskell-持久: how to use a foreign key as primary key in a second table

Question

更新 - 找到了错误的根本原因 - 但不知道如何解决

我刚刚发现这种行为的根源不是使用sql=…引起的，而是我使用第一个表的主键作为外部和 主键。

Post
  topic String

  deriving Show Eq

PostContent
  Id PostId
  content String

  deriving Show Eq

所以问题仍然是:

我可以以某种方式持久地表达主键是外键吗？ - 从 SQL 角度来看，这是有道理的(至少我认为是这样)？

原件

我正在移植 simon marlow 的 haxl 示例 Fun With HAXL pt1到 oracle/docker - 进行概念验证。

我正在使用现有的sql脚本来生成数据库(就像在现实世界中，我的数据库表不在我手中)-我有以下数据库布局

表帖子信息

| POSTID NUMBER | POSTDATE DATE | POSTTOPIC VARCHAR2(512 CHAR) |

表格帖子内容

| POSTID NUMBER | CONTENT CLOB |

表格帖子浏览量

| POSTID NUMBER | VIEWS INT |

当然，我想表达 POSTID 是相应 haskell 持久 postcontent 和 postview 中的外键和唯一键的关系QuasiQuoter。继yesod-book ，wiki和 test cases链接自 wiki。

我创建了以下模板 haskell splice:

share [ mkPersist sqlSettings {mpsGeneric = False} , mkMigrate "compositeMigrate" , mkDeleteCascade sqlSettings {mpsGeneric = False}] [persistUpperCase|

Post sql=POSTINFO
  Id Int sql=POSTID
  date UTCTime sql=POSTDATE
  topic Text sql=POSTTOPIC

  deriving Show Eq

PostContent sql=POSTCONTENT
  Id PostId sql=POSTID
  content Text sql=CONTENT
  deriving Show Eq

PostViews sql=POSTVIEWS
  Id PostId sql=POSTID
  views Int sql=VIEWS
  deriving Show Eq
|]

编译时出现错误

error:
    • Not in scope: type constructor or class ‘PostId’
    • In the quasi-quotation:
        [persistUpperCase|

Post sql=POSTINFO
  Id Int sql=POSTID
  date UTCTime sql=POSTDATE
  topic Text sql=POSTTOPIC

  deriving Show Eq

PostContent
  Id PostId sql=POSTID
  content Text sql=CONTENT
  deriving Show Eq

PostViews
  Id PostId sql=POSTID
  views Int sql=VIEWS
  deriving Show Eq
|]

需要注意以下测试用例准引用的一件事 - 有效，

  Citizen
    name String
    age Int Maybe
    deriving Eq Show
  Address
    address String
    country String
    deriving Eq Show
  CitizenAddress
    citizen CitizenId
    address AddressId
    Primary citizen address
    deriving Eq Show

这是一个重现错误和刚刚运行的一些工作版本的最小示例(并相应地更改 #define 行

> stack runhaskell --package persistent-template minimal.hs

minimal.hs

{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE CPP                        #-}

module Minimal where

import Database.Persist.TH

#define FAILS
main :: IO ()
main = putStrLn "It works"


#ifdef WORKS
share [ mkPersist sqlSettings {mpsGeneric = False} , mkMigrate "compositeMigrate" , mkDeleteCascade sqlSettings {mpsGeneric = False}] [persistUpperCase|

Post sql=POSTINFO
  Id Int sql=POSTID
  topic String sql=POSTTOPIC

  deriving Show Eq
|]
#endif

#ifdef ALSOWORKS
share [ mkPersist sqlSettings {mpsGeneric = False} , mkMigrate "compositeMigrate" , mkDeleteCascade sqlSettings {mpsGeneric = False}] [persistUpperCase|

Post sql=POSTINFO
  Id Int sql=POSTID
  topic String sql=POSTTOPIC

  deriving Show Eq


PostContent sql=POSTCONTENT
  post PostId sql=POSTID
  content String sql=POSTCONTENT

  deriving Show Eq
|]
#endif

#ifdef FAILS
share [ mkPersist sqlSettings {mpsGeneric = False} , mkMigrate "compositeMigrate" , mkDeleteCascade sqlSettings {mpsGeneric = False}] [persistUpperCase|

Post sql=POSTINFO
  Id Int sql=POSTID
  topic String sql=POSTTOPIC

  deriving Show Eq

PostContent sql=POSTCONTENT
  Id PostId sql=POSTID
  content String sql=POSTCONTENT

  deriving Show Eq
|]
#endif

-- UPDATE

#ifdef FAILSTOO
share [ mkPersist sqlSettings {mpsGeneric = False} , mkMigrate "compositeMigrate" , mkDeleteCascade sqlSettings {mpsGeneric = False}] [persistUpperCase|

Post
  topic String

  deriving Show Eq

PostContent
  Id PostId
  content String

  deriving Show Eq
|]
#endif

Answer 1

Can I express in persistent somehow that a primary key is a foreign key?

是的。假设 Sqlite 作为数据库的示例代码示例:

#!/usr/bin/env stack
{- stack
     --resolver lts-7.14
     --install-ghc
     runghc
     --package yesod
     --package yesod-core
     --package blaze-html
     --package text
     --package persistent
     --package persistent-template
     --package persistent-sqlite
     --package shakespeare
     --package aeson
-}

{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStderrLoggingT)
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
Post
    topic String
    deriving Show 
PostContent
    pid PostId
    Primary pid
    deriving Show
|]

main :: IO ()
main = mockMigration migrateAll

执行时，您会得到:

CREATE TABLE "post"("id" INTEGER PRIMARY KEY,"topic" VARCHAR NOT NULL)
CREATE TABLE "post_content"("pid" INTEGER NOT NULL REFERENCES "post", PRIMARY KEY ("pid"))

在上面的示例中可以看到，post_content 表中的 pid 列既是主键又是外键。