{-# LINE 1 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
module Database.HDBC.PostgreSQL.Statement where

import Database.HDBC.Types
import Database.HDBC
import Database.HDBC.PostgreSQL.Types
import Database.HDBC.PostgreSQL.Utils
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Control.Concurrent.MVar
import Foreign.C.String
import Control.Monad
import Data.List
import Data.Word
import Data.Ratio
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8
import Database.HDBC.PostgreSQL.Parser(convertSQL)
import Database.HDBC.DriverUtils
import Database.HDBC.PostgreSQL.PTypeConv
import Data.Time.Format

{-# LINE 25 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

l :: Monad m => t -> m ()
l :: forall (m :: * -> *) t. Monad m => t -> m ()
l t
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
--l m = hPutStrLn stderr ("\n" ++ m)



data SState =
    SState { SState -> MVar (Maybe Stmt)
stomv :: MVar (Maybe Stmt),
             SState -> MVar CInt
nextrowmv :: MVar (CInt), -- -1 for no next row (empty); otherwise, next row to read.
             SState -> Conn
dbo :: Conn,
             SState -> String
squery :: String,
             SState -> MVar [(String, SqlColDesc)]
coldefmv :: MVar [(String, SqlColDesc)]}

-- FIXME: we currently do no prepare optimization whatsoever.

newSth :: Conn -> ChildList -> String -> IO Statement
newSth :: Conn -> ChildList -> String -> IO Statement
newSth Conn
indbo ChildList
mchildren String
query =
    do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"in newSth"
       newstomv <- Maybe Stmt -> IO (MVar (Maybe Stmt))
forall a. a -> IO (MVar a)
newMVar Maybe Stmt
forall a. Maybe a
Nothing
       newnextrowmv <- newMVar (-1)
       newcoldefmv <- newMVar []
       usequery <- case convertSQL query of
                      Left ParseError
errstr -> SqlError -> IO String
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO String) -> SqlError -> IO String
forall a b. (a -> b) -> a -> b
$ SqlError
                                      {seState :: String
seState = String
"",
                                       seNativeError :: Int
seNativeError = (-Int
1),
                                       seErrorMsg :: String
seErrorMsg = String
"hdbc prepare: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                    ParseError -> String
forall a. Show a => a -> String
show ParseError
errstr}
                      Right String
converted -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
converted
       let sstate = SState {stomv :: MVar (Maybe Stmt)
stomv = MVar (Maybe Stmt)
newstomv, nextrowmv :: MVar CInt
nextrowmv = MVar CInt
newnextrowmv,
                            dbo :: Conn
dbo = Conn
indbo, squery :: String
squery = String
usequery,
                            coldefmv :: MVar [(String, SqlColDesc)]
coldefmv = MVar [(String, SqlColDesc)]
newcoldefmv}
       let retval =
                Statement {execute :: [SqlValue] -> IO Integer
execute = SState -> [SqlValue] -> IO Integer
forall a. (Num a, Read a) => SState -> [SqlValue] -> IO a
fexecute SState
sstate,
                           executeMany :: [[SqlValue]] -> IO ()
executeMany = SState -> [[SqlValue]] -> IO ()
fexecutemany SState
sstate,
                           executeRaw :: IO ()
executeRaw = SState -> IO ()
fexecuteRaw SState
sstate,
                           finish :: IO ()
finish = SState -> IO ()
public_ffinish SState
sstate,
                           fetchRow :: IO (Maybe [SqlValue])
fetchRow = SState -> IO (Maybe [SqlValue])
ffetchrow SState
sstate,
                           originalQuery :: String
originalQuery = String
query,
                           getColumnNames :: IO [String]
getColumnNames = SState -> IO [String]
fgetColumnNames SState
sstate,
                           describeResult :: IO [(String, SqlColDesc)]
describeResult = SState -> IO [(String, SqlColDesc)]
fdescribeResult SState
sstate}
       addChild mchildren retval
       return retval

fgetColumnNames :: SState -> IO [(String)]
fgetColumnNames :: SState -> IO [String]
fgetColumnNames SState
sstate =
    do c <- MVar [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> IO a
readMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate)
       return (map fst c)

fdescribeResult :: SState -> IO [(String, SqlColDesc)]
fdescribeResult :: SState -> IO [(String, SqlColDesc)]
fdescribeResult SState
sstate =
    MVar [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> IO a
readMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate)

{- For now, we try to just  handle things as simply as possible.
FIXME lots of room for improvement here (types, etc). -}
fexecute :: (Num a, Read a) => SState -> [SqlValue] -> IO a
fexecute :: forall a. (Num a, Read a) => SState -> [SqlValue] -> IO a
fexecute SState
sstate [SqlValue]
args = Conn -> (Ptr CConn -> IO a) -> IO a
forall b. Conn -> (Ptr CConn -> IO b) -> IO b
withConnLocked (SState -> Conn
dbo SState
sstate) ((Ptr CConn -> IO a) -> IO a) -> (Ptr CConn -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CConn
cconn ->
                       ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (String -> ByteString
BUTF8.fromString (SState -> String
squery SState
sstate)) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
cquery ->
                       [SqlValue] -> (Ptr CString -> IO a) -> IO a
forall a. [SqlValue] -> (Ptr CString -> IO a) -> IO a
withCStringArr0 [SqlValue]
args ((Ptr CString -> IO a) -> IO a) -> (Ptr CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CString
cargs -> -- wichSTringArr0 uses UTF-8
    do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"in fexecute"
       SState -> IO ()
public_ffinish SState
sstate    -- Sets nextrowmv to -1
       resptr <- Ptr CConn
-> CString
-> CInt
-> Ptr Word32
-> Ptr CString
-> Ptr CInt
-> Ptr CInt
-> CInt
-> IO (Ptr CStmt)
pqexecParams Ptr CConn
cconn CString
cquery
                 ([SqlValue] -> CInt
forall i a. Num i => [a] -> i
genericLength [SqlValue]
args) Ptr Word32
forall a. Ptr a
nullPtr Ptr CString
cargs Ptr CInt
forall a. Ptr a
nullPtr Ptr CInt
forall a. Ptr a
nullPtr CInt
0
       handleResultStatus cconn resptr sstate =<< pqresultStatus resptr

{- | Differs from fexecute in that it does not prepare its input
   query, and the input query may contain multiple statements.  This
   is useful for issuing DDL or DML commands. -}
fexecuteRaw :: SState -> IO ()
fexecuteRaw :: SState -> IO ()
fexecuteRaw SState
sstate =
    Conn -> (Ptr CConn -> IO ()) -> IO ()
forall b. Conn -> (Ptr CConn -> IO b) -> IO b
withConnLocked (SState -> Conn
dbo SState
sstate) ((Ptr CConn -> IO ()) -> IO ()) -> (Ptr CConn -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CConn
cconn ->
        ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (String -> ByteString
BUTF8.fromString (SState -> String
squery SState
sstate)) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cquery ->
            do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"in fexecute"
               SState -> IO ()
public_ffinish SState
sstate    -- Sets nextrowmv to -1
               resptr <- Ptr CConn -> CString -> IO (Ptr CStmt)
pqexec Ptr CConn
cconn CString
cquery
               _ <- handleResultStatus cconn resptr sstate =<< pqresultStatus resptr :: IO Int
               return ()

handleResultStatus :: (Num a, Read a) => Ptr CConn -> Ptr CStmt -> SState -> ResultStatus -> IO a
handleResultStatus :: forall a.
(Num a, Read a) =>
Ptr CConn -> Ptr CStmt -> SState -> Word32 -> IO a
handleResultStatus Ptr CConn
cconn Ptr CStmt
resptr SState
sstate Word32
status =
    case Word32
status of
      Word32
0 ->
{-# LINE 107 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
          do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"PGRES_EMPTY_QUERY: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SState -> String
squery SState
sstate
             Ptr CStmt -> IO ()
pqclear_raw Ptr CStmt
resptr
             _ <- MVar [(String, SqlColDesc)]
-> [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate) []
             return 0
      Word32
1 ->
{-# LINE 112 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
          do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"PGRES_COMMAND_OK: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SState -> String
squery SState
sstate
             rowscs <- Ptr CStmt -> IO CString
pqcmdTuples Ptr CStmt
resptr
             rows <- peekCString rowscs
             pqclear_raw resptr
             _ <- swapMVar (coldefmv sstate) []
             return $ case rows of
                        String
"" -> a
0
                        String
x -> String -> a
forall a. Read a => String -> a
read String
x
      Word32
2 ->
{-# LINE 121 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
          do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"PGRES_TUPLES_OK: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SState -> String
squery SState
sstate
             _ <- Ptr CStmt -> IO [(String, SqlColDesc)]
fgetcoldef Ptr CStmt
resptr IO [(String, SqlColDesc)]
-> ([(String, SqlColDesc)] -> IO [(String, SqlColDesc)])
-> IO [(String, SqlColDesc)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar [(String, SqlColDesc)]
-> [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate)
             numrows <- pqntuples resptr
             if numrows < 1 then (pqclear_raw resptr >> return 0) else
                 do
                   fresptr <- newForeignPtr pqclearptr resptr
                   _ <- swapMVar (nextrowmv sstate) 0
                   _ <- swapMVar (stomv sstate) (Just fresptr)
                   return 0
      Word32
_ | Ptr CStmt
resptr Ptr CStmt -> Ptr CStmt -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CStmt
forall a. Ptr a
nullPtr -> do
              String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"PGRES ERROR: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SState -> String
squery SState
sstate
              errormsg  <- CString -> IO String
peekCStringUTF8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CConn -> IO CString
pqerrorMessage Ptr CConn
cconn
              statusmsg <- peekCStringUTF8 =<< pqresStatus status

              throwSqlError $ SqlError { seState = "E"
                                       , seNativeError = fromIntegral status
                                       , seErrorMsg = "execute: " ++ statusmsg ++
                                                      ": " ++ errormsg}

      Word32
_ -> do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"PGRES ERROR: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SState -> String
squery SState
sstate
              errormsg  <- CString -> IO String
peekCStringUTF8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CStmt -> IO CString
pqresultErrorMessage Ptr CStmt
resptr
              statusmsg <- peekCStringUTF8 =<< pqresStatus status
              state     <- peekCStringUTF8 =<<
                            pqresultErrorField resptr 67
{-# LINE 145 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

              pqclear_raw resptr
              throwSqlError $ SqlError { seState = state
                                       , seNativeError = fromIntegral status
                                       , seErrorMsg = "execute: " ++ statusmsg ++
                                                      ": " ++ errormsg}

peekCStringUTF8 :: CString -> IO String
-- Marshal a NUL terminated C string into a Haskell string, decoding it
-- with UTF8.
peekCStringUTF8 :: CString -> IO String
peekCStringUTF8 CString
str
   | CString
str CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr  = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
   | Bool
otherwise       = (ByteString -> String) -> IO ByteString -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
BUTF8.toString (CString -> IO ByteString
B.packCString CString
str)



{- General algorithm: find out how many columns we have, check the type
of each to see if it's NULL.  If it's not, fetch it as text and return that.
-}

ffetchrow :: SState -> IO (Maybe [SqlValue])
ffetchrow :: SState -> IO (Maybe [SqlValue])
ffetchrow SState
sstate = MVar CInt
-> (CInt -> IO (CInt, Maybe [SqlValue])) -> IO (Maybe [SqlValue])
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SState -> MVar CInt
nextrowmv SState
sstate) CInt -> IO (CInt, Maybe [SqlValue])
dofetchrow
    where dofetchrow :: CInt -> IO (CInt, Maybe [SqlValue])
dofetchrow (-1) = String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"ffr -1" IO () -> IO (CInt, Maybe [SqlValue]) -> IO (CInt, Maybe [SqlValue])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CInt, Maybe [SqlValue]) -> IO (CInt, Maybe [SqlValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((-CInt
1), Maybe [SqlValue]
forall a. Maybe a
Nothing)
          dofetchrow CInt
nextrow = MVar (Maybe Stmt)
-> (Maybe Stmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
-> IO (CInt, Maybe [SqlValue])
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SState -> MVar (Maybe Stmt)
stomv SState
sstate) ((Maybe Stmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
 -> IO (CInt, Maybe [SqlValue]))
-> (Maybe Stmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
-> IO (CInt, Maybe [SqlValue])
forall a b. (a -> b) -> a -> b
$ \Maybe Stmt
stmt ->
             case Maybe Stmt
stmt of
               Maybe Stmt
Nothing -> String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"ffr nos" IO ()
-> IO (Maybe Stmt, (CInt, Maybe [SqlValue]))
-> IO (Maybe Stmt, (CInt, Maybe [SqlValue]))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Stmt, (CInt, Maybe [SqlValue]))
-> IO (Maybe Stmt, (CInt, Maybe [SqlValue]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Stmt
stmt, ((-CInt
1), Maybe [SqlValue]
forall a. Maybe a
Nothing))
               Just Stmt
cmstmt -> Stmt
-> (Ptr CStmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
-> IO (Maybe Stmt, (CInt, Maybe [SqlValue]))
forall b. Stmt -> (Ptr CStmt -> IO b) -> IO b
withStmt Stmt
cmstmt ((Ptr CStmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
 -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
-> (Ptr CStmt -> IO (Maybe Stmt, (CInt, Maybe [SqlValue])))
-> IO (Maybe Stmt, (CInt, Maybe [SqlValue]))
forall a b. (a -> b) -> a -> b
$ \Ptr CStmt
cstmt ->
                 do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"ffetchrow: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
nextrow
                    numrows <- Ptr CStmt -> IO CInt
pqntuples Ptr CStmt
cstmt
                    l $ "numrows: " ++ show numrows
                    if nextrow >= numrows
                       then do l "no more rows"
                               -- Don't use public_ffinish here
                               ffinish cmstmt
                               return (Nothing, ((-1), Nothing))
                       else do l "getting stuff"
                               ncols <- pqnfields cstmt
                               res <- mapM (getCol cstmt nextrow)
                                      [0..(ncols - 1)]
                               return (stmt, (nextrow + 1, Just res))
          getCol :: Ptr CStmt -> CInt -> CInt -> IO SqlValue
getCol Ptr CStmt
p CInt
row CInt
icol =
             do isnull <- Ptr CStmt -> CInt -> CInt -> IO CInt
pqgetisnull Ptr CStmt
p CInt
row CInt
icol
                if isnull /= 0
                   then return SqlNull
                   else do text <- pqgetvalue p row icol
                           coltype <- liftM oidToColType $ pqftype p icol
                           s <- B.packCString text
                           makeSqlValue coltype s



fgetcoldef :: Ptr CStmt -> IO [(String, SqlColDesc)]
fgetcoldef :: Ptr CStmt -> IO [(String, SqlColDesc)]
fgetcoldef Ptr CStmt
cstmt =
    do ncols <- Ptr CStmt -> IO CInt
pqnfields Ptr CStmt
cstmt
       mapM desccol [0..(ncols - 1)]
    where desccol :: CInt -> IO (String, SqlColDesc)
desccol CInt
i =
              do colname <- CString -> IO String
peekCStringUTF8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CStmt -> CInt -> IO CString
pqfname Ptr CStmt
cstmt CInt
i 
                 coltype <- pqftype cstmt i
                 --coloctets <- pqfsize
                 let coldef = Word32 -> SqlColDesc
oidToColDef Word32
coltype
                 return (colname, coldef)

-- FIXME: needs a faster algorithm.
fexecutemany :: SState -> [[SqlValue]] -> IO ()
fexecutemany :: SState -> [[SqlValue]] -> IO ()
fexecutemany SState
sstate [[SqlValue]]
arglist =
    ([SqlValue] -> IO Int) -> [[SqlValue]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SState -> [SqlValue] -> IO Int
forall a. (Num a, Read a) => SState -> [SqlValue] -> IO a
fexecute SState
sstate :: [SqlValue] -> IO Int) [[SqlValue]]
arglist IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Finish and change state
public_ffinish :: SState -> IO ()
public_ffinish :: SState -> IO ()
public_ffinish SState
sstate =
    do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"public_ffinish"
       _ <- MVar CInt -> CInt -> IO CInt
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar CInt
nextrowmv SState
sstate) (-CInt
1)
       modifyMVar_ (stomv sstate) worker
    where worker :: Maybe Stmt -> IO (Maybe a)
worker Maybe Stmt
Nothing = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
          worker (Just Stmt
sth) = Stmt -> IO ()
ffinish Stmt
sth IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

ffinish :: Stmt -> IO ()
ffinish :: Stmt -> IO ()
ffinish Stmt
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

foreign import ccall unsafe "libpq-fe.h PQresultStatus"
  pqresultStatus :: (Ptr CStmt) -> IO Word32
{-# LINE 226 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

foreign import ccall safe "libpq-fe.h PQexecParams"
  pqexecParams :: (Ptr CConn) -> CString -> CInt ->
                  (Ptr Word32) ->
{-# LINE 230 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
                  (Ptr CString) ->
                  (Ptr CInt) ->
                  (Ptr CInt) ->
                  CInt ->
                  IO (Ptr CStmt)

foreign import ccall safe "libpq-fe.h PQexec"
  pqexec :: (Ptr CConn) -> CString -> IO (Ptr CStmt)

foreign import ccall unsafe "libpq-fe.h &PQclear"
  pqclearptr :: FunPtr (Ptr CStmt -> IO ())

foreign import ccall unsafe "libpq-fe.h PQclear"
  pqclear_raw :: Ptr CStmt -> IO ()

foreign import ccall unsafe "libpq-fe.h PQcmdTuples"
  pqcmdTuples :: Ptr CStmt -> IO CString
foreign import ccall unsafe "libpq-fe.h PQresStatus"
  pqresStatus :: Word32 -> IO CString
{-# LINE 249 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

foreign import ccall unsafe "libpq-fe.h PQresultErrorMessage"
  pqresultErrorMessage :: (Ptr CStmt) -> IO CString

foreign import ccall unsafe "libpq-fe.h PQresultErrorField"
  pqresultErrorField :: (Ptr CStmt) -> CInt -> IO CString

foreign import ccall unsafe "libpq-fe.h PQntuples"
  pqntuples :: Ptr CStmt -> IO CInt

foreign import ccall unsafe "libpq-fe.h PQnfields"
  pqnfields :: Ptr CStmt -> IO CInt

foreign import ccall unsafe "libpq-fe.h PQgetisnull"
  pqgetisnull :: Ptr CStmt -> CInt -> CInt -> IO CInt

foreign import ccall unsafe "libpq-fe.h PQgetvalue"
  pqgetvalue :: Ptr CStmt -> CInt -> CInt -> IO CString

foreign import ccall unsafe "libpq-fe.h PQfname"
  pqfname :: Ptr CStmt -> CInt -> IO CString

foreign import ccall unsafe "libpq-fe.h PQftype"
  pqftype :: Ptr CStmt -> CInt -> IO Word32
{-# LINE 273 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

-- SqlValue construction function and helpers

-- Make a SqlValue for the passed column type and string value, where it is assumed that the value represented is not the Sql null value.
-- The IO Monad is required only to obtain the local timezone for interpreting date/time values without an explicit timezone.
makeSqlValue :: SqlTypeId -> B.ByteString -> IO SqlValue
makeSqlValue :: SqlTypeId -> ByteString -> IO SqlValue
makeSqlValue SqlTypeId
sqltypeid ByteString
bstrval =
    let strval :: String
strval = ByteString -> String
BUTF8.toString ByteString
bstrval
    in
    case SqlTypeId
sqltypeid of

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlCharT        Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlVarCharT     Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlLongVarCharT Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlWCharT       Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlWVarCharT    Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlWLongVarCharT  -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
bstrval

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlDecimalT Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlNumericT   -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Rational -> SqlValue
SqlRational (String -> Rational
makeRationalFromDecimal String
strval)

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlSmallIntT Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlTinyIntT  Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlIntegerT     -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Int32 -> SqlValue
SqlInt32 (String -> Int32
forall a. Read a => String -> a
read String
strval)

      SqlTypeId
SqlBigIntT -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Integer -> SqlValue
SqlInteger (String -> Integer
forall a. Read a => String -> a
read String
strval)

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlRealT   Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlFloatT  Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlDoubleT   -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Double -> SqlValue
SqlDouble (String -> Double
forall a. Read a => String -> a
read String
strval)

      SqlTypeId
SqlBitT -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ case String
strval of
                   Char
't':String
_ -> Bool -> SqlValue
SqlBool Bool
True
                   Char
'f':String
_ -> Bool -> SqlValue
SqlBool Bool
False
                   Char
'T':String
_ -> Bool -> SqlValue
SqlBool Bool
True -- the rest of these are here "just in case", since they are legal as input
                   Char
'y':String
_ -> Bool -> SqlValue
SqlBool Bool
True
                   Char
'Y':String
_ -> Bool -> SqlValue
SqlBool Bool
True
                   String
"1"   -> Bool -> SqlValue
SqlBool Bool
True
                   String
_     -> Bool -> SqlValue
SqlBool Bool
False

      -- Dates and Date/Times
      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlDateT -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ Day -> SqlValue
SqlLocalDate (SqlValue -> Day
forall a. Convertible SqlValue a => SqlValue -> a
fromSql (String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql String
strval))
      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlTimestampWithZoneT -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ZonedTime -> SqlValue
SqlZonedTime (SqlValue -> ZonedTime
forall a. Convertible SqlValue a => SqlValue -> a
fromSql (String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql (String -> String
fixString String
strval)))

          -- SqlUTCDateTimeT not actually generated by PostgreSQL

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlTimestampT   Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlUTCDateTimeT   -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> SqlValue
SqlLocalTime (SqlValue -> LocalTime
forall a. Convertible SqlValue a => SqlValue -> a
fromSql (String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql String
strval))

      -- Times without dates
      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlTimeT    Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlUTCTimeT   -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> SqlValue
SqlLocalTimeOfDay (SqlValue -> TimeOfDay
forall a. Convertible SqlValue a => SqlValue -> a
fromSql (String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql String
strval))

      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlTimeWithZoneT ->
              (let (TimeOfDay
a, TimeZone
b) = case (TimeLocale -> String -> String -> Maybe TimeOfDay
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parseTime' TimeLocale
defaultTimeLocale String
"%T%Q %z" String
timestr,
                                  TimeLocale -> String -> String -> Maybe TimeZone
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parseTime' TimeLocale
defaultTimeLocale String
"%T%Q %z" String
timestr) of
                                (Just TimeOfDay
x, Just TimeZone
y) -> (TimeOfDay
x, TimeZone
y)
                                (Maybe TimeOfDay, Maybe TimeZone)
x -> String -> (TimeOfDay, TimeZone)
forall a. HasCallStack => String -> a
error (String -> (TimeOfDay, TimeZone))
-> String -> (TimeOfDay, TimeZone)
forall a b. (a -> b) -> a -> b
$ String
"PostgreSQL Statement.hsc: Couldn't parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as SqlZonedLocalTimeOfDay: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe TimeOfDay, Maybe TimeZone) -> String
forall a. Show a => a -> String
show (Maybe TimeOfDay, Maybe TimeZone)
x
                   timestr :: String
timestr = String -> String
fixString String
strval
               in SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> TimeZone -> SqlValue
SqlZonedLocalTimeOfDay TimeOfDay
a TimeZone
b)

      SqlIntervalT SqlInterval
_ -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> SqlValue
SqlDiffTime (NominalDiffTime -> SqlValue) -> NominalDiffTime -> SqlValue
forall a b. (a -> b) -> a -> b
$ Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$
                         case Char -> String -> [String]
split Char
':' String
strval of
                           [String
h, String
m, String
s] -> Integer -> Rational
forall a. Real a => a -> Rational
toRational (((String -> Integer
forall a. Read a => String -> a
read String
h)::Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
                                                    ((String -> Integer
forall a. Read a => String -> a
read String
m)::Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+
                                        Double -> Rational
forall a. Real a => a -> Rational
toRational ((String -> Double
forall a. Read a => String -> a
read String
s)::Double)
                           [String]
_ -> String -> Rational
forall a. HasCallStack => String -> a
error (String -> Rational) -> String -> Rational
forall a b. (a -> b) -> a -> b
$ String
"PostgreSQL Statement.hsc: Couldn't parse interval: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strval

      -- TODO: For now we just map the binary types to SqlByteStrings. New SqlValue constructors are needed to handle these.
      SqlTypeId
tid | SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlBinaryT        Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlVarBinaryT     Bool -> Bool -> Bool
||
            SqlTypeId
tid SqlTypeId -> SqlTypeId -> Bool
forall a. Eq a => a -> a -> Bool
== SqlTypeId
SqlLongVarBinaryT    -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
bstrval

      SqlTypeId
SqlGUIDT -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
bstrval

      SqlUnknownT String
_ -> SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlValue -> IO SqlValue) -> SqlValue -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ ByteString -> SqlValue
SqlByteString ByteString
bstrval
      SqlTypeId
_ -> String -> IO SqlValue
forall a. HasCallStack => String -> a
error (String -> IO SqlValue) -> String -> IO SqlValue
forall a b. (a -> b) -> a -> b
$ String
"PostgreSQL Statement.hsc: unknown typeid: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SqlTypeId -> String
forall a. Show a => a -> String
show SqlTypeId
sqltypeid

-- Convert "15:33:01.536+00" to "15:33:01.536 +0000"
fixString :: String -> String
fixString :: String -> String
fixString String
s =
    let (String
strbase, String
zone) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
s
    in
      if (String -> Char
forall a. HasCallStack => [a] -> a
head String
zone) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| (String -> Char
forall a. HasCallStack => [a] -> a
head String
zone) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
         then String
strbase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
zone String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"00"
         else -- It wasn't in the expected format; don't touch.
              String
s


-- Make a rational number from a decimal string representation of the number.
makeRationalFromDecimal :: String -> Rational
makeRationalFromDecimal :: String -> Rational
makeRationalFromDecimal String
s =
    case Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'.' String
s of
      Maybe Int
Nothing -> Integer -> Rational
forall a. Real a => a -> Rational
toRational ((String -> Integer
forall a. Read a => String -> a
read String
s)::Integer)
      Just Int
dotix ->
        let (String
nstr,Char
'.':String
dstr) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
dotix String
s
            num :: Integer
num = (String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
nstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dstr)::Integer
            den :: Integer
den = Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^((String -> Integer
forall i a. Num i => [a] -> i
genericLength String
dstr) :: Integer)
        in
          Integer
num Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
den

split :: Char -> String -> [String]
split :: Char -> String -> [String]
split Char
delim String
inp =
    String -> [String]
lines (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
delim then Char
'\n' else Char
x) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
inp

parseTime' :: ParseTime t => TimeLocale -> String -> String -> Maybe t

{-# LINE 380 "Database/HDBC/PostgreSQL/Statement.hsc" #-}
parseTime' = parseTimeM True

{-# LINE 384 "Database/HDBC/PostgreSQL/Statement.hsc" #-}