Implement Cro::WebApp::I18N

lib/Cro/WebApp/I18N.pm6

@@ -1,33 +1,80 @@
-use Cro::HTTP::Router :plugin;
+use Cro::HTTP::Router :DEFAULT, :plugin;
 use POFile;
 
-my $plugin-key = router-plugin-register('cro-webapp-i18n');
+my $plugin-key = router-plugin-register('cro-webapp-i18n-files');
 my $prefix-key = router-plugin-register('cro-webapp-i18n-prefix');
 
-sub load-translation-file(Str $prefix, $file) is export {
-    router-plugin-add-config($plugin-key, $prefix => POFile.load($file));
+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 mean to configure _-prefix or use the long form of _?";
-        $prefix = @prefixes[*-1];
+                or die "No prefix configured, did you forget to call `_-prefix` or pass the prefix to _?";
+        $prefix = @prefixes[*- 1];
     }
-    my %config = router-plugin-get-configs($plugin-key);
-    with %config{$prefix} {
-        with $_{$key} {
-            .msgstr;
-        } orwith $default {
-            $default
-        } else {
-            die "No key $key in $prefix";
+    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 {
-        die "No such translation file: $prefix";
+        ()
     }
 }

t/i18n.t

@@ -14,30 +14,45 @@ my class I18NAwareForm is Cro::WebApp::Form {
     has $.name is rw is i18n-label('name-field');
 }
 
-my $application = route {
-    load-translation-file('main', 't/resources/test.po');
+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 -> 'form' {
+    get -> 'render' {
         template 'i18n-form.crotmp', { foo => I18NAwareForm.empty };
     }
-}
-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") },
-        'Can use _ in a template';
-ok $render-response.defined;
-is await($render-response.body-text), "b\nb";
-
-lives-ok { $render-response = await $client.get("/form") },
-        'Can render a form in a template';
-ok $render-response.defined;
-ok await($render-response.body-text) ~~ /'Your Name'/;
+}) ~~ /'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"