#!/usr/bin/perl
#
# Copyright © 2013 Jonas Smedegaard <dr@jones.dk>
# Description: render opening hours webpage from RDF data
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use 5.010;
use strictures 1;
use utf8::all;
#use DDP alias => 'Dumper';

use DateTimeX::Easy;
use DateTime::Format::W3CDTF;
use Carp;
use Try::Tiny;
use RDF::Query;
use RDF::TrineX::Functions qw[curie model parse];
use HTML::HTML5::Builder qw[:standard];
use HTML::HTML5::Writer;

# TODO: add options --verbose and --debug

# TODO: add override options --theme and (multivalued) --category
my @category = <<LIST =~ m/(\S.*\S)/g;
	full-meal food
	non-meal food
	<http://schema.org/GroceryStore>
	non-grocery store
	park or museum
	art
	transport
	public service
LIST

# TODO: add override options --from, --through and --theme
#my $globalfrom = DateTimeX::Easy->new('now');
# TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible words "current" and "present" (as alternatives to this)
my $globalfrom = DateTimeX::Easy->new('first day of this month');
# TODO: teach DTX::Easy / DT::F::Natural DT::F::Flexible these:
#  last day of month three months from now
#  last day of month in three months
#  last day of (the) month three months ahead
#  ... in the future
#  ... into the future
#  ... from now
#  ... later <- this last one for changing object, not create new
#my $globalthrough = DateTimeX::Easy->new('last day of month in 3 months');
my $globalthrough = DateTimeX::Easy->new($globalfrom);
$globalthrough->add( months => 4 )->subtract( days => 1 );

# TODO: add Getopt option --preset as shortcut to --category, --from and --through

my $parser = RDF::Trine::Parser::Turtle->new;
my $model = model();

# TODO: throw sensible error if no (non-opt) args provided
while (my $data = shift @ARGV) {
	try {
		parse($data, using => $parser, into => $model);
	} catch {
		say STDERR "Failed to parse file \"$data\": $_";
		die;
	}
}

# compose query for hourspec data at least partly within a "window" of time
# (yes, comparing global dates against opposite spec dates is deliberate)
# TODO: support transit:Schedule (as alternative to gr:hasOpeningHourSpecification)
my $w3c = DateTime::Format::W3CDTF->new;
my $query = qurie( sprintf(<<'SPARQL', $w3c->format_datetime($globalthrough), $w3c->format_datetime($globalfrom) ));
SELECT *
WHERE {
	{
		?location
#			a schema:Place ;
			gr:category ?category ;
			gr:name ?name ;
			gr:hasOpeningHourSpecification ?spec .
		?spec
			gr:opens ?opens ;
			gr:closes ?closes ;
			rdfs:label ?speclabel ;
			gr:validFrom ?specfrom ;
			gr:validThrough ?specthrough .
		OPTIONAL { ?spec rdfs:comment ?speccomment } .
		OPTIONAL { ?location gr:description ?locationcomment } .
		FILTER ( ?specfrom <= "%s"^^xsd:dateTime ) .
		FILTER ( ?specthrough > "%s"^^xsd:dateTime )
	} UNION {
		?location
			gr:category ?category ;
			gr:name ?name ;
			gr:hasOpeningHourSpecification ?spec .
		?spec
			gr:opens ?opens ;
			gr:closes ?closes .
		OPTIONAL {
			?spec
				rdfs:label ?speclabel ;
				gr:validFrom ?specfrom ;
				gr:validThrough ?specthrough .
		} .
		OPTIONAL { ?spec rdfs:comment ?speccomment } .
		OPTIONAL { ?location gr:description ?locationcomment } .
		FILTER (!bound(?specfrom)) .
		FILTER (!bound(?specthrough))
	}
}
SPARQL
# TODO: sort using SPARQL instead of perl
#    ORDER BY ?category ?name ?specfrom ?specthrough ?opens ?closes

