Hi, While using green-card to create an interface for postgres database
access, I recieved the following when I executed
ghc -c PG.hs -o PG.o -fglasgow-exts -i/usr/local/gc-2.03/lib/ghc
-package text -package data -package util
ghc-5.02: panic! (the `impossible' happened, GHC version 5.02):
Native code generator can't handle foreign call
{-_ccall-}__casm ``do {PGresult * t;int result;
t = (PGresult *)%0;
do { result = PQnfields( t );
%r = (int)(result);} while(0);} while(0);''
Please report it as a compiler bug to [EMAIL PROTECTED],
or http://sourceforge.net/projects/ghc/.
I am using a newly compiled version of green-card (2.03) on Debian
testing. This is interfacing to postgres version 7.1.3, standard Debian
install.
The ghc is the standard Debian testing install asl well.
I have attached the PG.gc ,hs and .hi files, as well as an optional
include file used for hugs...
Please note, this interface has been working for hugs (albeit with problems)
Please let me know if there is anything I can do to assist in further
debugging.
Brett Giles
Grad Student in formal methods, University of Calgary,
http://www.cpsc.ucalgary.ca/~gilesb
module PG where
-- (
-- {-type-} PGConn,
-- connect, quickConnect, disConnect,
-- host, port, user, tty, dbName, options, query,
-- {-type-} PGResult, PGResEmpty, PGResOk, PGResCOut, PGResCIn,
-- PGResBad, PGResError, PGResTuples,
-- {-type-} PGTuples,
-- nFields, nTuples, fld2Inx, inx2Fld, getVal, getValNamed,
-- fields, row, col, colNamed, values
-- )
-- where
import StdDIS
-- encapsulate the foreign objects ( C pointers )
newtype PGConn = PGC ForeignObj -- a connection
newtype PGTuples = PGT ForeignObj -- result tuples
instance Eq PGTuples where
_ == _ = False
instance Show PGTuples where
showsPrec _ _ = showString "<TUPLES>"
data PGResult = PGResEmpty
| PGResOk
| PGResCOut
| PGResCIn
| PGResTuples PGTuples
| PGResBad String
| PGResError String
deriving Eq
instance Show PGResult where
showsPrec _ PGResEmpty = showString "<PGRES: empty query>"
showsPrec _ PGResOk = showString "<PGRES: query ok>"
showsPrec _ PGResCOut = showString "<PGRES: copy out started>"
showsPrec _ PGResCIn = showString "<PGRES: copy in started>"
showsPrec _ (PGResBad s) = showString ( "<PGRES:" ++ s ++ ">" )
showsPrec _ (PGResError s) = showString ( "<PGRES:" ++ s ++ ">" )
showsPrec _ (PGResTuples t) = showString (show t)
-- BEGINNING of GreenCard code ---------------------------------------------
----------------------------------------------------------------------------
%#include "hskPG.h"
%dis pgconn pgc = PGC (declare {PGconn *} pgc in (foreign pgc {PQfinish}))
%dis pgtuples pgt = PGT (declare {PGresult *} pgt in (foreign pgt {freePGRes}))
%fun primCmpTuples :: PGTuples -> PGTuples -> Bool
%call (pgtuples a) (pgtuples b)
%code res = 1;
%result (bool res)
%fun connect :: String -> String -> String -> String -> String -> String ->
% String -> IO PGConn
%call (string pghost) (string pgport) (string pgoptions) (string pgtty)
% (string dbName) (string login) (string pwd)
%code ConnStatusType status;
% res = PQsetdbLogin ( pghost, pgport, pgoptions,
% pgtty, dbName, login, pwd );
% status = PQstatus( res );
% if ( status == CONNECTION_BAD ) PQfinish( res );
%fail { status == CONNECTION_BAD } { PQerrorMessage( res ) }
%result (pgconn res)
%fun disConnect :: PGConn -> IO ()
%call (pgconn conn)
%code PQfinish (conn);
%fun quickConnect :: String -> String -> String -> IO PGConn
%call (string pghost) (string pgport) (string dbName)
%code ConnStatusType status;
% res = PQsetdbLogin ( pghost, pgport, NULL, NULL, dbName, NULL, NULL );
% status = PQstatus( res );
% if ( status == CONNECTION_BAD ) PQfinish( res );
%fail { status == CONNECTION_BAD } { PQerrorMessage( res ) }
%result (pgconn res)
%fun host :: PGConn -> String
%call (pgconn conn)
%code res = PQhost( conn ); if ( !res ) res = "";
%result (string res)
%fun port :: PGConn -> String
%call (pgconn conn)
%code res = PQport( conn ); if ( !res ) res = "";
%result (string res)
%fun user :: PGConn -> String
%call (pgconn conn)
%code res = PQuser( conn ); if ( !res ) res = "";
%result (string res)
%fun dbName :: PGConn -> String
%call (pgconn conn)
%code res = PQdb( conn ); if ( !res ) res = "";
%result (string res)
%fun tty :: PGConn -> String
%call (pgconn conn)
%code res = PQtty( conn ); if ( !res ) res = "";
%result (string res)
%fun options:: PGConn -> String
%call (pgconn conn)
%code res = PQoptions( conn ); if ( !res ) res = "";
%result (string res)
%const Int [
% pgResEmpty = { PGRES_EMPTY_QUERY },
% pgResOk = { PGRES_COMMAND_OK },
% pgResTuples = { PGRES_TUPLES_OK },
% pgResCOut = { PGRES_COPY_OUT },
% pgResCIn = { PGRES_COPY_IN },
% pgResBadi = { PGRES_BAD_RESPONSE },
% pgResError = { PGRES_NONFATAL_ERROR }
% ]
%fun query_ :: PGConn -> String -> IO ( Int, String, ForeignObj )
%call (pgconn conn) (string query)
%code result = PQexec( conn, query );
% if ( result )
% {
% status = PQresultStatus( result );
% msg = PQerrorMessage( result );
% }
% else
% {
% status = PGRES_NONFATAL_ERROR;
% msg = "malformed query";
% }
% /* Don't worry with the compiler warning about a non-const
% pointer here - the marshalling function duplicates the
% value. */
%fail { status == PGRES_FATAL_ERROR } { PQerrorMessage( result ) }
%result (int status, string msg, foreign result {freePGRes})
query :: PGConn -> String -> IO PGResult
query c q = do {
result <- query_ c q;
return (marshall_result result);
}
where
marshall_result ( i, msg, res )
| i == pgResTuples = PGResTuples (PGT res)
| i == pgResOk = PGResOk
| i == pgResError = PGResError msg
| i == pgResCOut = PGResCOut
| i == pgResCIn = PGResCIn
| i == pgResEmpty = PGResEmpty
| otherwise = PGResBad msg
%fun fld2Inx :: PGTuples -> String -> Int
%call (pgtuples t) (string f)
%code result = PQfnumber( t, f );
%result (int result)
%fun inx2Fld :: PGTuples -> Int -> String
%call (pgtuples t) (int i)
%code result = PQfname( t, i );
%result (string result)
%fun getValue :: PGTuples -> Int -> Int -> String
%call (pgtuples t) (int tn) (int fn)
%code result = PQgetvalue( t, tn, fn );
%result (string result)
%fun nTuples :: PGTuples -> Int
%call (pgtuples t)
%code result = PQntuples( t );
%result (int result)
%fun nFields :: PGTuples -> Int
%call (pgtuples t)
%code result = PQnfields( t );
%result (int result)
fields :: PGTuples -> [String]
fields t = fields_ t (nFields t) []
where fields_ _ 0 l = l
fields_ t n l = fields_ t (n-1) ( (inx2Fld t (n-1)):l )
row :: PGTuples -> Int -> [String]
row t r | r >= nTuples t || r < 0 = []
| otherwise = row_ t r (nFields t) []
where row_ _ _ 0 l = l
row_ t r n l = row_ t r (n-1) ((getValue t r (n-1)):l)
col :: PGTuples -> Int -> [String]
col t c | c >= nFields t || c < 0 = []
| otherwise = col_ t c (nTuples t) []
where col_ _ _ 0 l = l
col_ t c n l = col_ t c (n-1) ((getValue t (n-1) c):l)
colNamed :: PGTuples -> String -> [String]
colNamed t name = col t (fld2Inx t name)
-- row_ is repeated here because we don't need the extra check that
-- row() performs, and we don't want to call nFields() every loop
values :: PGTuples -> [[String]]
values t = values_ t (nTuples t) (nFields t) []
where values_ t 0 _ l = l
values_ t r f l = values_ t (r-1) f ( (row_ t (r-1) f []):l )
row_ _ _ 0 l = l
row_ t r n l = row_ t r (n-1) ((getValue t r (n-1)):l)
getVal :: PGTuples -> Int -> Int -> String
getVal t r c | r >= nTuples t || r < 0 || c >= nFields t || c < 0 = []
| otherwise = getValue t r c
getValNamed :: PGTuples -> Int -> String -> String
getValNamed t r name = getVal t r (fld2Inx t name)
{-# OPTIONS -#include "hskPG.h" #-}
module PG where
-- (
-- {-type-} PGConn,
-- connect, quickConnect, disConnect,
-- host, port, user, tty, dbName, options, query,
-- {-type-} PGResult, PGResEmpty, PGResOk, PGResCOut, PGResCIn,
-- PGResBad, PGResError, PGResTuples,
-- {-type-} PGTuples,
-- nFields, nTuples, fld2Inx, inx2Fld, getVal, getValNamed,
-- fields, row, col, colNamed, values
-- )
-- where
import StdDIS
-- encapsulate the foreign objects ( C pointers )
newtype PGConn = PGC ForeignObj -- a connection
newtype PGTuples = PGT ForeignObj -- result tuples
instance Eq PGTuples where
_ == _ = False
instance Show PGTuples where
showsPrec _ _ = showString "<TUPLES>"
data PGResult = PGResEmpty
| PGResOk
| PGResCOut
| PGResCIn
| PGResTuples PGTuples
| PGResBad String
| PGResError String
deriving Eq
instance Show PGResult where
showsPrec _ PGResEmpty = showString "<PGRES: empty query>"
showsPrec _ PGResOk = showString "<PGRES: query ok>"
showsPrec _ PGResCOut = showString "<PGRES: copy out started>"
showsPrec _ PGResCIn = showString "<PGRES: copy in started>"
showsPrec _ (PGResBad s) = showString ( "<PGRES:" ++ s ++ ">" )
showsPrec _ (PGResError s) = showString ( "<PGRES:" ++ s ++ ">" )
showsPrec _ (PGResTuples t) = showString (show t)
-- BEGINNING of GreenCard code ---------------------------------------------
----------------------------------------------------------------------------
primCmpTuples :: PGTuples -> PGTuples -> Bool
primCmpTuples gc_arg1 gc_arg3 =
unsafePerformIO(
case gc_arg1 of { (PGT a) ->
case gc_arg3 of { (PGT b) ->
_casm_ ``do {PGresult * a; PGresult * b;int res;
a = (PGresult *)%0; b = (PGresult *)%1;
do { res = 1;
%r = (int)(res);} while(0);} while(0);'' a b
>>= \ res ->
(unmarshall_bool_ res) >>= \ gc_res1 ->
(return (gc_res1))}})
connect :: String -> String -> String -> String -> String -> String -> String -> IO
PGConn
connect gc_arg1 gc_arg2 gc_arg3 gc_arg4 gc_arg5 gc_arg6 gc_arg7 =
(marshall_string_ gc_arg1) >>= \ (pghost) ->
(marshall_string_ gc_arg2) >>= \ (pgport) ->
(marshall_string_ gc_arg3) >>= \ (pgoptions) ->
(marshall_string_ gc_arg4) >>= \ (pgtty) ->
(marshall_string_ gc_arg5) >>= \ (dbName) ->
(marshall_string_ gc_arg6) >>= \ (login) ->
(marshall_string_ gc_arg7) >>= \ (pwd) ->
_casm_ ``do {static struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;} gc_result;
char * pghost; char * pgport; char * pgoptions; char * pgtty; char *
dbName; char * login; char * pwd;PGconn * res;int gc_failed;
char* gc_failstring;
pghost = (char *)%0; pgport = (char *)%1; pgoptions = (char *)%2; pgtty
= (char *)%3; dbName = (char *)%4; login = (char *)%5; pwd = (char *)%6;
do { ConnStatusType status;
res = PQsetdbLogin ( pghost, pgport, pgoptions,
pgtty, dbName, login, pwd );
status = PQstatus( res );
if ( status == CONNECTION_BAD ) PQfinish( res );
if ((gc_failed = ( status == CONNECTION_BAD ))) {gc_failstring =
PQerrorMessage( res ) ;}
else {gc_failed = 0;}
gc_result.gc_res3 = &PQfinish;
gc_result.gc_res1 = (void*)(res);
gc_result.gc_failed = gc_failed;
gc_result.gc_failstring = gc_failstring;
%r = &gc_result;} while(0);} while(0);'' pghost pgport pgoptions
pgtty dbName login pwd
>>= \ gc_result ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_res3;} while(0);'' (gc_result :: Addr) >>= \ gc_res3 ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_res1;} while(0);'' (gc_result :: Addr) >>= \ gc_res1 ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_failed;} while(0);'' (gc_result :: Addr) >>= \ gc_failed ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_failstring;} while(0);'' (gc_result :: Addr) >>= \
gc_failstring ->
if ( gc_failed /= (0::Int))
then unmarshall_string_ gc_failstring >>= ioError . userError
else (makeForeignObj gc_res1 gc_res3) >>= \ gc_res2 ->
(return ((PGC gc_res2)))
disConnect :: PGConn -> IO ()
disConnect gc_arg1 =
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;
conn = (PGconn *)%0;
do { PQfinish (conn);
} while(0);} while(0);'' conn}
quickConnect :: String -> String -> String -> IO PGConn
quickConnect gc_arg1 gc_arg2 gc_arg3 =
(marshall_string_ gc_arg1) >>= \ (pghost) ->
(marshall_string_ gc_arg2) >>= \ (pgport) ->
(marshall_string_ gc_arg3) >>= \ (dbName) ->
_casm_ ``do {static struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;} gc_result;
char * pghost; char * pgport; char * dbName;PGconn * res;int gc_failed;
char*
gc_failstring;
pghost = (char *)%0; pgport = (char *)%1; dbName = (char *)%2;
do { ConnStatusType status;
res = PQsetdbLogin ( pghost, pgport, NULL, NULL, dbName, NULL, NULL );
status = PQstatus( res );
if ( status == CONNECTION_BAD ) PQfinish( res );
if ((gc_failed = ( status == CONNECTION_BAD ))) {gc_failstring =
PQerrorMessage( res ) ;}
else {gc_failed = 0;}
gc_result.gc_res3 = &PQfinish;
gc_result.gc_res1 = (void*)(res);
gc_result.gc_failed = gc_failed;
gc_result.gc_failstring = gc_failstring;
%r = &gc_result;} while(0);} while(0);'' pghost pgport dbName
>>= \ gc_result ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_res3;} while(0);'' (gc_result :: Addr) >>= \ gc_res3 ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_res1;} while(0);'' (gc_result :: Addr) >>= \ gc_res1 ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_failed;} while(0);'' (gc_result :: Addr) >>= \ gc_failed ->
_casm_ ``do {%r = ((struct {void * gc_res3;void * gc_res1;int gc_failed;void *
gc_failstring;}*) %0)->gc_failstring;} while(0);'' (gc_result :: Addr) >>= \
gc_failstring ->
if ( gc_failed /= (0::Int))
then unmarshall_string_ gc_failstring >>= ioError . userError
else (makeForeignObj gc_res1 gc_res3) >>= \ gc_res2 ->
(return ((PGC gc_res2)))
host :: PGConn -> String
host gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQhost( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
port :: PGConn -> String
port gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQport( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
user :: PGConn -> String
user gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQuser( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
dbName :: PGConn -> String
dbName gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQdb( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
tty :: PGConn -> String
tty gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQtty( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
options :: PGConn -> String
options gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGC conn) ->
_casm_ ``do {PGconn * conn;char * res;
conn = (PGconn *)%0;
do { res = PQoptions( conn ); if ( !res ) res = "";
%r = (char *)(res);} while(0);} while(0);'' conn
>>= \ res ->
(unmarshall_string_ res) >>= \ gc_res1 ->
(return (gc_res1))})
pgResEmpty :: Int
pgResEmpty =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_EMPTY_QUERY ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResOk :: Int
pgResOk =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_COMMAND_OK ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResTuples :: Int
pgResTuples =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_TUPLES_OK ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResCOut :: Int
pgResCOut =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_COPY_OUT ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResCIn :: Int
pgResCIn =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_COPY_IN ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResBadi :: Int
pgResBadi =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_BAD_RESPONSE ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
pgResError :: Int
pgResError =
unsafePerformIO(
_casm_ ``do {int res1;
do {res1= PGRES_NONFATAL_ERROR ;
%r = (int)(res1);} while(0);} while(0);''
>>= \ res1 ->
(return (res1)))
query_ :: PGConn -> String -> IO (Int,String,ForeignObj)
query_ gc_arg1 gc_arg3 =
case gc_arg1 of { (PGC conn) ->
(marshall_string_ gc_arg3) >>= \ (query) ->
_casm_ ``do {static struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;} gc_result;
char * query;PGconn * conn;int status; char * msg; void* result;int
gc_failed;
char*
gc_failstring;
conn = (PGconn *)%0; query = (char *)%1;
do { result = PQexec( conn, query );
if ( result )
{
status = PQresultStatus( result );
msg = PQerrorMessage( result );
}
else
{
status = PGRES_NONFATAL_ERROR;
msg = "malformed query";
}
/* Don't worry with the compiler warning about a non-const
pointer here - the marshalling function duplicates the
value. */;
if ((gc_failed = ( status == PGRES_FATAL_ERROR ))) {gc_failstring
= PQerrorMessage( result ) ;}
else {gc_failed = 0;}
gc_result.status = (int)(status);
gc_result.msg = (char *)(msg);
gc_result.gc_res4 = &freePGRes;
gc_result.gc_res2 = (void*)(result);
gc_result.gc_failed = gc_failed;
gc_result.gc_failstring = gc_failstring;
%r = &gc_result;} while(0);} while(0);'' conn query
>>= \ gc_result ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->status;} while(0);'' (gc_result :: Addr) >>= \
status ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->msg;} while(0);'' (gc_result :: Addr) >>= \
msg ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->gc_res4;} while(0);'' (gc_result :: Addr) >>=
\ gc_res4 ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->gc_res2;} while(0);'' (gc_result :: Addr) >>=
\ gc_res2 ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->gc_failed;} while(0);'' (gc_result :: Addr)
>>= \ gc_failed ->
_casm_ ``do {%r = ((struct {int status;void * msg;void * gc_res4;void * gc_res2;int
gc_failed;void * gc_failstring;}*) %0)->gc_failstring;} while(0);'' (gc_result ::
Addr) >>= \ gc_failstring ->
if ( gc_failed /= (0::Int))
then unmarshall_string_ gc_failstring >>= ioError . userError
else (unmarshall_string_ msg) >>= \ gc_res1 ->
(makeForeignObj gc_res2 gc_res4) >>= \ gc_res3 ->
(return ((status,gc_res1,gc_res3)))}
query :: PGConn -> String -> IO PGResult
query c q = do {
result <- query_ c q;
return (marshall_result result);
}
where
marshall_result ( i, msg, res )
| i == pgResTuples = PGResTuples (PGT res)
| i == pgResOk = PGResOk
| i == pgResError = PGResError msg
| i == pgResCOut = PGResCOut
| i == pgResCIn = PGResCIn
| i == pgResEmpty = PGResEmpty
| otherwise = PGResBad msg
fld2Inx :: PGTuples -> String -> Int
fld2Inx gc_arg1 gc_arg3 =
unsafePerformIO(
case gc_arg1 of { (PGT t) ->
(marshall_string_ gc_arg3) >>= \ (f) ->
_casm_ ``do {char * f;PGresult * t;int result;
t = (PGresult *)%0; f = (char *)%1;
do { result = PQfnumber( t, f );
%r = (int)(result);} while(0);} while(0);'' t f
>>= \ result ->
(return (result))})
inx2Fld :: PGTuples -> Int -> String
inx2Fld gc_arg1 i =
unsafePerformIO(
case gc_arg1 of { (PGT t) ->
_casm_ ``do {int i;PGresult * t;char * result;
t = (PGresult *)%0; i = (int)%1;
do { result = PQfname( t, i );
%r = (char *)(result);} while(0);} while(0);'' t i
>>= \ result ->
(unmarshall_string_ result) >>= \ gc_res1 ->
(return (gc_res1))})
getValue :: PGTuples -> Int -> Int -> String
getValue gc_arg1 tn fn =
unsafePerformIO(
case gc_arg1 of { (PGT t) ->
_casm_ ``do {int tn; int fn;PGresult * t;char * result;
t = (PGresult *)%0; tn = (int)%1; fn = (int)%2;
do { result = PQgetvalue( t, tn, fn );
%r = (char *)(result);} while(0);} while(0);'' t tn fn
>>= \ result ->
(unmarshall_string_ result) >>= \ gc_res1 ->
(return (gc_res1))})
nTuples :: PGTuples -> Int
nTuples gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGT t) ->
_casm_ ``do {PGresult * t;int result;
t = (PGresult *)%0;
do { result = PQntuples( t );
%r = (int)(result);} while(0);} while(0);'' t
>>= \ result ->
(return (result))})
nFields :: PGTuples -> Int
nFields gc_arg1 =
unsafePerformIO(
case gc_arg1 of { (PGT t) ->
_casm_ ``do {PGresult * t;int result;
t = (PGresult *)%0;
do { result = PQnfields( t );
%r = (int)(result);} while(0);} while(0);'' t
>>= \ result ->
(return (result))})
fields :: PGTuples -> [String]
fields t = fields_ t (nFields t) []
where fields_ _ 0 l = l
fields_ t n l = fields_ t (n-1) ( (inx2Fld t (n-1)):l )
row :: PGTuples -> Int -> [String]
row t r | r >= nTuples t || r < 0 = []
| otherwise = row_ t r (nFields t) []
where row_ _ _ 0 l = l
row_ t r n l = row_ t r (n-1) ((getValue t r (n-1)):l)
col :: PGTuples -> Int -> [String]
col t c | c >= nFields t || c < 0 = []
| otherwise = col_ t c (nTuples t) []
where col_ _ _ 0 l = l
col_ t c n l = col_ t c (n-1) ((getValue t (n-1) c):l)
colNamed :: PGTuples -> String -> [String]
colNamed t name = col t (fld2Inx t name)
-- row_ is repeated here because we don't need the extra check that
-- row() performs, and we don't want to call nFields() every loop
values :: PGTuples -> [[String]]
values t = values_ t (nTuples t) (nFields t) []
where values_ t 0 _ l = l
values_ t r f l = values_ t (r-1) f ( (row_ t (r-1) f []):l )
row_ _ _ 0 l = l
row_ t r n l = row_ t r (n-1) ((getValue t r (n-1)):l)
getVal :: PGTuples -> Int -> Int -> String
getVal t r c | r >= nTuples t || r < 0 || c >= nFields t || c < 0 = []
| otherwise = getValue t r c
getValNamed :: PGTuples -> Int -> String -> String
getValNamed t r name = getVal t r (fld2Inx t name)
#include <stdio.h>
#include <libpq-fe.h>
#define HugsAPI2 HugsAPI3
void freePGRes( PGresult * p );
__interface "Main" PG 1 502 where
__export PG PGConn{PGC} PGResult{PGResBad PGResCIn PGResCOut PGResEmpty PGResError
PGResOk PGResTuples} PGTuples{PGT} col colNamed connect dbName disConnect fields
fld2Inx getVal getValNamed getValue host inx2Fld nFields nTuples options pgResBadi
pgResCIn pgResCOut pgResEmpty pgResError pgResOk pgResTuples port primCmpTuples query
queryzu quickConnect row tty user values;
import PrelPtr;
import PrelFloat;
import PrelWord;
import PrelReal;
import PrelByteArr;
import PrelStable;
import PrelEnum;
import PrelList;
import PrelInt;
import Monad;
import Int;
import IOExts;
import IORef;
import MArray;
import PrelHandle;
import StablePtr;
import Word;
import CCall;
import PrelWeak;
import PrelGHC :: 1;
import PrelBase ! :: 1;
import Addr :: 1;
import PrelNum :: 1;
import PrelTup :: 1;
import PrelIOBase :: 1;
import ForeignObj :: 1;
import PrelShow :: 1;
import PrelArr :: 1;
import StdDIS :: 1 1 1 marshallzustringzu 1 unmarshallzuboolzu 1 unmarshallzustringzu
1;
import PrelMaybe :: 1;
import PrelDynamic :: 1;
;
instance {PrelBase.Eq PGResult} = zdfEqPGResult ;
instance {PrelShow.Show PGResult} = zdfShowPGResult ;
instance {PrelShow.Show PGTuples} = zdfShowPGTuples ;
instance {PrelBase.Eq PGTuples} = zdfEqPGTuples ;
getVal :: PGTuples -> PrelBase.Int -> PrelBase.Int -> PrelBase.String;
getValNamed :: PGTuples -> PrelBase.Int -> PrelBase.String -> PrelBase.String;
values :: PGTuples -> [[PrelBase.String]];
colNamed :: PGTuples -> PrelBase.String -> [PrelBase.String];
col :: PGTuples -> PrelBase.Int -> [PrelBase.String];
row :: PGTuples -> PrelBase.Int -> [PrelBase.String];
fields :: PGTuples -> [PrelBase.String];
nFields :: PGTuples -> PrelBase.Int;
nTuples :: PGTuples -> PrelBase.Int;
getValue :: PGTuples -> PrelBase.Int -> PrelBase.Int -> PrelBase.String;
inx2Fld :: PGTuples -> PrelBase.Int -> PrelBase.String;
fld2Inx :: PGTuples -> PrelBase.String -> PrelBase.Int;
query :: PGConn -> PrelBase.String -> PrelIOBase.IO PGResult;
queryzu :: PGConn -> PrelBase.String -> PrelIOBase.IO (PrelBase.Int, PrelBase.String,
ForeignObj.ForeignObj);
pgResError :: PrelBase.Int;
pgResBadi :: PrelBase.Int;
pgResCIn :: PrelBase.Int;
pgResCOut :: PrelBase.Int;
pgResTuples :: PrelBase.Int;
pgResOk :: PrelBase.Int;
pgResEmpty :: PrelBase.Int;
options :: PGConn -> PrelBase.String;
tty :: PGConn -> PrelBase.String;
dbName :: PGConn -> PrelBase.String;
user :: PGConn -> PrelBase.String;
port :: PGConn -> PrelBase.String;
host :: PGConn -> PrelBase.String;
quickConnect :: PrelBase.String -> PrelBase.String -> PrelBase.String -> PrelIOBase.IO
PGConn;
disConnect :: PGConn -> PrelIOBase.IO ();
connect :: PrelBase.String -> PrelBase.String -> PrelBase.String -> PrelBase.String ->
PrelBase.String -> PrelBase.String -> PrelBase.String -> PrelIOBase.IO PGConn;
primCmpTuples :: PGTuples -> PGTuples -> PrelBase.Bool;
newtype PGConn = PGC ForeignObj.ForeignObj;
newtype PGTuples = PGT ForeignObj.ForeignObj;
data PGResult = PGResEmpty | PGResOk | PGResCOut | PGResCIn | PGResTuples PGTuples |
PGResBad PrelBase.String | PGResError PrelBase.String;
zdfShowPGTuples :: {PrelShow.Show PGTuples};
zdfShowPGResult :: {PrelShow.Show PGResult};
zdfEqPGTuples :: {PrelBase.Eq PGTuples};
zdfEqPGResult :: {PrelBase.Eq PGResult};
