purescript-postgresql-client/Rows.pl

122 lines
3.3 KiB
Perl
Raw Normal View History

use strict;
use warnings;
sub vars {
my @as;
for (my $a = 'a', my $i = 0; $i < $_; ++$a, ++$i) {
push @as, $a;
}
@as
}
if (@ARGV != 1) {
die 'Usage: perl Rows.perl src/Database/PostgreSQL/Row.purs';
}
open my $out, '>', $ARGV[0]
or die $!;
print $out <<'EOF';
module Database.PostgreSQL.Row where
import Data.Array as Array
import Data.Either (Either(..))
import Data.Foreign (Foreign)
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, toSQLValue)
import Prelude
-- | Convert things to SQL rows.
class ToSQLRow a where
toSQLRow :: a -> Array Foreign
-- | Convert things from SQL rows.
class FromSQLRow a where
fromSQLRow :: Array Foreign -> Either String a
EOF
for (0 .. 19) {
print $out "\n";
print $out "-- | A row with $_ field" . ($_ == 1 ? '' : 's') . ".\n";
print $out "data Row$_";
print $out map { " $_" } vars($_);
print $out " = Row$_";
print $out map { " $_" } vars($_);
print $out "\n\n";
if ($_ == 0) {
print $out "derive instance eqRow$_ :: Eq Row$_";
} else {
print $out "derive instance eqRow$_ :: (";
print $out join(', ', map { "Eq $_" } vars($_));
print $out ") => Eq (Row$_" . join('', map { " $_" } vars($_)) . ")";
}
print $out "\n\n";
if ($_ == 0) {
print $out "derive instance ordRow$_ :: Ord Row$_";
} else {
print $out "derive instance ordRow$_ :: (";
print $out join(', ', map { "Ord $_" } vars($_));
print $out ") => Ord (Row$_" . join('', map { " $_" } vars($_)) . ")";
}
print $out "\n\n";
if ($_ == 0) {
print $out "instance showRow$_ :: Show Row$_";
} else {
print $out "instance showRow$_ :: (";
print $out join(', ', map { "Show $_" } vars($_));
print $out ") => Show (Row$_" . join('', map { " $_" } vars($_)) . ')';
}
print $out " where\n";
if ($_ == 0) {
print $out " show Row$_ =\n";
print $out " \"Row$_\"";
} else {
print $out " show (Row$_" . join('', map { " $_" } vars($_)) . ") = \n";
print $out " \"(Row$_ \" <> ";
print $out join(' <> " " <> ', map { "show $_" } vars($_));
print $out " <> \")\"";
}
print $out "\n\n";
if ($_ == 0) {
print $out "instance fromSQLRowRow$_ :: FromSQLRow Row$_";
} else {
print $out "instance fromSQLRowRow$_ :: (";
print $out join(', ', map { "FromSQLValue $_" } vars($_));
print $out ") => FromSQLRow (Row$_" . join('', map { " $_" } vars($_)) . ')';
}
print $out " where\n";
print $out ' fromSQLRow [' . join(', ', vars($_)) . "] =\n";
print $out " pure Row$_\n";
for (vars($_)) {
print $out " <*> fromSQLValue $_\n";
}
print $out ' fromSQLRow xs = Left $ "Row has " <> show n <> " fields,';
print $out " expecting $_.\"\n";
print $out ' where n = Array.length xs';
print $out "\n\n";
if ($_ == 0) {
print $out "instance toSQLRowRow$_ :: ToSQLRow Row$_";
} else {
print $out "instance toSQLRowRow$_ :: (";
print $out join(', ', map { "ToSQLValue $_" } vars($_));
print $out ") => ToSQLRow (Row$_" . join('', map { " $_" } vars($_)) . ')';
}
print $out " where\n";
if ($_ == 0) {
print $out " toSQLRow Row$_ = []";
} else {
print $out " toSQLRow (Row$_" . join('', map { " $_" } vars($_)) . ") = \n";
print $out ' [' . join(', ', map { "toSQLValue $_" } vars($_)) . ']';
}
}