#!/usr/bin/perl
# organize.pl
# Copyright (C) 2020 Daniel Beer <dlbeer@gmail.com>
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;

package Day {

sub days_in_month {
    my ($y, $m) = @_;

    die "Invalid year: $y" if $y < 1 or $y > 9999;
    die "Invalid month: $m" if $m < 1 or $m > 12;

    return 30 if $m == 4 || $m == 6 || $m == 9 || $m == 11;

    if ($m == 2) {
	return 29 unless $y % 400;
	return 28 unless $y % 100;
	return 29 unless $y % 4;
	return 28;
    }

    return 31;
}

sub pack_date {
    use integer;
    my ($y, $m, $d) = @_;
    my $when = 0;

    die "Invalid day: $d (month $m, year $y)"
	if $d < 1 or $d > days_in_month($y, $m);

    $y--;
    $m--;
    $d--;

    $when += $y * 365;
    $when += $y / 4;
    $when -= $y / 100;
    $when += $y / 400;

    for (my $i = 0; $i < $m; $i++) {
	$when += days_in_month(($y+1), ($i+1));
    }

    return $when + $d;
}

sub unpack_date {
    use integer;
    my $when = shift;

    # 400-year cycles
    my $y = $when / 146097 * 400;
    $when %= 146097;

    # 100-year cycles
    my $y100 = $when / 36524;
    $y100 = 3 if $y100 > 3;

    $when -= $y100 * 36524;
    $y += $y100 * 100;

    # 4-year cycles
    $y += $when / 1461 * 4;
    $when %= 1461;

    # Whole years
    my $y1 = $when / 365;
    $y1 = 3 if $y1 > 3;

    $when -= $y1 * 365;
    $y += $y1;
    $y++;

    # Figure out what month it is
    my $m = 1;

    while ($when >= days_in_month $y, $m) {
	$when -= days_in_month $y, $m;
	$m++;
    }

    my $d = $when + 1;
    return ($y, $m, $d);
}

my @mnames = (
    "Jan", "Feb", "Mar",
    "Apr", "May", "Jun",
    "Jul", "Aug", "Sep",
    "Oct", "Nov", "Dec"
);

my @downames = ("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun");

sub parse_date {
    my $text = shift;

    # Try ISO 8601
    my @isoparts = split /-/, $text;
    return pack_date @isoparts if @isoparts == 3;

    # Otherwise, day month year
    my @parts = split /[\/ ]/, $text;
    die "Invalid date: $text" if @parts != 3;

    # Parse common month names
    my ($d, $m, $y) = @parts;

    for (my $i = 0; $i < @mnames; $i++) {
	$m = $i+1 if lc(substr($m, 0, 3)) eq lc($mnames[$i]);
    }

    return pack_date $y, $m, $d;
}

sub print_date {
    my $when = shift;
    my ($y, $m, $d) = unpack_date $when;
    my $mn = $mnames[$m - 1];
    my $dn = $downames[$when % 7];

    return sprintf("$dn %2d $mn $y", $d);
}

sub today {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    return pack_date($year+1900, $mon+1, $mday);
}

sub print_reldays_abs {
    my $r = shift;
    my $wks = "";

    if ($r >= 7) {
	use integer;
	$wks = ($r / 7) . "wk";
	$r %= 7;
    }

    return $wks . "${r}d";
}

sub print_reldays {
    my $r = shift;

    return "today" if $r == 0;
    return "yesterday" if $r == -1;
    return "tomorrow" if $r == 1;

    return print_reldays_abs(-$r) . " ago" if $r < 0;

    return "in " . print_reldays_abs($r);
}

}

