generated from tpl/purs
Remove purspgpp
This commit is contained in:
parent
4fd8c42515
commit
dc4cdda722
@ -1,11 +0,0 @@
|
|||||||
module PurspgppExample where
|
|
||||||
|
|
||||||
f :: Query (String × Unit) (UUID × String × Unit)
|
|
||||||
f = [query|
|
|
||||||
SELECT id, name
|
|
||||||
FROM files
|
|
||||||
WHERE author_id = $1
|
|
||||||
|]
|
|
||||||
|
|
||||||
g :: Query Unit (Boolean × Unit)
|
|
||||||
g = [query|SELECT pg_try_advisory_lock(3735928559)|]
|
|
@ -3,3 +3,8 @@
|
|||||||
purescript-postgresql-client is a PostgreSQL client library for PureScript.
|
purescript-postgresql-client is a PostgreSQL client library for PureScript.
|
||||||
|
|
||||||
To use this library, you need to add `pg` as an npm dependency.
|
To use this library, you need to add `pg` as an npm dependency.
|
||||||
|
|
||||||
|
The purspgpp preprocessor has been replaced by [sqltopurs], which is a code
|
||||||
|
generator instead of a preprocessor, and easier to use.
|
||||||
|
|
||||||
|
[sqltopurs]: https://github.com/rightfold/sqltopurs
|
||||||
|
108
purspgpp
108
purspgpp
@ -1,108 +0,0 @@
|
|||||||
#!/usr/bin/env perl6
|
|
||||||
use v6;
|
|
||||||
use NativeCall;
|
|
||||||
|
|
||||||
module libpq {
|
|
||||||
constant LIBPQ = $*DISTRO.is-win ?? "libpq" !! "pq";
|
|
||||||
|
|
||||||
sub PQconnectdb(Str --> Pointer[void]) is native(LIBPQ) {*}
|
|
||||||
|
|
||||||
sub PQstatus(Pointer[void] --> int32) is native(LIBPQ) {*}
|
|
||||||
sub PQerrorMessage(Pointer[void] --> Str) is native(LIBPQ) {*}
|
|
||||||
sub PQresultStatus(Pointer[void] --> int32) is native(LIBPQ) {*}
|
|
||||||
sub PQresultErrorMessage(Pointer[void] --> Str) is native(LIBPQ) {*}
|
|
||||||
|
|
||||||
sub PQprepare(Pointer[void], Str, Str, int32, Pointer[void] --> Pointer[void]) is native(LIBPQ) {*}
|
|
||||||
sub PQdescribePrepared(Pointer[void], Str --> Pointer[void]) is native(LIBPQ) {*}
|
|
||||||
sub PQnparams(Pointer[void] --> int32) is native(LIBPQ) {*}
|
|
||||||
sub PQparamtype(Pointer[void], int32 --> uint32) is native(LIBPQ) {*}
|
|
||||||
sub PQnfields(Pointer[void] --> int32) is native(LIBPQ) {*}
|
|
||||||
sub PQftype(Pointer[void], int32 --> uint32) is native(LIBPQ) {*}
|
|
||||||
|
|
||||||
our class Description {
|
|
||||||
has Int:D @.parameters;
|
|
||||||
has Int:D @.fields;
|
|
||||||
}
|
|
||||||
|
|
||||||
our class Connection {
|
|
||||||
has Pointer[void] $!handle;
|
|
||||||
|
|
||||||
method new(Str:D $connection-string) {
|
|
||||||
self.bless(:$connection-string);
|
|
||||||
}
|
|
||||||
|
|
||||||
submethod BUILD(Str:D :$connection-string) {
|
|
||||||
my $handle = PQconnectdb($connection-string);
|
|
||||||
die PQerrorMessage($handle) unless PQstatus($handle) == 0;
|
|
||||||
$!handle = $handle;
|
|
||||||
}
|
|
||||||
|
|
||||||
method prepare(Str:D $name, Str:D $source) {
|
|
||||||
my $result = PQprepare($!handle, $name, $source, 0, Nil);
|
|
||||||
die PQerrorMessage($!handle) without $result;
|
|
||||||
die PQresultErrorMessage($result) unless PQresultStatus($result) == 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
method describe-prepared(Str:D $name) {
|
|
||||||
my $result = PQdescribePrepared($!handle, $name);
|
|
||||||
die PQerrorMessage($!handle) without $result;
|
|
||||||
die PQresultErrorMessage($result) unless PQresultStatus($result) == 1;
|
|
||||||
my @parameters = (^PQnparams($result)).map({PQparamtype($result, $_)});
|
|
||||||
my @fields = (^PQnfields($result)).map({PQftype($result, $_)});
|
|
||||||
Description.new(:@parameters, :@fields);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
constant DEFAULT-MAPPING = q:to/EOF/;
|
|
||||||
16 Boolean
|
|
||||||
17 ByteString
|
|
||||||
18 Char
|
|
||||||
23 Int
|
|
||||||
25 String
|
|
||||||
701 Number
|
|
||||||
2950 UUID
|
|
||||||
2951 List UUID
|
|
||||||
EOF
|
|
||||||
|
|
||||||
sub process-module(libpq::Connection $conn, %mapping, Str:D $segment --> Str:D) {
|
|
||||||
S:g/'[query|' (.*?) '|]'/&process-query($conn, %mapping, ~$0)/ given $segment;
|
|
||||||
}
|
|
||||||
|
|
||||||
multi sub process-query(libpq::Connection:D $conn, %mapping, Str:D $source --> Str:D) {
|
|
||||||
$conn.prepare: '', $source;
|
|
||||||
my $description = $conn.describe-prepared('');
|
|
||||||
sub convert-types(Int:D @oids --> Str:D) {
|
|
||||||
die "unknown oid: $_" unless %mapping{$_}:exists for @oids;
|
|
||||||
multi sub infix:<Tuple>(--> Str:D) is assoc<right> { "Unit" }
|
|
||||||
multi sub infix:<Tuple>(Str:D $a --> Str:D) { $a }
|
|
||||||
multi sub infix:<Tuple>(Str:D $a, Str:D $b --> Str:D) { "Tuple ($a) ($b)" }
|
|
||||||
[Tuple] |@oids.map({%mapping{$_}}), "Unit";
|
|
||||||
}
|
|
||||||
my $parameters = convert-types($description.parameters);
|
|
||||||
my $fields = convert-types($description.fields);
|
|
||||||
"(Query \"\"\"$source\"\"\" :: Query ($parameters) ($fields))";
|
|
||||||
}
|
|
||||||
|
|
||||||
multi sub process-query(libpq::Connection:U $conn, %mapping, Str:D $source --> Str:D) {
|
|
||||||
"(Query \"\"\"$source\"\"\")";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub main(libpq::Connection $conn, IO::Path:D $in-file, IO::Path:D $out-file, Bool:D $syntax-only, IO::Path $mapping-file) {
|
|
||||||
my %mapping{Int:D} =
|
|
||||||
(do with $mapping-file { .slurp } else { DEFAULT-MAPPING })
|
|
||||||
.lines
|
|
||||||
.map(*.trim.split(/\s+/, 2))
|
|
||||||
.grep(*.elems == 2)
|
|
||||||
.map({+$_[0] => $_[1]});
|
|
||||||
$out-file.spurt: process-module($conn, %mapping, $in-file.slurp);
|
|
||||||
}
|
|
||||||
|
|
||||||
multi sub MAIN(Str $connection-string, IO(Cool) $in-file, IO(Cool) $out-file = '-', Bool :$syntax-only where !*, IO(Cool) :$mapping-file) {
|
|
||||||
my $conn = libpq::Connection.new($connection-string);
|
|
||||||
main($conn, $in-file, $out-file, $syntax-only // False, $mapping-file);
|
|
||||||
}
|
|
||||||
|
|
||||||
multi sub MAIN(IO(Cool) $in-file, IO(Cool) $out-file = '-', Bool :$syntax-only where *, IO(Cool) :$mapping-file) {
|
|
||||||
main(libpq::Connection, $in-file, $out-file, $syntax-only // False, $mapping-file);
|
|
||||||
}
|
|
Loading…
Reference in New Issue
Block a user