Skip to content

Instantly share code, notes, and snippets.

@moritz
Created December 4, 2013 17:19
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save moritz/7791603 to your computer and use it in GitHub Desktop.
Recurring date calculation (for the Perl 6 advent calendar)
use v6;
grammar DateSpec::Grammar {
rule TOP {
[<count><.quant>?]?
<day-of-week>
[<sign>? <offset=count>]?
}
token count { \d+ }
token quant { st | nd | rd | th }
token day-of-week { :i
[ mon | tue | wed | thu | fri | sat | sun ]
}
token sign { '+' | '-' }
}
my %dow = (mon => 1, tue => 2, wed => 3, thu => 4,
fri => 5, sat => 6, sun => 7);
class DateSpec {
has $.day-of-week;
has $.count;
has $.offset;
multi method new(Str $s) {
my $m = DateSpec::Grammar.parse($s);
die "Invalid date specification '$s'\n" unless $m;
self.bless(
:day-of-week(%dow{lc $m<day-of-week>}),
:count($m<count> ?? +$m<count>[0] !! 1),
:offset( ($m<sign> eq '-' ?? -1 !! 1)
* ($m<offset> ?? +$m<offset> !! 0)),
);
}
method based-on(Date $d is copy where { .day == 1}) {
++$d until $d.day-of-week == $.day-of-week;
$d += 7 * ($.count - 1) + $.offset;
return $d;
}
method next(Date $d = Date.today) {
my $month-start = $d.truncated-to(month);
my $candidate = $.based-on($month-start);
if $candidate ge $d {
return $candidate;
}
else {
return $.based-on($month-start + $month-start.days-in-month);
}
}
}
my $spec = DateSpec.new('3rd Tue + 2');
say $spec.next;
say $spec.next(Date.new(2013, 12, 25));
use v6;
class DateSpec { ... };
grammar DateSpec::Grammar {
rule TOP {
[<count><.quant>?]?
<day-of-week>
[<sign>? <offset=count>]?
}
token count { \d+ }
token quant { st | nd | rd | th }
token day-of-week { :i
[ mon | tue | wed | thu | fri | sat | sun ]
}
token sign { '+' | '-' }
}
class DateSpec::Actions {
method count($/) { make +$/ }
my %dow = (mon => 1, tue => 2, wed => 3, thu => 4,
fri => 5, sat => 6, sun => 7);
method day-of-week($/) { make %dow{lc $/} }
method sign($/) { make $/ eq '+' ?? 1 !! -1 };
method TOP($/) {
make DateSpec.new(
:day-of-week($<day-of-week>.ast),
:offset( ($<sign>.?ast // 1) * ($<offset>.?ast // 0)),
:count( $<count>[0].?ast),
);
}
}
class DateSpec {
has $.day-of-week;
has $.count;
has $.offset;
multi method new(Str $s) {
my $res = DateSpec::Grammar.parse($s,
:actions(DateSpec::Actions),
);
return $res.ast if $res;
die "Invalid date specification '$s'\n";
}
method based-on(Date $d is copy) {
++$d until $d.day-of-week == $.day-of-week;
$d += 7 * ($.count - 1) + $.offset;
return $d;
}
method next(Date $d = Date.today) {
my $month-start = $d.truncated-to(month);
my $candidate = $.based-on($month-start);
if $candidate ge $d {
return $candidate;
}
else {
return $.based-on($month-start + $month-start.days-in-month);
}
}
}
my $spec = DateSpec.new('3rd Tue + 2');
say $spec.next;
say $spec.next(Date.new(2013, 12, 24));
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment