Implement Cro::WebApp::I18N

lib/Cro/WebApp/Form.pm6

@@ -1,9 +1,11 @@
 use Cro::HTTP::Body;
 use Cro::HTTP::MultiValue;
+use Cro::WebApp::I18N;
 
 #| A role to be mixed in to Attribute to hold extra form-related properties.
 my role FormProperties {
     has $.webapp-form-label is rw;
+    has $.webapp-form-i18n-label is rw;
     has $.webapp-form-placeholder is rw;
     has $.webapp-form-help is rw;
     has Str $.webapp-form-type is rw;
@@ -30,6 +32,12 @@ multi trait_mod:<is>(Attribute:D $attr, :$label! --> Nil) is export {
     $attr.webapp-form-label = $label;
 }
 
+#| Set the i18n key to be used for this attribute (falls back to label).
+multi trait_mod:<is>(Attribute:D $attr, :$i18n-label! --> Nil) is export {
+    ensure-attr-state($attr);
+    $attr.webapp-form-i18n-label = $i18n-label;
+}
+
 #| Provide placeholder text for a form field.
 multi trait_mod:<is>(Attribute:D $attr, :$placeholder! --> Nil) is export {
     ensure-attr-state($attr);
@@ -521,7 +529,7 @@ role Cro::WebApp::Form {
     }
 
     method !calculate-label($attr) {
-        with $attr.?webapp-form-label {
+        my $label = do with $attr.?webapp-form-label {
             # Explicitly provided label
             $_
         }
@@ -531,6 +539,12 @@ role Cro::WebApp::Form {
             @words[0] .= tclc;
             @words.join(' ')
         }
+
+        with $attr.?webapp-form-i18n-label {
+            _($_, prefix => self.i18n-prefix, default => $label)
+        } else {
+            $label
+        }
     }
 
     #| Add validation errors to a control.
@@ -747,6 +761,9 @@ role Cro::WebApp::Form {
     method add-validation-error($message --> Nil) {
         $!validation-state.add-custom-error($message);
     }
+
+    #| Defines the prefix to use for translations using this form
+    method i18n-prefix(--> Str) { Str:U }
 }
 
 #| Take the submitted data in the request body and parse it into a form object of

lib/Cro/WebApp/I18N.pm6

@@ -0,0 +1,80 @@
+use Cro::HTTP::Router :DEFAULT, :plugin;
+use POFile;
+
+my $plugin-key = router-plugin-register('cro-webapp-i18n-files');
+my $prefix-key = router-plugin-register('cro-webapp-i18n-prefix');
+
+my class TranslationFile {
+    has Str:D $.prefix is required;
+    has POFile:D $.file is required;
+    has Str @.languages;
+}
+
+#| Load a translation file and store it with a given prefix and a given (set of) language
+sub load-translation-file(Str:D $prefix, $file, :language(:languages(@languages))) is export {
+    my $pofile = POFile.load($file);
+    my $translation-file = TranslationFile.new(:@languages, :$prefix, file => $pofile);
+    router-plugin-add-config($plugin-key, $translation-file);
+}
+
+#| Configure the default prefix `_` should use.
+#| This is useful for reducing duplication, especially in templates.
+sub _-prefix(Str $prefix) is export {
+    router-plugin-add-config($prefix-key, $prefix);
+}
+
+#| Install a language selection handler.
+#| That handler will receive a list of languages accepted by the client (from the Accept-Language header),
+#| and should return a language that will be used to filter against the loaded translation files.
+sub select-language(Callable $fn) is export {
+    # XXX We might register multiple `before-matched`, which is LTA
+    before-matched {
+        my @languages = get-languages(request.header('accept-language'));
+        request.annotations<language> = $fn(@languages);
+    }
+}
+
+#| Look up key and return its associated translation
+sub _(Str $key, Str :$prefix is copy, Str :$default) is export {
+    without $prefix {
+        my @prefixes = router-plugin-get-innermost-configs($prefix-key)
+                or die "No prefix configured, did you forget to call `_-prefix` or pass the prefix to _?";
+        $prefix = @prefixes[*- 1];
+    }
+    my $language = guess-language;
+    my %files = router-plugin-get-configs($plugin-key)
+            .grep(*.prefix eq $prefix)
+            .classify({ match-language(.languages, $language) });
+    for |(%files{"1"} // ()), |(%files{"2"} // ()), |(%files{"3"} // ()) {
+        with .file{$key} {
+            return .msgstr;
+        }
+    }
+    $default // die "No key $key in $prefix";
+}
+
+sub match-language(Str @languages, Str $accept --> Int) {
+    if +@languages && $accept.defined {
+        return 1 if any(@languages) eq $accept;
+        return 2 if $accept ~~ /^@languages'-'/;
+        # XXX is this fuzzy matching really necessary
+        return 4
+    } else {
+        return 3
+    }
+}
+
+sub guess-language(--> Str) {
+    try { request.annotations<language> } // Str
+}
+
+# TODO move this to Request
+sub get-languages($header) {
+    with $header {
+        # TODO q sort
+        # TODO move this to a request method
+        $header.split(',')>>.trim.map(*.split(';')[0].trim)
+    } else {
+        ()
+    }
+}

lib/Cro/WebApp/Template/Builtins.pm6

@@ -1,3 +1,5 @@
+use Cro::WebApp::I18N;
+
 class X::Cro::WebApp::Template::XSS is Exception {
     has Str $.content is required;
     method message() {
@@ -12,6 +14,6 @@ sub __TEMPLATE_SUB__HTML(Str() $html) is export {
     $html
 }
 
-sub __TEMPLATE_SUB__HTML-AND-JAVASCRIPT(Str() $html) is export {
-    $html
-}
+multi sub __TEMPLATE_SUB___(Str $key, Str :$prefix) is export {
+    _($key, :$prefix);
+}

t/i18n.t

@@ -0,0 +1,58 @@
+use Cro::WebApp::I18N;
+use Cro::HTTP::Router;
+use Cro::HTTP::Client;
+use Cro::HTTP::Server;
+use Cro::WebApp::Form;
+use Cro::WebApp::Template;
+use Test;
+
+my constant TEST_PORT = 30210;
+
+template-location $*PROGRAM.parent.add('test-data');
+
+my class I18NAwareForm is Cro::WebApp::Form {
+    has $.name is rw is i18n-label('name-field');
+}
+
+is get-response(route {
+    load-translation-file('main', 't/resources/main.po');
+    _-prefix 'main';
+
+    get -> 'render' {
+        is 'b', _('a', :prefix('main'));
+        template 'i18n-_.crotmp';
+    }
+}), "b\nb";
+
+ok get-response(route {
+    load-translation-file('main', 't/resources/main.po');
+    _-prefix 'main';
+
+    get -> 'render' {
+        template 'i18n-form.crotmp', { foo => I18NAwareForm.empty };
+    }
+}) ~~ /'Your Name'/;
+
+is get-response(route {
+    # XXX We currently fuzzy-match `en` and `en-XX`, should we really?
+    load-translation-file('main', 't/resources/main.po', :language<en en-GB en-US>);
+    load-translation-file('main', 't/resources/main-fr.po', :language<fr fr-FR fr-CH>);
+    _-prefix 'main';
+    select-language -> @ { 'fr' }
+
+    get -> 'render' {
+        template 'i18n-_.crotmp';
+    }
+}), "b mais en français\nb mais en français";
+
+sub get-response($application) {
+    my $server = Cro::HTTP::Server.new(:$application, :host('localhost'), :port(TEST_PORT));
+    $server.start;
+    LEAVE try $server.stop;
+    my $client = Cro::HTTP::Client.new(base-uri => "http://localhost:{ TEST_PORT }", :cookie-jar);
+
+    my $render-response;
+    lives-ok { $render-response = await $client.get("/render") };
+    ok $render-response.defined;
+    return await $render-response.body-text;
+}

t/resources/main-fr.po

@@ -0,0 +1,2 @@
+msgid "a"
+msgstr "b mais en français"

t/resources/main.po

@@ -0,0 +1,5 @@
+msgid "a"
+msgstr "b"
+
+msgid "name-field"
+msgstr "Your Name"

t/test-data/i18n-_.crotmp

@@ -0,0 +1,2 @@
+<&_('a')>
+<&_('a', :prefix('main'))>

t/test-data/i18n-form.crotmp

@@ -0,0 +1 @@
+<&form(.foo)>