v2rw/RelEdit: Allow creating a new release

Not totally super happy with this solution; I'd rather automatically
create an empty entry and send that to 'RelEdit.Main', but initializing
all fields in Perl is tricky. At least in Elm we get some sort of type
checking (though Elm can't tell whether the default value makes sense)
and doing this in Elm makes it possible to initialize to something
invalid that the user has to change (not currently done yet).

It's messy either way.

2 files changed, 67 insertions, 48 deletions

diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
index cf6409cb..355fbdc2 100644
--- a/lib/VNWeb/Elm.pm
+++ b/lib/VNWeb/Elm.pm
@@ -202,7 +202,7 @@ sub write_module {
 #   elm_api FormName => $OUT_SCHEMA, $IN_SCHEMA, sub {
 #       my($data) = @_;
 #       elm_Success # Or any other elm_Response() function
-#   };
+#   }, %extra_schemas;
 #
 # That will create an endpoint at `POST /elm/FormName.json` that accepts JSON
 # data that must validate $IN_SCHEMA. The subroutine is given the validated
@@ -220,11 +220,12 @@ sub write_module {
 #   -- Command to send an API request to the endpoint and receive a response
 #   send : Send -> (Gen.Api.Response -> msg) -> Cmd msg
 #
+# Extra type aliases can be added using %extra_schemas.
 sub elm_api {
-    my($name, $out, $in, $sub) = @_;
+    my($name, $out, $in, $sub, %extra) = @_;
 
-    $in  = ref $in  eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $in  }) : $in;
-    $out = ref $out eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $out }) : $out;
+    my sub comp { ref $_[0] eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $_[0] }) : $_[0] }
+    $in = comp $in;
 
     TUWF::post qr{/elm/\Q$name\E\.json} => sub {
         if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
@@ -245,8 +246,9 @@ sub elm_api {
     if(tuwf->{elmgen}) {
         my $data = "import Gen.Api as GApi\n";
         $data .=   "import Lib.Api as Api\n";
-        $data .= def_type Recv => $out->analyze if $out;
+        $data .= def_type Recv => comp($out)->analyze if $out;
         $data .= def_type Send => $in->analyze;
+        $data .= def_type $_ => comp($extra{$_})->analyze for sort keys %extra;
         $data .= def_validation val => $in->analyze;
         $data .= encoder encode => 'Send', $in->analyze;
         $data .= "send : Send -> (GApi.Response -> msg) -> Cmd msg\n";
@@ -352,8 +354,8 @@ sub write_extlinks {
 
     my sub links {
         my($name, $type, @links) = @_;
-        def $name => "List (Site $type)" => list map {
-            my($i,$l) = ($_, $links[$_]);
+        $data .= def $name.'Sites' => "List (Site $type)" => list map {
+            my $l = $_;
             my $addval = $l->{int} ? 'toint v' : 'v';
             '{ '.join("\n  , ",
                 'name  = '.string($l->{name}),
@@ -364,9 +366,12 @@ sub write_extlinks {
                 'del   = (\i m -> { m | '.$l->{id}.' = '.($l->{multi} ? "delidx i m.$l->{id}" : $l->{default}).' })',
                 'add   = (\v m -> { m | '.$l->{id}.' = '.($l->{multi} ? "m.$l->{id} ++ [$addval]" : $addval).' })'
             )."\n  }";
-        } 0..$#links;
+        } @links;
+
+        $data .= def $name.'New' => $type =>
+            "\n  { ".join("\n  , ", map sprintf('%-10s = %s', $_->{id}, $_->{default}), @links)."\n  }";
     }
-    $data .= links releaseLinks => 'GRE.RecvExtlinks' => VNDB::ExtLinks::extlinks_sites('r');
+    links release => 'GRE.RecvExtlinks' => VNDB::ExtLinks::extlinks_sites('r');
 
     write_module ExtLinks => $data;
 }
diff --git a/lib/VNWeb/Releases/Edit.pm b/lib/VNWeb/Releases/Edit.pm
index a292261d..f569e7b0 100644
--- a/lib/VNWeb/Releases/Edit.pm
+++ b/lib/VNWeb/Releases/Edit.pm
@@ -4,46 +4,46 @@ use VNWeb::Prelude;
 
 
 my $FORM = {
-    id         => { required => 0, id => 1 },
-    title      => { maxlength => 250 },
-    original   => { required => 0, default => '', maxlength => 250 },
-    rtype      => { enum => \%RELEASE_TYPE },
-    patch      => { anybool => 1 },
-    freeware   => { anybool => 1 },
-    doujin     => { anybool => 1 },
-    lang       => { aoh => { lang => { enum => \%LANGUAGE } } },
-    platforms  => { aoh => { platform => { enum => \%PLATFORM } } },
-    media      => { aoh => {
+    id         => { _when => 'in out', required => 0, id => 1 },
+    title      => { _when => 'in out new', maxlength => 250 },
+    original   => { _when => 'in out new', required => 0, default => '', maxlength => 250 },
+    rtype      => { _when => 'in out', enum => \%RELEASE_TYPE },
+    patch      => { _when => 'in out', anybool => 1 },
+    freeware   => { _when => 'in out', anybool => 1 },
+    doujin     => { _when => 'in out', anybool => 1 },
+    lang       => { _when => 'in out', aoh => { lang => { enum => \%LANGUAGE } } },
+    platforms  => { _when => 'in out', aoh => { platform => { enum => \%PLATFORM } } },
+    media      => { _when => 'in out', aoh => {
         medium    => { enum => \%MEDIUM },
         qty       => { uint => 1, range => [0,20] },
     } },
-    gtin       => { gtin => 1 },
-    catalog    => { required => 0, default => '', maxlength => 50 },
-    released   => { rdate => 1 },
-    minage     => { int => 1, enum => \%AGE_RATING },
-    uncensored => { anybool => 1 },
-    resolution => { enum => \%RESOLUTION },
-    voiced     => { uint => 1, enum => \%VOICED },
-    ani_story  => { uint => 1, enum => \%ANIMATED },
-    ani_ero    => { uint => 1, enum => \%ANIMATED },
-    website    => { required => 0, default => '', weburl => 1 },
-    engine     => { required => 0, default => '', maxlength => 50 },
-    extlinks   => validate_extlinks('r'),
-    notes      => { required => 0, default => '', maxlength => 10240 },
-    vn         => { sort_keys => 'vid', aoh => {
+    gtin       => { _when => 'in out', gtin => 1 },
+    catalog    => { _when => 'in out', required => 0, default => '', maxlength => 50 },
+    released   => { _when => 'in out', min => 1, rdate => 1 },
+    minage     => { _when => 'in out', int => 1, enum => \%AGE_RATING },
+    uncensored => { _when => 'in out', anybool => 1 },
+    resolution => { _when => 'in out', enum => \%RESOLUTION },
+    voiced     => { _when => 'in out', uint => 1, enum => \%VOICED },
+    ani_story  => { _when => 'in out', uint => 1, enum => \%ANIMATED },
+    ani_ero    => { _when => 'in out', uint => 1, enum => \%ANIMATED },
+    website    => { _when => 'in out', required => 0, default => '', weburl => 1 },
+    engine     => { _when => 'in out', required => 0, default => '', maxlength => 50 },
+    extlinks   => { _when => 'in out', validate_extlinks('r')->%* },
+    notes      => { _when => 'in out', required => 0, default => '', maxlength => 10240 },
+    vn         => { _when => 'in out new', sort_keys => 'vid', aoh => {
         vid    => { id => 1 },
-        title  => { _when => 'out' },
+        title  => { _when => 'out new' },
     } },
-    producers  => { sort_keys => 'pid', aoh => {
+    producers  => { _when => 'in out', sort_keys => 'pid', aoh => {
         pid       => { id => 1 },
         developer => { anybool => 1 },
         publisher => { anybool => 1 },
         name      => { _when => 'out' },
     } },
-    hidden     => { anybool => 1 },
-    locked     => { anybool => 1 },
+    hidden     => { _when => 'in out', anybool => 1 },
+    locked     => { _when => 'in out', anybool => 1 },
 
-    engines    => { _when => 'out', aoh => {
+    engines    => { _when => 'out new', aoh => {
         engine => {},
         count  => { uint => 1 },
     } },
@@ -53,10 +53,18 @@ my $FORM = {
 
 my $FORM_OUT = form_compile out => $FORM;
 my $FORM_IN  = form_compile in  => $FORM;
+my $FORM_NEW = form_compile new => $FORM;
 my $FORM_CMP = form_compile cmp => $FORM;
 
 sub to_extlinks { $_[0]{extlinks} = { map +($_, delete $_[0]{$_}), grep /^l_/, keys $_[0]->%* } }
 
+sub engines {
+    tuwf->dbAlli(q{
+         SELECT engine, count(*) AS count FROM releases WHERE NOT hidden AND engine <> ''
+          GROUP BY engine ORDER BY count(*) DESC, engine
+    })
+}
+
 TUWF::get qr{/$RE{rrev}/(?<action>edit|copy)} => sub {
     my $e = db_entry r => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
     my $copy = tuwf->capture('action') eq 'copy';
@@ -64,12 +72,9 @@ TUWF::get qr{/$RE{rrev}/(?<action>edit|copy)} => sub {
 
     $e->{rtype} = delete $e->{type};
     $e->{authmod} = auth->permDbmod;
-    $e->{editsum} = $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision r$e->{id}.$e->{chrev}";
+    $e->{editsum} = $copy ? "Copied from r$e->{id}.$e->{chrev}" : $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision r$e->{id}.$e->{chrev}";
 
-    $e->{engines} = tuwf->dbAlli(q{
-         SELECT engine, count(*) AS count FROM releases WHERE NOT hidden AND engine <> ''
-          GROUP BY engine ORDER BY count(*) DESC, engine
-    });
+    $e->{engines} = engines;
     to_extlinks $e;
 
     enrich_merge vid => 'SELECT id AS vid, title FROM vn WHERE id IN', $e->{vn};
@@ -86,11 +91,20 @@ TUWF::get qr{/$RE{rrev}/(?<action>edit|copy)} => sub {
 
 TUWF::get qr{/$RE{vid}/add}, sub {
     return tuwf->resDenied if !can_edit r => undef;
-    # TODO: Auto-fill some fields
-    framework_ title => 'Add release',
+    my $v = tuwf->dbRowi('SELECT id, title, original FROM vn WHERE id =', \tuwf->capture('id'));
+    return tuwf->resNotFound if !$v->{id};
+
+    # TODO: List deleted releases
+    framework_ title => "Add release to $v->{title}",
     sub {
-        editmsg_ r => undef, 'Add release';
-        elm_ 'ReleaseEdit.New';
+        editmsg_ r => undef, "Add release to $v->{title}";
+        elm_ 'ReleaseEdit.New' => $FORM_NEW, {
+            title    => $v->{title},
+            original => $v->{original},
+            engines  => engines(),
+            authmod  => auth->permDbmod(),
+            vn       => [{vid => $v->{id}, title => $v->{title}}],
+        };
     };
 };
 
@@ -123,7 +137,7 @@ elm_api ReleaseEdit => $FORM_OUT, $FORM_IN, sub {
 
     my($id,undef,$rev) = db_edit r => $e->{id}, $data;
     elm_Redirect "/r$id.$rev";
-};
+}, New => $FORM_NEW;
 
 
 1;