ListParser.pm

package ListParser;

use strict;
use warnings;

sub parse_mapping {
	my ($input) = @_;
	my ($key, $value);
	my $i = 0;
	my ($string_start, $string_end);
	$string_start = $string_end = undef;

	# Are we currently lexing inside a string literal?
	my $is_string = 0;

	# Currently parsing key or value?
	my $is_key = 1;

	while ($i < length($input)) {
		my $c = substr($input, $i, 1);
		my $lookahead = substr($input, $i+1, 1);

		if ($is_string and $c eq "'") {
			$is_string = 0;
			$string_end = $i;
			if (not $is_key) {
				$value = substr($input, $string_start, $string_end - $string_start);
			}
			$i++;
			next;
		}
		if (not $is_string) {
			if ($c =~ /\s/) {
				# allow whitespace
			} elsif ($c eq "'") {
				return { error => "Key/value must consist of single string",
				         column_start => $string_start,
				         column_end => $i } if defined $string_end;
				$is_string = 1;
				$string_start = $i + 1;
			} elsif ($c eq "=") {
				return { error => "Expected > after =, got $lookahead",
				         column_start => $i + 1,
				         column_end => $i + 1 } unless $lookahead eq ">";
				return { error => "Unexpected '=>'.",
				         column_start => $i,
				         column_end => $i} unless $is_key;
				$i++;

				$key = substr($input, $string_start, $string_end - $string_start);
				$string_start = $string_end = undef;
				$is_key = 0;
			} else {
				return { error => "Unexpected $c",
				         column_start => $i,
				         column_end => $i };
			}
		}
		$i++;
	}

	return { column_start => $i,
	         column_end => $i,
	         key => $key,
	         value => $value };
}

sub parse_list {
	my ($input, $is_hash) = @_;
	my $c_start = $is_hash ? "{" : "[";
	my $c_end   = $is_hash ? "}" : "]";
	my %h_res;
	my %mapping;
	my @a_res;
	my $i = 0;

	# Index of the start of the current item
	my $item_i = 0;

	# Level of nested lists, 1 being the minimum
	my $nest = 1;

	return { error => "Error: expected $c_start",
	         column_start => $i,
	         column_end => $i } unless substr($input, $i, 1) eq $c_start;

	$i++;
	$item_i = $i;

	while ($nest != 0 && $i < length($input)) {
		my $c = substr($input, $i, 1);

		if ($c eq "\\") {
			substr($input, $i, 1) = "";
			$i++;
		} elsif ($c eq $c_start) {
			$nest++;
		} elsif ($c eq $c_end) {
			$nest--;
		}

		if (($nest == 1 and $c eq ",") || ($nest == 0 and $c eq $c_end)) {
			my $item = substr($input, $item_i, $i - $item_i);
			$item =~ s/^\s+|\s+$//g;
			if ($is_hash) {
				my $mapping = parse_mapping($item);
				$mapping{column_start} += $item_i;
				$mapping{column_end} += $item_i;
				return $mapping if $mapping->{error};
				return { error => "Error: duplicate key \"$mapping->{key}\"",
				         column_start => $item_i,
				         column_end => $mapping->{column_end} } if grep {$_ eq $mapping->{key}} (keys %h_res);
				$h_res{$mapping->{key}} = $mapping->{value};
			} else {
				push @a_res, $item;
			}
			$item_i = $i+1;
		}
		$i++;
	}

	return { error => "Error: expected $c_end, got end of line",
	         column_start => $i,
	         column_end => $i } unless $nest == 0;

	if ($i != length($input)) {
		return { error => "Error: unexpected item in the bagging area (after '$c_end')",
		         column_start => $i,
		         column_end => $i };
	}

	return { hash => \%h_res } if $is_hash;
	return { array => \@a_res };
}
1;