haskell-persistent：如何在一秒内将外键用作主键table

Question

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

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

Post
  topic String

  deriving Show Eq

PostContent
  Id PostId
  content String

  deriving Show Eq

所以问题仍然存在：

我能以某种方式持久地表达主键是外键吗？ - 从 SQL 的角度来看这是有道理的（至少我是这么认为的）？

原创

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

我正在使用现有的 sql 脚本来生成数据库（在现实世界中，我拥有的数据库 table 不在我手中）- 我有以下数据库布局

table 发布信息

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

table 发布内容

| POSTID NUMBER | CONTENT CLOB |

table 评论后

| POSTID NUMBER | VIEWS INT |

当然我想表达POSTID在postcontent和postview中的外键和唯一键在相应的haskell持久[=25=中的关系].按照维基的 yesod-book, the wiki and the test cases 链接。

我创建了如下模板haskell拼接：

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"))

在上面的例子中可以看到tablepost_content中的pid列既是主键又是外键

haskell-persistent：如何在一秒内将外键用作主键table

haskell-persistent: how to use a foreign key as primary key in a second table

sql

haskell

persistent

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

原创

table 发布信息

table 发布内容

table 评论后

minimal.hs

`minimal.hs`