my %data;
my $iterator = $query->execute($model);
while ( my $row = $iterator->next ) {
	my $category = $row->{category}->as_string;
	my $name = $row->{name}->literal_value;
	my $locationcomment = $row->{locationcomment} ? $row->{locationcomment}->literal_value : '';

	my $speclabel = $row->{speclabel} ? $row->{speclabel}->literal_value : '';

	# Strip surrounding quotes
	$category =~ s/^"(.*)"$/$1/;

	# merge identically named locations, tying varying descriptions to spec instead
#	my $name_key = titledescribe( $name, $locationcomment );
#	my $specbundle_key = $speclabel;
	my $name_key = $name;
	my $specbundle_key = titledescribe( $speclabel, $locationcomment );

	my $specfrom = $row->{specfrom} ? $row->{specfrom}->datetime : '';
	my $specthrough = $row->{specthrough} ? $row->{specthrough}->datetime : '';

	my $speccomment = $row->{speccomment} ? $row->{speccomment}->literal_value : '';

	# TODO: use DateTime objects instead.
	my $opens = $row->{opens}->literal_value;
	$opens =~ s/:\d\d$//;
	my $closes = $row->{closes}->literal_value;
	$closes =~ s/:\d\d$//;
	$closes =~ s/^23:59/24/;

	my @weekdays;
	my $iterator = $model->get_statements($row->{spec}, curie('gr_hasOpeningHoursDayOfWeek'), undef);
	while (my $statement = $iterator->next) {
		my $label = $statement->object;

		given ($label->as_string) {
			when (/Monday/) { push @weekdays, 1 };
			when (/Tuesday/) { push @weekdays, 2 };
			when (/Wednesday/) { push @weekdays, 3 };
			when (/Thursday/) { push @weekdays, 4 };
			when (/Friday/) { push @weekdays, 5 };
			when (/Saturday/) { push @weekdays, 6 };
			when (/Sunday/) { push @weekdays, 7 };
			when (/PublicHolidays/) { push @weekdays, 8 };
			default { die "failed to parse weekday: ", $label->as_string };
		}
	}
	my $weekdays = join ', ', sort @weekdays;
	$weekdays = 0 unless ($weekdays);
	my $weekdays_key = titledescribe( $weekdays, $speccomment );

	$data{$category}{$name_key}{name} = $name;
	$data{$category}{$name_key}{specbundle}{$specbundle_key}{locationcomment} = $locationcomment;
	$data{$category}{$name_key}{specbundle}{$specbundle_key}{speclabel} = $speclabel;
	$data{$category}{$name_key}{specbundle}{$specbundle_key}{specfrom} = $specfrom;
	$data{$category}{$name_key}{specbundle}{$specbundle_key}{specthrough} = $specthrough;
	$data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{weekdays} = $weekdays;
	# TODO: extend SPARQL to cover specs without opens/closes, or drop below check
	if ($opens and $closes) {
		my $hours_key = $opens;
		$hours_key =~ s/\b(\d)\b/0$1/g;
		my $hourrange = "$opens - $closes";
		$data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{hours}{$hours_key} = $hourrange;
		$data{$category}{$name_key}{specbundle}{$specbundle_key}{spec}{$weekdays_key}{speccomment} = $speccomment;
	}
}

my $title = 'Åbningstider';
my $intro = sprintf(
	'Åbningstider på Orø indenfor udvalgte kategorier, dækkende perioden %s.',
	daterangedescribe($globalfrom, $globalthrough),
);

# TODO: make simplified html (preferred for Scribus) optional
#push my @content, h1($title), "\n", p($intro);
push my @content, h1($title), "\n", $intro;

# TODO: optionally merge items appearing in multiple categories
for my $category ( @category ) {
	push @content, "\n", h2( categorydescribe($category) ), "\n";
	for my $name ( sort keys %{ $data{$category} } ) {
		push @content, "\n", h3($name);
		my @bundle = keys %{ $data{$category}{$name}{specbundle} };
		# FIXME: respect locale when sorting (Galleri before Gaardstronomi)
		for my $specbundle ( sort {
			$data{$category}{$name}{specbundle}{$a}{specfrom}
			<=> $data{$category}{$name}{specbundle}{$b}{specfrom}
			|| $a cmp $b
		} @bundle ) {
			# TODO: when global limits shown, show only speclabel plural spec bundles
			my $speclabel = speclabeldescribe(
				$data{$category}{$name}{specbundle}{$specbundle}{speclabel},
				$data{$category}{$name}{specbundle}{$specbundle}{locationcomment},
				$data{$category}{$name}{specbundle}{$specbundle}{specfrom},
				$data{$category}{$name}{specbundle}{$specbundle}{specthrough},
				scalar @bundle,
			);
			push @content, "\n", h4($speclabel) if ($speclabel);
			my @specbundle;
			for my $weekdays ( sort keys %{ $data{$category}{$name}{specbundle}{$specbundle}{spec} } ) {
				my $specdescription = specdescribe(
					$data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{weekdays},
					$data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{speccomment},
				);
				push @specbundle, br if (@specbundle);
				my @hours;
				for my $hours ( sort keys %{ $data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{hours} } ) {
					# TODO: make simplified html (preferred for Scribus) optional
#					push @hours, br, "\n" if (@hours);
					push @hours, br if (@hours);
					push @hours, "\t", span(
						$data{$category}{$name}{specbundle}{$specbundle}{spec}{$weekdays}{hours}{$hours}
					);
				}
				push @specbundle, "\n", span(
					span($specdescription, ":"), @hours,
				);
			}
			# TODO: make simplified html (preferred for Scribus) optional
#			push @content, p("\n", @specbundle) if (@specbundle);
			push @content, @specbundle if (@specbundle);
		}
	}
}

