generated from tpl/purs
122 lines
3.3 KiB
Perl
122 lines
3.3 KiB
Perl
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($_)) . ']';
|
|
}
|
|
}
|