Skip to content

Instantly share code, notes, and snippets.

@lehmacdj
Created October 25, 2022 00:22
Show Gist options
  • Save lehmacdj/25415101cae41d65c9720e1101e6b8ea to your computer and use it in GitHub Desktop.
Save lehmacdj/25415101cae41d65c9720e1101e6b8ea to your computer and use it in GitHub Desktop.
Repro attempt using postgresql-libpq instead of squeal for https://github.com/morphismtech/squeal/discussions/334
#!/usr/bin/env stack
{- stack script
--resolver lts-19.30
--package postgresql-libpq
--package bytestring
-}
{-# LANGUAGE OverloadedStrings #-}
-- | To run, start a local postgresql database, potentially alter the
-- connection string as appropriate and then run the script
module Main where
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Control.Exception (Exception, throwIO)
import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
exec :: LibPQ.Connection -> ByteString -> IO ()
exec connection query = do
result <- LibPQ.exec connection query
maybe (error $ "query failed: " <> show query) resultOkOrThrow result
cleanupDb :: LibPQ.Connection -> IO ()
cleanupDb connection = do
exec connection "drop table if exists referencing_table;"
exec connection "drop table if exists referenced_table;"
setupDb :: LibPQ.Connection -> IO ()
setupDb connection = do
exec connection "create table referenced_table (id text not null primary key);"
exec connection "create table referencing_table (foreign_key text not null references referenced_table);"
exec connection "insert into referenced_table (id) values ('foo');"
data LibPQError = LibPQError LibPQ.Result ByteString ByteString
deriving (Show)
instance Exception LibPQError
resultOkOrThrow :: LibPQ.Result -> IO ()
resultOkOrThrow result = do
status <- LibPQ.resultStatus result
case status of
LibPQ.CommandOk -> pure ()
LibPQ.TuplesOk -> pure ()
_ -> do
statusCode <- fromMaybe (error "no status code") <$> LibPQ.resultErrorField result LibPQ.DiagSqlstate
errorMessage <- fromMaybe (error "no error message") <$> LibPQ.resultErrorMessage result
throwIO $ LibPQError result statusCode errorMessage
main :: IO ()
main = do
connection <- LibPQ.connectdb "dbname=postgres"
connectionStatus <- LibPQ.status connection
unless (connectionStatus == LibPQ.ConnectionOk) $ error $ "connection failed: " <> show connectionStatus
cleanupDb connection
setupDb connection
exec connection "begin;"
let temp = "temporary_statement"
prepareResult <- LibPQ.prepare connection temp "insert into referencing_table (foreign_key) values ($1::text);" Nothing
maybe (error "failed to prepare!") resultOkOrThrow prepareResult
queryResult <- LibPQ.execPrepared connection temp [Just ("bar", LibPQ.Binary)] LibPQ.Binary
maybe (error "didn't get result from query!") resultOkOrThrow queryResult
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment