mnemosyne/lib/Mnemosyne/Schedule.pm

package Mnemosyne::Schedule;
use strict;
use warnings;
use DateTime;
use Carp qw(croak);

use constant {
    UPCOMING_HORIZON  => 7,
    MEDIUM_FLOAT_DAYS => 3,
    LOW_FLOAT_DAYS    => 7,
};

# Public interface
# -----------------------------------------------------------------------

# status($class, $task_href, $today_dt, %opts) → one of:
#   'inactive' | 'due' | 'overdue' | 'upcoming' | 'not_relevant'
#
# opts:
#   last_completed_dt  => DateTime or undef  (most recent completion)
#   upcoming_horizon   => integer days        (default 7)
#   medium_float_days  => integer             (default 3)

sub status {
    my ($class, $task, $today, %opts) = @_;

    return 'inactive' unless $task->{active};

    my $horizon     = $opts{upcoming_horizon}  // UPCOMING_HORIZON;
    my $medium_days = $opts{medium_float_days} // MEDIUM_FLOAT_DAYS;
    my $last_comp   = $opts{last_completed_dt};
    my $tc          = $task->{class} // croak "task has no class";

    return _monthly_date   ($task, $today, $last_comp, $horizon) if $tc eq 'monthly_date';
    return _monthly_weekday($task, $today, $last_comp, $horizon) if $tc eq 'monthly_weekday';
    return _every_n_period ($task, $today, $last_comp, $horizon) if $tc eq 'every_n_period';
    return _interval       ($task, $today, $last_comp, $horizon) if $tc eq 'interval';
    return _floating       ($task, $today, $medium_days)         if $tc eq 'floating';
    croak "Unknown task class: $tc";
}

# next_due_date($class, $task_href, $today_dt, %opts) → DateTime or undef
# TODO: implement when needed by Digest/commands
sub next_due_date { undef }

# -----------------------------------------------------------------------
# Per-class handlers
# -----------------------------------------------------------------------

sub _monthly_date {
    my ($task, $today, $last_comp, $horizon) = @_;
    my $dom     = $task->{day_of_month};
    my $created = _created_date($task);

    my $this_occ = _dom_in_month($dom, $today->year, $today->month);

    # curr_occ: most recent occurrence on or before today
    # next_occ: the one after that
    my ($curr_occ, $next_occ);
    if (_cmp($this_occ, $today) <= 0) {
        $curr_occ = $this_occ;
        my $nm = $today->clone->add(months => 1);
        $next_occ = _dom_in_month($dom, $nm->year, $nm->month);
    } else {
        my $pm = $today->clone->subtract(months => 1);
        $curr_occ = _dom_in_month($dom, $pm->year, $pm->month);
        $next_occ = $this_occ;
    }

    # Pre-creation occurrences carry no obligation
    my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
    my $completed    = $pre_creation
                    || ($last_comp && _cmp($last_comp, $curr_occ) >= 0);

    unless ($completed) {
        return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
    }
    return _from_next($next_occ, $today, $horizon);
}

sub _monthly_weekday {
    my ($task, $today, $last_comp, $horizon) = @_;
    my ($weekday, $ordinal) = ($task->{weekday}, $task->{ordinal});
    my $created = _created_date($task);

    my $this_occ = _nth_weekday($today->year, $today->month, $weekday, $ordinal);

    my ($curr_occ, $next_occ);
    if (_cmp($this_occ, $today) <= 0) {
        $curr_occ = $this_occ;
        my $nm = $today->clone->add(months => 1);
        $next_occ = _nth_weekday($nm->year, $nm->month, $weekday, $ordinal);
    } else {
        my $pm = $today->clone->subtract(months => 1);
        $curr_occ = _nth_weekday($pm->year, $pm->month, $weekday, $ordinal);
        $next_occ = $this_occ;
    }

    my $pre_creation = $created && _cmp($curr_occ, $created) < 0;
    my $completed    = $pre_creation
                    || ($last_comp && _cmp($last_comp, $curr_occ) >= 0);

    unless ($completed) {
        return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
    }
    return _from_next($next_occ, $today, $horizon);
}

sub _every_n_period {
    my ($task, $today, $last_comp, $horizon) = @_;
    my $anchor = _parse_date($task->{anchor_date})
        or croak "every_n_period task missing valid anchor_date";
    my ($n, $unit) = ($task->{interval_n}, $task->{period_unit});

    # Anchor hasn't arrived yet
    if (_cmp($anchor, $today) > 0) {
        return _from_next($anchor, $today, $horizon);
    }

    my $k        = _find_k($anchor, $n, $unit, $today);
    my $curr_occ = _add_period($anchor, $k,     $n, $unit);
    my $next_occ = _add_period($anchor, $k + 1, $n, $unit);

    my $completed = $last_comp && _cmp($last_comp, $curr_occ) >= 0;

    unless ($completed) {
        return _cmp($curr_occ, $today) == 0 ? 'due' : 'overdue';
    }
    return _from_next($next_occ, $today, $horizon);
}

