module Database.PostgreSQL.PQTypes.SQL.Raw (
    RawSQL
  , rawSQL
  , unRawSQL
  ) where

import Data.String
import Foreign.Marshal.Alloc
import qualified Data.ByteString.Char8 as BS
import qualified Data.Semigroup as SG
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.ToRow
import Database.PostgreSQL.PQTypes.ToSQL

-- | Form of SQL query which is very close to libpqtypes specific
-- representation. Note that, in particular, 'RawSQL' () is isomorphic (modulo
-- bottom) to 'Text'.
data RawSQL row = RawSQL !T.Text !row
  deriving (RawSQL row -> RawSQL row -> Bool
forall row. Eq row => RawSQL row -> RawSQL row -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawSQL row -> RawSQL row -> Bool
$c/= :: forall row. Eq row => RawSQL row -> RawSQL row -> Bool
== :: RawSQL row -> RawSQL row -> Bool
$c== :: forall row. Eq row => RawSQL row -> RawSQL row -> Bool
Eq, RawSQL row -> RawSQL row -> Bool
RawSQL row -> RawSQL row -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {row}. Ord row => Eq (RawSQL row)
forall row. Ord row => RawSQL row -> RawSQL row -> Bool
forall row. Ord row => RawSQL row -> RawSQL row -> Ordering
forall row. Ord row => RawSQL row -> RawSQL row -> RawSQL row
min :: RawSQL row -> RawSQL row -> RawSQL row
$cmin :: forall row. Ord row => RawSQL row -> RawSQL row -> RawSQL row
max :: RawSQL row -> RawSQL row -> RawSQL row
$cmax :: forall row. Ord row => RawSQL row -> RawSQL row -> RawSQL row
>= :: RawSQL row -> RawSQL row -> Bool
$c>= :: forall row. Ord row => RawSQL row -> RawSQL row -> Bool
> :: RawSQL row -> RawSQL row -> Bool
$c> :: forall row. Ord row => RawSQL row -> RawSQL row -> Bool
<= :: RawSQL row -> RawSQL row -> Bool
$c<= :: forall row. Ord row => RawSQL row -> RawSQL row -> Bool
< :: RawSQL row -> RawSQL row -> Bool
$c< :: forall row. Ord row => RawSQL row -> RawSQL row -> Bool
compare :: RawSQL row -> RawSQL row -> Ordering
$ccompare :: forall row. Ord row => RawSQL row -> RawSQL row -> Ordering
Ord, Int -> RawSQL row -> ShowS
forall row. Show row => Int -> RawSQL row -> ShowS
forall row. Show row => [RawSQL row] -> ShowS
forall row. Show row => RawSQL row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawSQL row] -> ShowS
$cshowList :: forall row. Show row => [RawSQL row] -> ShowS
show :: RawSQL row -> String
$cshow :: forall row. Show row => RawSQL row -> String
showsPrec :: Int -> RawSQL row -> ShowS
$cshowsPrec :: forall row. Show row => Int -> RawSQL row -> ShowS
Show)

instance (Show row, ToRow row) => IsSQL (RawSQL row) where
  withSQL :: forall r.
RawSQL row
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (RawSQL Text
query row
row) pa :: ParamAllocator
pa@(ParamAllocator forall r. (Ptr PGparam -> IO r) -> IO r
allocParam) Ptr PGparam -> CString -> IO r
execute =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall r. (Ptr PGparam -> IO r) -> IO r
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param -> do
      forall row.
ToRow row =>
row -> ParamAllocator -> Ptr PGparam -> Ptr PGerror -> IO ()
toRow row
row ParamAllocator
pa Ptr PGparam
param Ptr PGerror
err
      forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
T.encodeUtf8 Text
query) (Ptr PGparam -> CString -> IO r
execute Ptr PGparam
param)

-- | Construct 'RawSQL' () from 'String'.
instance IsString (RawSQL ()) where
  fromString :: String -> RawSQL ()
fromString = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall row. Text -> row -> RawSQL row
RawSQL () forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance SG.Semigroup (RawSQL ()) where
  RawSQL Text
a () <> :: RawSQL () -> RawSQL () -> RawSQL ()
<> RawSQL Text
b () = forall row. Text -> row -> RawSQL row
RawSQL (Text
a forall a. Semigroup a => a -> a -> a
SG.<> Text
b) ()
  sconcat :: NonEmpty (RawSQL ()) -> RawSQL ()
sconcat NonEmpty (RawSQL ())
xs = forall row. Text -> row -> RawSQL row
RawSQL (forall a. Semigroup a => NonEmpty a -> a
SG.sconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(RawSQL Text
s ()) -> Text
s) NonEmpty (RawSQL ())
xs) ()

instance Monoid (RawSQL ()) where
  mempty :: RawSQL ()
mempty = forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL Text
T.empty ()
  mappend :: RawSQL () -> RawSQL () -> RawSQL ()
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
  mconcat :: [RawSQL ()] -> RawSQL ()
mconcat [RawSQL ()]
xs = forall row. Text -> row -> RawSQL row
RawSQL (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(RawSQL Text
s ()) -> Text
s) [RawSQL ()]
xs) ()

-- | Construct 'RawSQL' from 'Text' and a tuple of parameters.
rawSQL :: (Show row, ToRow row) => T.Text -> row -> RawSQL row
rawSQL :: forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL = forall row. Text -> row -> RawSQL row
RawSQL

-- | Take query string out of 'RawSQL' ().
unRawSQL :: RawSQL () -> T.Text
unRawSQL :: RawSQL () -> Text
unRawSQL (RawSQL Text
s ()
_) = Text
s