{-# 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"
       MVar (Maybe Stmt)
newstomv <- Maybe Stmt -> IO (MVar (Maybe Stmt))
forall a. a -> IO (MVar a)
newMVar Maybe Stmt
forall a. Maybe a
Nothing
       MVar CInt
newnextrowmv <- CInt -> IO (MVar CInt)
forall a. a -> IO (MVar a)
newMVar (-CInt
1)
       MVar [(String, SqlColDesc)]
newcoldefmv <- [(String, SqlColDesc)] -> IO (MVar [(String, SqlColDesc)])
forall a. a -> IO (MVar a)
newMVar []
       String
usequery <- case String -> Either ParseError String
convertSQL String
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
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
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}
       ChildList -> Statement -> IO ()
addChild ChildList
mchildren Statement
retval
       Statement -> IO Statement
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
retval

fgetColumnNames :: SState -> IO [(String)]
fgetColumnNames :: SState -> IO [String]
fgetColumnNames SState
sstate =
    do [(String, SqlColDesc)]
c <- MVar [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> IO a
readMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate)
       [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (((String, SqlColDesc) -> String)
-> [(String, SqlColDesc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SqlColDesc) -> String
forall a b. (a, b) -> a
fst [(String, SqlColDesc)]
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
       Ptr CStmt
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
       Ptr CConn -> Ptr CStmt -> SState -> Word32 -> IO a
forall a.
(Num a, Read a) =>
Ptr CConn -> Ptr CStmt -> SState -> Word32 -> IO a
handleResultStatus Ptr CConn
cconn Ptr CStmt
resptr SState
sstate (Word32 -> IO a) -> IO Word32 -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CStmt -> IO Word32
pqresultStatus Ptr CStmt
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
               Ptr CStmt
resptr <- Ptr CConn -> CString -> IO (Ptr CStmt)
pqexec Ptr CConn
cconn CString
cquery
               Int
_ <- Ptr CConn -> Ptr CStmt -> SState -> Word32 -> IO Int
forall a.
(Num a, Read a) =>
Ptr CConn -> Ptr CStmt -> SState -> Word32 -> IO a
handleResultStatus Ptr CConn
cconn Ptr CStmt
resptr SState
sstate (Word32 -> IO Int) -> IO Word32 -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CStmt -> IO Word32
pqresultStatus Ptr CStmt
resptr :: IO Int
               () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
             [(String, SqlColDesc)]
_ <- MVar [(String, SqlColDesc)]
-> [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate) []
             a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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
             CString
rowscs <- Ptr CStmt -> IO CString
pqcmdTuples Ptr CStmt
resptr
             String
rows <- CString -> IO String
peekCString CString
rowscs
             Ptr CStmt -> IO ()
pqclear_raw Ptr CStmt
resptr
             [(String, SqlColDesc)]
_ <- MVar [(String, SqlColDesc)]
-> [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar [(String, SqlColDesc)]
coldefmv SState
sstate) []
             a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ case String
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
             [(String, SqlColDesc)]
_ <- 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)
             CInt
numrows <- Ptr CStmt -> IO CInt
pqntuples Ptr CStmt
resptr
             if CInt
numrows CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
1 then (Ptr CStmt -> IO ()
pqclear_raw Ptr CStmt
resptr IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
0) else
                 do
                   Stmt
fresptr <- FinalizerPtr CStmt -> Ptr CStmt -> IO Stmt
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CStmt
pqclearptr Ptr CStmt
resptr
                   CInt
_ <- MVar CInt -> CInt -> IO CInt
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar CInt
nextrowmv SState
sstate) CInt
0
                   Maybe Stmt
_ <- MVar (Maybe Stmt) -> Maybe Stmt -> IO (Maybe Stmt)
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar (Maybe Stmt)
stomv SState
sstate) (Stmt -> Maybe Stmt
forall a. a -> Maybe a
Just Stmt
fresptr)
                   a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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
              String
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
              String
