{-# 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 ()
data SState =
SState { SState -> MVar (Maybe Stmt)
stomv :: MVar (Maybe Stmt),
SState -> MVar CInt
nextrowmv :: MVar (CInt),
SState -> Conn
dbo :: Conn,
SState -> String
squery :: String,
SState -> MVar [(String, SqlColDesc)]
coldefmv :: MVar [(String, SqlColDesc)]}
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)
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 ->
do String -> IO ()
forall (m :: * -> *) t. Monad m => t -> m ()
l String
"in fexecute"
SState -> IO ()
public_ffinish SState
sstate
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
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
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
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)
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"
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
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)
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 ()
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" #-}
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
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
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)))
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))
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
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
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
String
s
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" #-}