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

Question

UPDATE - found the root cause for the error - but don't know how to solve it

I just found out that the root of this behaviour is not caused by using sql=… but rather that I use the primary key of the first table as a foreign and primary key.

Post
  topic String

  deriving Show Eq

PostContent
  Id PostId
  content String

  deriving Show Eq

So the question remains:

Can I express in persistent somehow that a primary key is a foreign key? - as from an SQL perspective this makes sense (at least I think so)?

ORIGINAL

I am doing a port of the haxl example by simon marlow Fun With HAXL pt1 to oracle/docker - for a proof of concept.

I am using the existing sql scripts to generate the db (as in the real world case that I have the db tables are not in my hand) - I have the following db layout

table postinfo

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

table postcontent

| POSTID NUMBER | CONTENT CLOB |

table postviews

| POSTID NUMBER | VIEWS INT |

Of course I want to express the relation that POSTID is a foreign & unique key in postcontent and postview in the corresponding haskell persistent QuasiQuoter. Following the yesod-book, the wiki and the test cases linked from the wiki.

I created the following template 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
|]

which compiles with an error

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
|]

One thing to note the following test case quasi-quoter - works,

  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

Here is a minimal example reproducing both the error and some working versions just run (and change the #define line accordingly

> 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?

Yes. A sample code example assuming Sqlite as the database:

#!/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

On executing, you get this:

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

You can see in the above example that the pid column in the table post_content is both the primary key and the foreign key.