statusmsg <- CString -> IO String
peekCStringUTF8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> IO CString
pqresStatus Word32
status

              SqlError -> IO a
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO a) -> SqlError -> IO a
forall a b. (a -> b) -> a -> b
$ SqlError { seState :: String
seState = String
"E"
                                       , seNativeError :: Int
seNativeError = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
status
                                       , seErrorMsg :: String
seErrorMsg = String
"execute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
statusmsg String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                      String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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
              String
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
              String
statusmsg <- CString -> IO String
peekCStringUTF8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> IO CString
pqresStatus Word32
status
              String
state     <- 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
pqresultErrorField Ptr CStmt
resptr CInt
67
{-# LINE 145 "Database/HDBC/PostgreSQL/Statement.hsc" #-}

              Ptr CStmt -> IO ()
pqclear_raw Ptr CStmt
resptr
              SqlError -> IO a
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO a) -> SqlError -> IO a
forall a b. (a -> b) -> a -> b
$ SqlError { seState :: String
seState = String
state
                                       , seNativeError :: Int
seNativeError = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
status
                                       , seErrorMsg :: String
seErrorMsg = String
"execute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
statusmsg String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                      String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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
                    CInt
numrows <- Ptr CStmt -> IO CInt
pqntuples Ptr CStmt
cstmt
                    String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"numrows: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
numrows
                    if CInt
nextrow CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
numrows
                       then do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"no more rows"
                               -- Don't use public_ffinish here
                               Stmt -> IO ()
ffinish Stmt
cmstmt
                               (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
forall a. Maybe a
Nothing, ((-CInt
1), Maybe [SqlValue]
forall a. Maybe a
Nothing))
                       else do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"getting stuff"
                               CInt
ncols <- Ptr CStmt -> IO CInt
pqnfields Ptr CStmt
cstmt
                               [SqlValue]
res <- (CInt -> IO SqlValue) -> [CInt] -> IO [SqlValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr CStmt -> CInt -> CInt -> IO SqlValue
getCol Ptr CStmt
cstmt CInt
nextrow)
                                      [CInt
0..(CInt
ncols CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)]
                               (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
nextrow CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1, [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just [SqlValue]
res))
          getCol :: Ptr CStmt -> CInt -> CInt -> IO SqlValue
getCol Ptr CStmt
p CInt
row CInt
icol =
             do CInt
isnull <- Ptr CStmt -> CInt -> CInt -> IO CInt
pqgetisnull Ptr CStmt
p CInt
row CInt
icol
                if CInt
isnull CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
                   then SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SqlValue
SqlNull
                   else do CString
text <- Ptr CStmt -> CInt -> CInt -> IO CString
pqgetvalue Ptr CStmt
p CInt
row CInt
icol
                           SqlTypeId
coltype <- (Word32 -> SqlTypeId) -> IO Word32 -> IO SqlTypeId
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> SqlTypeId
oidToColType (IO Word32 -> IO SqlTypeId) -> IO Word32 -> IO SqlTypeId
forall a b. (a -> b) -> a -> b
$ Ptr CStmt -> CInt -> IO Word32
pqftype Ptr CStmt
p CInt
icol
                           ByteString
s <- CString -> IO ByteString
B.packCString CString
text
                           SqlTypeId -> ByteString -> IO SqlValue
makeSqlValue SqlTypeId
coltype ByteString
s



fgetcoldef :: Ptr CStmt -> IO [(String, SqlColDesc)]
fgetcoldef :: Ptr CStmt -> IO [(String, SqlColDesc)]
fgetcoldef Ptr CStmt
cstmt =
    do CInt
ncols <- Ptr CStmt -> IO CInt
pqnfields Ptr CStmt
cstmt
       (CInt -> IO (String, SqlColDesc))
-> [CInt] -> IO [(String, SqlColDesc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CInt -> IO (String, SqlColDesc)
desccol [CInt
0..(CInt
ncols CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)]
    where desccol :: CInt -> IO (String, SqlColDesc)
desccol CInt
i =
              do String
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 
                 Word32
coltype <- Ptr CStmt -> CInt -> IO Word32
pqftype Ptr CStmt
cstmt CInt
i
                 --coloctets <- pqfsize
                 let coldef :: SqlColDesc
coldef = Word32 -> SqlColDesc
oidToColDef Word32
coltype
                 (String, SqlColDesc) -> IO (String, SqlColDesc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
colname, SqlColDesc
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"
       CInt
_ <- MVar CInt -> CInt -> IO CInt
forall a. MVar a -> a -> IO a
swapMVar (SState -> MVar CInt
nextrowmv SState
sstate) (-CInt
1)
       MVar (Maybe Stmt) -> (Maybe Stmt -> IO (Maybe Stmt)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (SState -> MVar (Maybe Stmt)
stomv SState
sstate) Maybe Stmt -> IO (Maybe Stmt)
forall {a}. Maybe Stmt -> IO (Maybe a)
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" #-}