#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use open OUT => ':utf8', ':std';
use Data::Dumper;

our $VERSION = '1.03';

# create a hash of desired input
my $di = do 'data/digraphs-rfc.inc.pl'
	or die "error reading digraphs include: ", $@ // $!;

# personal addendums
my @extra;
if (-r 'shiar.inc.txt') {
	open my $include, '<:utf8', 'shiar.inc.txt';
	for (readline $include) {
		m{^(\$?[!"%'-Z_a-z]{2}) (.)} or next;
		warn("$1 already defined"), next if defined $di->{$1};
		$di->{$1} = ord $2;
		push @extra, $1;
	}
}
warn $@ if $@;

$di->{chr $_} = $_ for 32 .. 126;
$di->{'\\'.$_} = delete $di->{$_} for '{', '}', '\\';

# optionally get unicode character information
my %info = eval {
	require Unicode::UCD;
	map {
		$_ => Unicode::UCD::charinfo($di->{$_})
			|| { block => '?', category => 'Xn', name => '', script => '' }
	} keys %{$di};
};

# add custom categories for certain blocks
for (values %info) {
	$_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
	$_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
}

# mark unofficial extras as such
$info{$_}->{category} .= ' Xz' for @extra;

for (keys %{$di}) {
	$info{$_}->{string} = chr(9676) . chr($di->{$_}) if $info{$_}->{combining};
	# find control characters (first 32 chars from 0 and 128)
	next unless ($di->{$_} & ~0b1001_1111) == 0 or $di->{$_} == 127;
	# rename to something more descriptive
	$info{$_}->{name} = $info{$_}->{unicode10}
		? '<'.$info{$_}->{unicode10}.'>'  # the old name was much more useful
		: sprintf('<control U+%04X>', $di->{$_});  # at least identify by value
	# show descriptive symbols instead of control chars themselves
	$info{$_}->{string} = $di->{$_} < 32 ? chr($di->{$_} + 0x2400) : chr(0xFFFD);
}
# presentational string for some control(lish) entries
$info{$_}->{string} = '-' for grep { $di->{$_} == 0x00AD } keys %{$di};
$info{$_}->{string} = '␣' for grep { $di->{$_} == 0x200B } keys %{$di};
$info{$_}->{string} = '|' for grep { $di->{$_} == 0x200C } keys %{$di};
$info{$_}->{string} = '⁀' for grep { $di->{$_} == 0x200D } keys %{$di};
$info{$_}->{string} = '→' for grep { $di->{$_} == 0x200E } keys %{$di};
$info{$_}->{string} = '←' for grep { $di->{$_} == 0x200F } keys %{$di};

# convert info hashes into arrays of strings to output in display order
for my $row (values %info) {
	$row = [ map { $row->{$_} } qw/name category script string/ ];
	# strip off trailing missing values (especially string may be unknown)
	defined $row->[-1] ? last : pop @$row for 1 .. @$row;
}

# output perl code of hash
# (assume no backslashes or curlies, so we can just q{} w/o escaping)
print "# automatically generated by $0\n";
print "use utf8;\n";
print "+{\n";
printf '(map {$_=>0} qw{%s}),'."\n", join(' ',
	map { substr($_, 1, 1).substr($_, 0, 1) } sort keys %{$di}
);
printf "q{%s}=>[%s],\n", $_, join(',',
	$di->{$_},   # original code point
	$info{$_}  # optional additional arguments
		? map {"'$_'"} @{ $info{$_} }
		: ()
) for sort keys %{$di};
print "}\n";

__END__

=head1 NAME

mkdigraphlist - Output character list of combined digraph data

=head1 SYNOPSIS

    mkdigraphlist >digraphs.inc.pl
    perl -e'$di = do "digraphs.inc.pl"; print chr $di->{DO}->[0]'

=head1 DESCRIPTION

Parses the official RFC-1345 document, searching the
'character mnemonic table' for all digraph definitions.
If successful, Perl code is output resulting in a hash
with character data keyed by digraph.
Any errors and warnings are given at STDERR.

The value can either be a scalar string containing another
digraph which can be considered identical (usually inverted),
or an array ref containing at least the resulting character's
Unicode code point value.  If available, the following UCD data
is appended: character name, category, script, and output string.
For example:

 +{
   AE => [198, 'LATIN CAPITAL LETTER AE', 'Lu Xl', 'Latin'],
   EA => 'AE',
  }

=head1 AUTHOR

Mischa POSLAWSKY <perl@shiar.org>

=head1 LICENSE

Licensed under the GNU Affero General Public License version 3.