package Multitree {

use Text::Tabs;

sub path_combine {
    my ($a, $b) = @_;

    $a =~ s/\/+/\//g;
    $b =~ s/\/+/\//g;

    return $b if $b =~ /^\//;

    my @a = split /\//, $a;
    my @b = split /\//, $b;

    pop @a;
    for my $c (@b) {
	next if $c eq '.';
	if ($c eq '..' && @a) {
	    pop @a unless @a == 1 && $a[0] eq '';
	} else {
	    push @a, $c
	}
    }

    return join '/', @a;
}

sub read_line_tree {
    my $path = shift;

    # Read lines of text, parsing indentation
    my @lines;
    open my $fh, '<', $path or die "Can't open $path: $!";
    while (<$fh>) {
	chomp;
	my $text = expand $_;
	$text =~ s/\r//g;
	$text =~ s/ *$//;

	if ($text =~ /( *)([^ ].*$)/) {
	    my $level = length($1);
	    my $line = $2;
	    my $bullet;

	    # Bullets
	    if ($line =~ /^[-*] /) {
		$bullet = substr($line, 0, 1);
		$line = substr($line, 2);
		$level += 2;
	    }

	    push @lines, {Level => $level, Bullet => $bullet, Text => $line};
	} else {
	    push @lines, {Level => 0, Text => ""};
	}
    }
    close $fh;

    # Mark headings
    my @new_lines;

    for my $line (@lines) {
	if ($line->{Text} =~ /^[-=#]+$/) {
	    $new_lines[$#new_lines]->{Heading} = substr($line->{Text}, 0, 1)
		if @new_lines && $new_lines[$#new_lines]->{Text} ne "";
	} else {
	    push @new_lines, $line;
	}
    }

    @lines = @new_lines;

    # Assign levels to headings
    my $top_level = -3;

    for my $line (@lines) {
	$top_level = -1 if ($line->{Heading} // '') eq '-';
	$top_level = -2 if ($line->{Heading} // '') eq '=';
	$line->{Level} = $top_level
	    if $line->{Level} == 0 && $line->{Text} ne "";
    }

    # Assign levels to blank lines
    my $level = 0;

    for my $line (@lines) {
	$level = $line->{Level} if $line->{Text} ne "";
	$line->{Level} = $level if $line->{Text} eq "";
    }

    # Group into tree. Each tree node is an array of items. Each item is
    # either a hashref line object, or an array of other items.
    my @stack = ([]);
    my @levels = (-3);

    for my $line (@lines) {
	while ($levels[$#levels] > $line->{Level}) {
	    pop @stack;
	    pop @levels;
	}

	# Pop item if we're starting a new one at the same level
	if ((defined($line->{Bullet}) || defined($line->{Heading})) &&
		$levels[$#levels] == $line->{Level}) {
	    pop @stack;
	    pop @levels;
	}

	# Start new item if necessary
	unless ($levels[$#levels] == $line->{Level}) {
	    my $new_item = [];

	    push @{$stack[$#stack]}, $new_item if @stack;
	    push @stack, $new_item;
	    push @levels, $line->{Level};
	}

	# Add to item
	push @{$stack[$#stack]}, $line->{Text};
    }

    return $stack[0];
}

# Multi-file trees with INCLUDE directives

my %visited_files;

sub read_multitree;

sub expand_inclusions {
    my ($fn, $node) = @_;
    my @out;

    for my $line (@$node) {
	if (ref($line)) {
	    push @out, expand_inclusions($fn, $line);
	} elsif ($line =~ /^INCLUDE (.*)$/) {
	    my $subtree = visit_multitree(path_combine($fn, $1));
	    for my $l (@$subtree) {
		push @out, $l;
	    }
	} else {
	    push @out, $line;
	}
    }

    return \@out;
}

sub visit_multitree {
    my $fn = shift;
    die "Recursive file reference: $fn" if $visited_files{$fn};
    $visited_files{$fn} = 1;

    return expand_inclusions($fn, read_line_tree($fn));
}

sub read_multitree {
    %visited_files = ();
    visit_multitree @_;
}

}

package Org {

use Data::Dumper;

sub process_cost {
    my $n = shift;

    for my $c (@{$n->{Children}}) {
	process_cost($c);
	$n->{CostTodo} += $c->{CostTodo} // 0;
	$n->{Cost} += $c->{Cost} // 0;
    }

    $n->{CostTodo} = ($n->{Cost} // 0) if $n->{Todo};
}

sub max_priority {
    my ($best, $n) = @_;
    my $p = $n->{Priority};

    $best = $p if defined $p && (!defined $best || $p > $best);

    for my $c (@{$n->{Children}}) {
	next if $c->{Project};
	$best = max_priority($best, $c);
    }

    return $best;
}

sub set_priorities {
    my ($p, $n) = @_;

    $n->{ProjectPriority} = $p;

    for my $c (@{$n->{Children}}) {
	if ($c->{Project}) {
	    prioritize_project($c);
	} else {
	    set_priorities($p, $c);
	}
    }
}

sub prioritize_project {
    my $n = shift;
    my $p = max_priority undef, $n;

    set_priorities $p, $n;
}

sub inherit_priorities {
    my ($p, $n) = @_;

    $p = $n->{Priority} // $p;
    $n->{Priority} = $p;
    for my $c (@{$n->{Children}}) {
	inherit_priorities($p, $c);
    }
}

sub preprocess {
    my $n = shift;

    process_cost $n;
    prioritize_project $n;
    inherit_priorities undef, $n;
}

sub parse_nodes {
    my $r = shift;
    my @lines;
    my @children;
    my %out;

    for my $l (@$r) {
	if (ref $l) {
	    push @children, parse_nodes($l);
	    next;
	}

	if ($l =~ /^TODO *(.*)$/) {
	    $out{Todo} = 1;
	    $l = $1;
	    next unless defined $l;
	}

	if ($l =~ /^PROJECT *(.*)$/) {
	    $out{Project} = 1;
	    next unless defined $l;
	}

	if ($l =~ /^DATE *(.*)$/) {
	    $out{Date} = Day::parse_date $1;
	    next;
	}

	if ($l =~ /^PRIORITY *(.*)$/) {
	    $out{Priority} = $1;
	    next;
	}

	push @lines, $l;
    }

    push @lines, '' unless @lines;
    $out{Title} = $lines[0];
    $out{Lines} = \@lines;
    $out{Children} = \@children;

    if ($out{Title} =~ /^\[([0-9\.]+)\] *(.*)$/) {
	$out{Title} = $2;
	$out{Cost} = $1;
    }

    return \%out;
}

sub filter_nodes {
    my $cutoff = $_[0];
    my $prioritize = $_[1];
    my %n = %{$_[2]};
    my @filtered_children;
    my $match = 0;

    $match = 1 if defined $n{Date} && $n{Date} < $cutoff;

    if (defined($n{Todo})) {
	if (defined $prioritize && defined $n{ProjectPriority}) {
	    $match = 1 if ($n{Priority} // 0) + $prioritize > $n{ProjectPriority}
	} else {
	    $match = 1
	}
    }

    for my $c (@{$n{Children}}) {
	my $cf = filter_nodes($cutoff, $prioritize, $c);
	push @filtered_children, $cf if defined $cf;
    }

    $n{Children} = \@filtered_children;
    $n{Keep} = $match;

    $match = 1 if @filtered_children;

    return $match ? \%n : undef;
}

sub squash_tree {
    my %n = %{$_[0]};
    my @filtered_children;

    for my $c (@{$n{Children}}) {
	push @filtered_children, squash_tree($c);
    }

    $n{Children} = \@filtered_children;

    # Squash this node if we can
    if (@filtered_children == 1 && !$n{Keep}) {
	my $context = $n{Title};
	$context .= ": " if length($context) > 0;
	%n = %{$filtered_children[0]};
	$n{Title} = $context . $n{Title};
    }

    return \%n;
}

sub sort_by_date {
    my $n = shift;

    for my $c (@{$n->{Children}}) {
	sort_by_date($c);
    }

    my @c = sort { ($a->{SortKey} // 0) <=> ($b->{SortKey} // 0) }
	@{$n->{Children}};
    $n->{Children} = \@c;

    my $k = $n->{Date};

    foreach my $c (@c) {
	next unless defined $c->{SortKey};
	$k = $c->{SortKey} if !defined($k) || $k > $c->{SortKey};
    }

    $n->{SortKey} = $k;
}

sub print_todo {
    my ($today, $level, $n, $printer) = @_;
    my $title = $n->{Title};
    my $cost_value = $n->{CostTodo} // 0;
    my $cost = "";
    my $when = "";
    my $bullet = "-";
    my $indent = ' ' x ($level * 2);

    $bullet = "\x1b[1;31m*\x1b[0m" if defined $n->{Todo};
    $title = "\x1b[1;33m$title\x1b[0m" unless $n->{Keep};
    $cost = "[\x1b[1;34m$cost_value\x1b[0m] " if $cost_value;

    if ($n->{Date}) {
	my $r = $n->{Date} - $today;
	my $rel = Day::print_reldays $r;

	$rel = "\x1b[1;31m$rel\x1b[0;36m" if $r <= 0;

	my $day = Day::print_date $n->{Date};
	$when = "\x1b[36m[\x1b[1m$day\x1b[0;36m ($rel)]\x1b[0m ";
    }

    if ($n->{Keep} || $n->{Title} ne '') {
	$printer->("${indent}${bullet} ${cost}${when}${title}");
	$level++;
    }

    for my $c (@{$n->{Children}}) {
	print_todo($today, $level, $c, $printer);
    }
}

sub walk_for_planner {
    my $planner = shift;
    my $n = shift;

    for my $c (@{$n->{Children}}) {
	walk_for_planner($planner, $c);
    }

    my $date = $n->{Date};
    push @{$planner->{$date}}, $n
      if defined $date && defined $n->{Keep};
}

sub print_planner {
    my $tree = shift;
    my $today = shift;
    my $cutoff = shift;
    my $printer = shift;

    my %planner;

    walk_for_planner \%planner, $tree;

    for (my $i = 0; $i < $cutoff; $i++) {
	my $day = $today + $i;
	my $dt = Day::print_date $day;
	my $color = ($day % 7 >= 5) ? "33" : "36";

	$printer->("") if $i && !($day % 7);

	$printer->("\x1b[${color}m\x{2015}\x{2015}\x{2015}" .
		"[ \x1b[1m$dt\x1b[0;${color}m ]" .
		("\x{2015}" x 55) . "\x1b[0m");
	next unless exists $planner{$day};
	for my $n (@{$planner{$day}}) {
	    my $bullet = "-";
	    my $title = $n->{Title};

	    $bullet = "\x1b[1m*\x1b[0m" if defined $n->{Todo};
	    $printer->("$bullet $title");
	}
    }
}

# Preprocess an organizer tree with the given cutoff
sub fss {
    my ($cutoff, $prioritize, $n) = @_;

    $n = Org::filter_nodes $cutoff, $prioritize, $n;
    $n = {Title => '', Children => []} unless defined $n;
    $n = Org::squash_tree $n;
    Org::sort_by_date $n;

    return $n;
}

}

package main;

use Getopt::Long;

my $flag_version;
my $flag_help;
my $horizon = 14;
my $agenda = 7;
my $flag_no_color;
my $prioritize;

sub my_print {
    my $text = shift;
    $text =~ s/\x1b\[[0-9;]*m//g if $flag_no_color;
    print "$text\n";
}

binmode STDOUT, ":utf8";

GetOptions("version"	  => \$flag_version,
	   "help"	  => \$flag_help,
	   "horizon=i"	  => \$horizon,
	   "agenda=i"	  => \$agenda,
	   "prioritize=i" => \$prioritize,
	   "no-color"	  => \$flag_no_color);

if ($flag_help) {
    print qq{Usage: $0 [options] [<file1> ...]

Options may be any of:
  --help         Show this text.
  --version      Print version and exit.

  --horizon <H>     Set horizon, in days.
  --agenda <A>      Set agenda length, in days.
  --no-color        Do not use colour codes.
  --prioritize <P>  Prune to <P> levels of priority within each project.
};
    exit 0;
}

if ($flag_version) {
    print "organize.pl version 2022-01-03\n";
    print "Copyright (C) 2020-2022 Daniel Beer <dlbeer\@gmail.com>\n";
    exit 0;
}

die "Invalid horizon" if $horizon < 0;
die "Invalid agenda" if $agenda < 0;

my $today = Day::today;

die "You must specify at least one input file" unless @ARGV;
my @n = map { Org::parse_nodes(Multitree::read_multitree($_)) } @ARGV;
my $raw = { Title => '', Children => \@n };
Org::preprocess $raw;

Org::print_todo $today, 0, Org::fss($today + $horizon,
	$prioritize, $raw), \&my_print;
print "\n";
Org::print_planner Org::fss($today + $agenda,
	undef, $raw), $today, $agenda, \&my_print;