#!/usr/bin/env perl

use strict;
use warnings;
use v5.16;
use Test::More;

###############################################################################
###############################################################################

if (!caller()) {
	run_unit_tests();
}

###############################################################################
###############################################################################

sub run_unit_tests {
	my $str = qq%---
foo: bar
num: 7
colors:
  - red
  - 'blue'
  - "green"
neg: -3
whitespace: ' foobar '
bool: False
roman: [I, 'II', "III", IV]
word: 'bird'
word2: 'eagle'
key.a: aa
key-b: bb
pi: 3.1415
url: http://example.com:8080/x
c:
list: []
nested:
  one:
    two:
      three: donk
# This is a comment
tutorial:
  - yaml:
      name: "YAML Ain't Markup Language"
      type: awesome
      born: 2001
  - json:
      name: JavaScript Object Notation
      type: great
      born: 2001
  - xml:
      name: Extensible Markup Language
      type: good
      born: 1996
%;

	my $x = yaml_parse($str);

	#k($x);

	is($x->{foo}       , 'bar');
	is($x->{num}       , 7);
	is($x->{bool}      , 'False'); # Bool not implemented yet
	is($x->{neg}       , -3);
	is($x->{word}      , 'bird');
	is($x->{word2}     , 'eagle');
	is($x->{whitespace}, ' foobar ');
	is($x->{'key.a'}   , 'aa');
	is($x->{'key-b'}   , 'bb');
	is($x->{'url'}     , 'http://example.com:8080/x');
	is($x->{'pi'}      , '3.1415');

	is($x->{tutorial}[0]{yaml}{type}, 'awesome');
	is($x->{tutorial}[1]{json}{born}, 2001);
	is($x->{tutorial}[2]{xml}{name} , 'Extensible Markup Language');

	is($x->{nested}->{one}->{two}->{three}, 'donk');

	is_deeply($x->{colors}, ['red', 'blue', 'green']);
	is_deeply($x->{roman} ,  ['I', 'II', 'III', 'IV']);
	is_deeply($x->{nested}, {one => {two => {three => 'donk'}}});
	is_deeply($x->{'list'}, []);
	is_deeply($x->{'c'}   , {}); # Empty value = {}. Known deviation

	done_testing();
};

# Purposely small to facilitate copy/paste
# If you need full YAML parsing use YAML::XS
sub yaml_parse {
	return {} unless defined $_[0] && length $_[0];
	my %data; my $root = \%data; my @st = ([-1, \$root]);
	for my $line (split /\n/, $_[0]) {
		$line =~ s/\r$//;
		next if $line =~ /^\s*(?:$|---\s*$|#)/;
		if ($line =~ /^(\s*)-\s*(.*)$/) {
			my ($n, $v) = (length($1), $2);
			pop @st while $n < $st[-1][0]; my $cur = ${$st[-1][1]};
			die "yaml_parse: array without parent: $line" if @st == 1;
			$cur = ${$st[-1][1]} = [] if ref $cur eq 'HASH' && !%$cur;
			die "yaml_parse: mixed array/hash" if ref $cur ne 'ARRAY';
			$v =~ s/^\s+|\s+$//g; $v =~ s/^(['"])(.*)\1$/$2/s;
			$v += 0 if $v =~ /^-?\d+(?:\.\d+)?$/;
			if ($v =~ /^([\w\-\.\/]+):\s*$/) { push(@$cur, my $el = {$1 => {}}); push(@st, [$n + 2, \$el->{$1}]); next; }
			push(@$cur, $v);
		} elsif ($line =~ /^(\s*)([\w\-\.\/]+)\s*:\s*(.*)$/) {
			my ($n, $key, $v) = (length($1), $2, $3);
			pop @st while $n <= $st[-1][0]; my $cur = ${$st[-1][1]};
			die "yaml_parse: '$key' under array" if ref $cur eq 'ARRAY';
			$v =~ s/\s+$//; $v =~ s/^\s+//; $v =~ s/^(['"])(.*)\1$/$2/s;
			if ($v =~ /^\[(.*)\]$/) {
				my @a = grep { length } map { s/^\s+|\s+$//gr =~ s/^(['"])(.*)\1$/$2/sr } split /,/, $1;
				for (@a) { $_ += 0 if /^-?\d+(?:\.\d+)?$/ } $v = \@a;
			} else { $v += 0 if $v =~ /^-?\d+(?:\.\d+)?$/; }
			if (ref $v or length $v) { $cur->{$key} = $v }
			else { $cur->{$key} = {}; push(@st, [$n, \$cur->{$key}]) }
		} else { warn "yaml_parse: ignoring: $line\n" }
	} return \%data;
}

# Creates methods k() and kd() to print, and print & die respectively
BEGIN {
	if (!defined(&trim)) {
		*trim = sub {
			my ($s) = (@_, $_); # Passed in var, or default to $_
			if (length($s) == 0) { return ""; }
			$s =~ s/^\s*//;
			$s =~ s/\s*$//;

			return $s;
		}
	}

	if (eval { require Dump::Krumo }) {
		Dump::Krumo->import(qw/k kd/);
	} else {
		require Data::Dumper;
		*k  = sub { print Data::Dumper::Dumper(\@_) };
		*kd = sub { print Data::Dumper::Dumper(\@_); die; };
	}
}

# vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4