Add a user.wfh-days preference

Some people work from home some days, and I can never remember when. Now
I won't have to.

lib/Synergy/Reactor/Status.pm

@@ -11,7 +11,7 @@ use utf8;
 use experimental qw(signatures);
 use namespace::clean;
 use List::Util qw(first);
-use Synergy::Util qw(parse_time_hunk);
+use Synergy::Util qw(parse_time_hunk day_name_from_abbr);
 use Time::Duration::Parse;
 use Time::Duration;
 
@@ -202,8 +202,16 @@ sub _business_hours_status ($self, $event, $user) {
       ucfirst $user->theyre, $user->their;
   }
 
-  return sprintf "It's currently %s normal business hours.",
-    $user->their;
+  my $trailer = '';
+  if ($user->is_wfh_on($dow)) {
+    $trailer = sprintf q{, and usually %s works from home on %ss},
+      $user->they,
+      day_name_from_abbr($dow);
+  }
+
+  return sprintf "It's currently %s normal business hours%s.",
+    $user->their,
+    $trailer,
 }
 
 sub _chatter_status ($self, $event, $user) {

lib/Synergy/User.pm

@@ -172,6 +172,11 @@ sub hours_for_dow ($self, $dow) {
   return $hours;
 }
 
+sub is_wfh_on ($self, $dow) {
+  my $wfh_days = $self->preference('wfh-days');
+  return !! grep {; $_ eq $dow } @$wfh_days;
+}
+
 # We must now inject $hub, because the directory is not necessarily attached
 # to one.
 sub shift_for_day ($self, $hub, $moment) {

lib/Synergy/UserDirectory.pm

@@ -14,8 +14,9 @@ use experimental qw(signatures lexical_subs);
 use namespace::autoclean;
 use Path::Tiny;
 use Synergy::User;
-use Synergy::Util qw(known_alphabets read_config_file);
+use Synergy::Util qw(known_alphabets read_config_file day_name_from_abbr);
 use Synergy::Logger '$Logger';
+use Lingua::EN::Inflect qw(WORDLIST);
 use List::Util qw(first shuffle all);
 use DateTime;
 use Defined::KV;
@@ -382,4 +383,30 @@ __PACKAGE__->add_preference(
   },
 );
 
+__PACKAGE__->add_preference(
+  name => 'wfh-days',
+  help      => q{days you work regularly from home; use "Wed, Fri" (etc.)"},
+  default   => sub { [] },
+  describer => sub ($value) {
+    my @all = map {; day_name_from_abbr($_) } @$value;
+    return @all ? WORDLIST(@all) : '<none>';
+  },
+  validator => sub ($self, $value, @) {
+    my @known = qw(mon tue wed thu fri sat sun);
+    my %is_valid = map {; $_ => 1 } @known;
+
+    my @got = split /[,;]\s+/, lc $value;
+
+    return [] if @got == 1 and $got[0] eq 'none';
+
+    my @bad = grep {; ! $is_valid{$_} } @got;
+    if (@bad) {
+      my $err = q{use 3-letter day abbreviations, separated with commas, like "Wed, Fri" (or "none")};
+      return (undef, $err);
+    }
+
+    return \@got;
+  },
+);
+
 1;

lib/Synergy/Util.pm

@@ -37,6 +37,7 @@ use Sub::Exporter -setup => [ qw(
   transliterate
 
   validate_business_hours describe_business_hours
+  day_name_from_abbr
 ) ];
 
 sub read_config_file ($filename) {
@@ -547,4 +548,18 @@ sub describe_business_hours ($value) {
     (qw(weekdays sun), @wdays, qw(sat weekends));
 }
 
+sub day_name_from_abbr ($dow) {
+  state $days = {
+    mon => 'Monday',
+    tue => 'Tuesday',
+    wed => 'Wednesday',
+    thu => 'Thursday',
+    fri => 'Friday',
+    sat => 'Saturday',
+    sun => 'Sunday',
+  };
+
+  return $days->{$dow};
+}
+
 1;