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
(RawSQL row -> RawSQL row -> Bool)
-> (RawSQL row -> RawSQL row -> Bool) -> Eq (RawSQL row)
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, Eq (RawSQL row)
Eq (RawSQL row)
-> (RawSQL row -> RawSQL row -> Ordering)
-> (RawSQL row -> RawSQL row -> Bool)
-> (RawSQL row -> RawSQL row -> Bool)
-> (RawSQL row -> RawSQL row -> Bool)
-> (RawSQL row -> RawSQL row -> Bool)
-> (RawSQL row -> RawSQL row -> RawSQL row)
-> (RawSQL row -> RawSQL row -> RawSQL row)
-> Ord (RawSQL row)
RawSQL row -> RawSQL row -> Bool
RawSQL row -> RawSQL row -> Ordering
RawSQL row -> RawSQL row -> RawSQL row
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
$cp1Ord :: forall row. Ord row => Eq (RawSQL row)
Ord, Int -> RawSQL row -> ShowS
[RawSQL row] -> ShowS
RawSQL row -> String
(Int -> RawSQL row -> ShowS)
-> (RawSQL row -> String)
-> ([RawSQL row] -> ShowS)
-> Show (RawSQL row)
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 :: 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 =
    (Ptr PGerror -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO r) -> IO r) -> (Ptr PGerror -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr PGparam -> IO r) -> IO r
forall r. (Ptr PGparam -> IO r) -> IO r
allocParam ((Ptr PGparam -> IO r) -> IO r) -> (Ptr PGparam -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param -> do
      row -> ParamAllocator -> Ptr PGparam -> Ptr PGerror -> IO ()
forall row.
ToRow row =>
row -> ParamAllocator -> Ptr PGparam -> Ptr PGerror -> IO ()
toRow row
row ParamAllocator
pa Ptr PGparam
param Ptr PGerror
err
      ByteString -> (CString -> IO r) -> IO r
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 = (Text -> () -> RawSQL ()) -> () -> Text -> RawSQL ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> () -> RawSQL ()
forall row. Text -> row -> RawSQL row
RawSQL () (Text -> RawSQL ()) -> (String -> Text) -> String -> 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 () = Text -> () -> RawSQL ()
forall row. Text -> row -> RawSQL row
RawSQL (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
SG.<> Text
b) ()
  sconcat :: NonEmpty (RawSQL ()) -> RawSQL ()
sconcat NonEmpty (RawSQL ())
xs = Text -> () -> RawSQL ()
forall row. Text -> row -> RawSQL row
RawSQL (NonEmpty Text -> Text
forall a. Semigroup a => NonEmpty a -> a
SG.sconcat (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ (RawSQL () -> Text) -> NonEmpty (RawSQL ()) -> NonEmpty Text
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 = Text -> () -> RawSQL ()
forall row. (Show row, ToRow row) => Text -> row -> RawSQL row
rawSQL Text
T.empty ()
  mappend :: RawSQL () -> RawSQL () -> RawSQL ()
mappend = RawSQL () -> RawSQL () -> RawSQL ()
forall a. Semigroup a => a -> a -> a
(SG.<>)
  mconcat :: [RawSQL ()] -> RawSQL ()
mconcat [RawSQL ()]
xs = Text -> () -> RawSQL ()
forall row. Text -> row -> RawSQL row
RawSQL ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RawSQL () -> Text) -> [RawSQL ()] -> [Text]
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 :: Text -> row -> RawSQL row
rawSQL = Text -> row -> RawSQL row
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