{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Relational.PostgreSQL.Pure.Query
( runQuery'
) where
import qualified Data.ByteString.UTF8 as BSU
import Data.String (IsString (fromString))
import Data.Tuple.Homotuple (Homotuple, IsHomolisttuple, IsHomotupleItem)
import Data.Tuple.List (HasLength)
import Database.PostgreSQL.Placeholder.Convert (convertQuestionMarkStyleToDollarSignStyle)
import Database.PostgreSQL.Pure (ColumnInfo, Connection, FormatCode (BinaryFormat), FromRecord,
Length, Oid, ToRecord, bind, execute, parameters, parse,
records, sync)
import qualified Database.PostgreSQL.Pure as Pure
import Database.Relational (Query, untypeQuery)
import GHC.TypeLits (KnownNat)
runQuery' :: forall p r.
( ToRecord p
, FromRecord r
, KnownNat (Length p)
, KnownNat (Length r)
, HasLength (Homotuple (Length r) ColumnInfo)
, IsHomotupleItem (Length p) Oid
, IsHomotupleItem (Length r) Oid
, IsHomotupleItem (Length r) ColumnInfo
, IsHomolisttuple (Length p) Oid
, IsHomolisttuple (Length r) Oid
, IsHomolisttuple (Length r) ColumnInfo
)
=> Connection
-> Query p r
-> p
-> IO [r]
runQuery' conn q p =
case convertQuestionMarkStyleToDollarSignStyle $ fromString $ untypeQuery q of
Left err -> fail err
Right q' -> do
let psp = parse "" (Pure.Query q') Nothing
pp <- bind "" BinaryFormat BinaryFormat (parameters conn) (pure . BSU.fromString) p psp
let ep = execute 0 (pure . BSU.toString) pp
((_, _, e, _), _) <- sync conn ep
pure $ records e