#Dumper %data;
#die;

my $writer = HTML::HTML5::Writer->new;
say $writer->document( html(
	-lang => 'da',
	head(
		title($title),
		Meta(-charset => 'utf-8'),
	),
	body(
		"\n", @content
	),
));

# create query object from curied SPARQL string
sub qurie {
	my $sparql = shift;
	$sparql =~ s/(?<=\s|\^)([a-z]+):([a-zA-Z]+)(?=\s)/curie("$1_$2")/eg;
	my $query = RDF::Query->new( $sparql );
	if (!$query) {
		say STDERR $sparql;
		say STDERR RDF::Query->error;
		croak "failed to prepare SPARQL query";
	}
	return $query;
}

sub daterangedescribe {
	my ($from, $through) = @_;

	return sprintf( '%s - %s',
		$from->format_cldr('d/M'),
		$through->format_cldr('d/M'),
	);
}

sub categorydescribe {
	my $cat = shift;

	$cat =~ s!full-meal food!spisesteder!;
	$cat =~ s!non-meal food!caféer, slikbutikker o.l.!;
	$cat =~ s!<http://schema.org/GroceryStore>!dagligvarebutikker!;
	$cat =~ s!non-grocery store!øvrige butikker!;
	$cat =~ s!park or museum!parker og museer!;
	$cat =~ s!art!kunstudstillinger og gallerier!;
	$cat =~ s!public service!offentlige services!;

	return ucfirst($cat);
}

sub titledescribe {
	my ($title, $comment) = @_;

	return ($comment) ? "$title ($comment)" : $title;
}

sub speclabeldescribe {
	my ($label, $comment, $from, $through, $size) = @_;

	# TODO: support optionally enabling descriptive label
	my $compact = 1;

	return '' if ( ($compact) and ( $size == 1 ) );

	my $daterange =  daterangedescribe($from, $through);
	if (($from) and ($through)) {
		return titledescribe( $daterange, $comment )
			if ($compact);
		return $label, ' (', $daterange, ' - ', $comment, ')'
			if ($comment);
		return $label, ' (', $daterange, ')';
	}
	warn "gr:validFrom and gr:validThrough missing for label \"$label\"";
	return ($compact) ? '' : titledescribe( $label, $comment );
}

sub specdescribe {
	my ($weekdays, $comment) = @_;

	# TODO: translate properly
	$weekdays =~ s/1, 2, 3, 4, 5, 6, 7/alle ugedage/;
	$weekdays =~ s/1, 2, 3, 4, 5/mandag-fredag/;
	$weekdays =~ s/1, 2, 3, 4/mandag-torsdag/;
	$weekdays =~ s/2, 3, 4, 5, 6, 7/tirsdag-søndag/;
	$weekdays =~ s/2, 3, 4, 5, 6/tirsdag-lørdag/;
	$weekdays =~ s/2, 3, 4, 5/tirsdag-fredag/;
	$weekdays =~ s/3, 4, 5/onsdag-fredag/;
	$weekdays =~ s/^2, 3, 4(|, [^5].*)$/tirsdag-torsdag$1/;
	$weekdays =~ s/^(|.*?[\d^5], |.*?(?!fredag, ))6, 7(.*)$/$1weekend$2/;
	$weekdays =~ s/1/mandag/;
	$weekdays =~ s/2/tirsdag/;
	$weekdays =~ s/3/onsdag/;
	$weekdays =~ s/4/torsdag/;
	$weekdays =~ s/5/fredag/;
	$weekdays =~ s/6/lørdag/;
	$weekdays =~ s/7/søndag/;
	$weekdays =~ s/8/helligdage/;

	if ( $weekdays eq "0" and ($comment) ) {
		return $comment;
	}
	return titledescribe( $weekdays, $comment );
}

1;