sub _interval {
    my ($task, $today, $last_comp, $horizon) = @_;
    my $interval = $task->{interval_days};

    # Seed: last completion, or created_at (so a new task doesn't scream overdue on day one)
    my $seed = $last_comp
        ? $last_comp->clone->truncate(to => 'day')
        : _created_date($task);

    my $next_due = $seed->clone->add(days => $interval);
    my $days     = _days_diff($today, $next_due);   # positive = future

    return 'overdue'      if $days < 0;
    return 'due'          if $days == 0;
    return 'upcoming'     if $days <= $horizon;
    return 'not_relevant';
}

sub _floating {
    my ($task, $today, $medium_days) = @_;
    my $priority = $task->{priority} // 'medium';

    return 'due' if $priority eq 'high';

    my $created      = _created_date($task);
    my $days_since   = _days_diff($created, $today);
    $days_since      = 0 if $days_since < 0;

    if ($priority eq 'medium') {
        return $days_since % $medium_days == 0 ? 'due' : 'not_relevant';
    }

    if ($priority eq 'low') {
        my $task_id = $task->{id} // 0;
        return ($days_since + $task_id) % LOW_FLOAT_DAYS == 0 ? 'due' : 'not_relevant';
    }

    return 'not_relevant';
}

# -----------------------------------------------------------------------
# Date helpers
# -----------------------------------------------------------------------

# Day-of-month occurrence in a given month, clamped to the last day.
# e.g. _dom_in_month(31, 2026, 6) → Jun 30
sub _dom_in_month {
    my ($dom, $year, $month) = @_;
    my $last = DateTime->last_day_of_month(year => $year, month => $month)->day;
    return DateTime->new(year => $year, month => $month, day => ($dom > $last ? $last : $dom));
}

# Nth weekday of a month.
# weekday: 1=Mon .. 7=Sun (DateTime day_of_week)
# ordinal: 1-4 for first-fourth, -1 for last
sub _nth_weekday {
    my ($year, $month, $weekday, $ordinal) = @_;
    if ($ordinal == -1) {
        my $last = DateTime->last_day_of_month(year => $year, month => $month);
        my $diff = ($last->day_of_week - $weekday) % 7;
        return $last->clone->subtract(days => $diff);
    } else {
        my $first = DateTime->new(year => $year, month => $month, day => 1);
        my $diff  = ($weekday - $first->day_of_week) % 7;
        return $first->clone->add(days => $diff + ($ordinal - 1) * 7);
    }
}

# Advance an anchor by k * (n period_units), with end-of-month clamping for months.
sub _add_period {
    my ($anchor, $k, $n, $unit) = @_;
    return $anchor->clone if $k == 0;
    my $dt = $anchor->clone;
    if    ($unit eq 'day')   { $dt->add(days  => $k * $n) }
    elsif ($unit eq 'week')  { $dt->add(weeks => $k * $n) }
    elsif ($unit eq 'month') { $dt->add(months => $k * $n, end_of_month => 'limit') }
    else                     { croak "Unknown period_unit: $unit" }
    return $dt;
}

# Largest k such that anchor + k*(n units) <= today.
sub _find_k {
    my ($anchor, $n, $unit, $today) = @_;

    if ($unit eq 'day') {
        return int(_days_diff($anchor, $today) / $n);
    }
    if ($unit eq 'week') {
        return int(_days_diff($anchor, $today) / ($n * 7));
    }
    if ($unit eq 'month') {
        # Approximate, then walk to correct value
        my $total_months = ($today->year - $anchor->year) * 12
                         + ($today->month - $anchor->month);
        my $k = int($total_months / $n);
        $k = 0 if $k < 0;

        # Ensure anchor + (k+1)*period > today
        while (1) {
            my $next = _add_period($anchor, $k + 1, $n, $unit);
            last if _cmp($next, $today) > 0;
            $k++;
        }
        # Ensure anchor + k*period <= today
        while ($k > 0) {
            my $curr = _add_period($anchor, $k, $n, $unit);
            last if _cmp($curr, $today) <= 0;
            $k--;
        }
        return $k;
    }
    croak "Unknown period_unit: $unit";
}

# Days from d1 to d2 (positive if d2 is later).
# Uses Julian Day Numbers — safe across DST boundaries (never counts seconds).
sub _days_diff {
    my ($d1, $d2) = @_;
    return int($d2->jd - $d1->jd);
}

# Status based solely on how far away the next occurrence is.
sub _from_next {
    my ($next, $today, $horizon) = @_;
    my $days = _days_diff($today, $next);
    return 'due'          if $days == 0;
    return 'upcoming'     if $days > 0 && $days <= $horizon;
    return 'not_relevant';
}

# Compare two DateTime objects; returns -1, 0, 1.
sub _cmp { DateTime->compare($_[0], $_[1]) }

# Parse an ISO date/datetime string to a day-granular DateTime.
sub _parse_date {
    my ($s) = @_;
    return undef unless defined $s && $s =~ /^(\d{4})-(\d{2})-(\d{2})/;
    return DateTime->new(year => $1+0, month => $2+0, day => $3+0);
}

sub _created_date {
    my ($task) = @_;
    return _parse_date($task->{created_at});
}

1;