use v6;

constant u8 = uint8;
constant u16 = uint16;
constant u32 = uint32;
constant u64 = uint64;

constant i8 = int8;
constant i16 = int16;
constant i32 = int32;
constant i64 = int64;

constant f32 = num32;
constant f64 = num64;

# byte
# uint
# int
# num
# str


my SetHash $attr-is-no-serialize; BEGIN { $attr-is-no-serialize = SetHash.new; }
multi sub trait_mod:<is>(Attribute $a, :$no-serialize) {
    $attr-is-no-serialize{$a.WHICH.Str} = True;
}
sub attr-is-no-serialize(Attribute $a --> Bool) { $attr-is-no-serialize{$a.WHICH.Str} }


use NativeCall;
# @Optimize
sub f64-as-u64(f64 $x) { nativecast(CArray[u64], CArray[f64].new($x))[0] }
sub u64-as-f64(u64 $x) { nativecast(CArray[f64], CArray[u64].new($x))[0] }
sub f32-as-u32(f32 $x) { nativecast(CArray[u32], CArray[f32].new($x))[0] }
sub u32-as-f32(u32 $x) { nativecast(CArray[f32], CArray[u32].new($x))[0] }


sub MAIN() {
    class Foo {}
    class Foo_0x01 is Foo {
        our $version = 0x01;

        # has u64 $.bar = 0x11_22_33_44_55_66_77_88;
        # has Int $.baz is no-serialize = 1;
        has Str $.qux = 'ABCD';
    }
    class Foo_0x02 is Foo {
        our $version = 0x02;

        # has u64 $.bar = 0x11_22_33_44_55_66_77_88;
        # has Int $.baz is no-serialize = 1;
        # has Str $.qux = 'QUX';
        has f32 $.float = 1.0e0;
        has Str $.qux = 'ABCD';
        # has u8 @.array = 0xAA, 0xBB, 0xCC, 0xDD;
    }
    class FooLatest is Foo_0x01 {}

    constant Write-File = True;

    if Write-File {
        my buf8 $buf .= new;

        write-type($buf, FooLatest.new);
        # write-type($buf, FooLatest.new(qux => 'WXYZ'));
        # my Foo $custom = FooLatest.new(
        #     :bar(0xFF), :qux('QUX'),
        #     :float(2.0e0),
        #     :array(0x44, 0x33, 0x22, 0x11)
        # );
        # write-type($buf, $custom);

        'my-file.bin'.IO.spurt($buf, :bin);
        return;
    }

    # read file

    my buf8 $buf = 'my-file.bin'.IO.slurp(:bin);

    my u64 $offset = 0;
    my Foo $foo = read-type($buf, FooLatest, $offset);
    # my Foo $bar = read-type($buf, FooLatest, $offset);
    # my Foo $baz = read-type($buf, FooLatest, $offset);

    say $foo;
    # say $bar;
    # say $baz;
}

sub write-type(buf8 $b, Any:D $x) {
    my Any $ty = $x.WHAT;

    my $version = $x.^parents()[0].WHO.{'$version'};
    if defined($version) {
        write-u8($b, $version);
    }

    for $ty.^attributes -> $attr {
        next if attr-is-no-serialize($attr);

        given $attr.type {

        when u64 { write-u64($b, $attr.get_value($x)); }
        when u32 { write-u32($b, $attr.get_value($x)); }
        when u16 { write-u16($b, $attr.get_value($x)); }
        when u8 { write-u8($b, $attr.get_value($x)); }

        when i64 { write-i64($b, $attr.get_value($x)); }
        when i32 { write-i32($b, $attr.get_value($x)); }
        when i16 { write-i16($b, $attr.get_value($x)); }
        when i8 { write-i8($b, $attr.get_value($x)); }

        when f64 { write-f64($b, $attr.get_value($x)); }
        when f32 { write-f32($b, $attr.get_value($x)); }

        when Int { write-Int($b, $attr.get_value($x)); }
        when Str { write-Str($b, $attr.get_value($x)); }

        # when Array | array {
        when Positional {
            my $array_of = $attr.type.of;
            my $array = $attr.get_value($x);
            write-array($b, $array_of, $array);
        }

        default { fail 'write-type: unsupported type: ' ~ $_.^name; }
        }
    }
}

sub read-type(buf8 $b, Any:U $ty is copy, u64 $offset is rw --> Any) {
    my Any $result;

    my $type_version = $ty.^parents()[0].WHO.{'$version'};

    my Str $ty_name;
    if defined($type_version) {
        my u8 $version = read-u8($b, $offset);

        if $version > $type_version {
            fail "found version $version but {$ty.^name} is only at version $type_version";
        }

        $ty_name = substr($ty.^name, 0, *-6); # FooLatest => Foo
        $ty_name = "{$ty_name}_{sprintf('0x%02X', $version)}"; # Foo_0x02
    }

    if $ty_name.defined {
        use MONKEY-SEE-NO-EVAL;
        $ty = EVAL($ty_name);
    }

    $result = $ty.CREATE;

    for $ty.^attributes -> $attr {
        next if attr-is-no-serialize($attr);

        given $attr.type {

        when u64 { $attr.set_value($result, read-u64($b, $offset)); }
        when u32 { $attr.set_value($result, read-u32($b, $offset)); }
        when u16 { $attr.set_value($result, read-u16($b, $offset)); }
        when u8 { $attr.set_value($result, read-u8($b, $offset)); }

        when i64 { $attr.set_value($result, read-i64($b, $offset)); }
        when i32 { $attr.set_value($result, read-i32($b, $offset)); }
        when i16 { $attr.set_value($result, read-i16($b, $offset)); }
        when i8 { $attr.set_value($result, read-i8($b, $offset)); }

        when f64 { $attr.set_value($result, read-f64($b, $offset)); }
        when f32 { $attr.set_value($result, read-f32($b, $offset)); }

        when Int { $attr.set_value($result, read-Int($b, $offset)); }
        when Str { $attr.set_value($result, read-Str($b, $offset)); }

        # when Array | array {
        when Positional {
            my $array_of = $attr.type.of;
            $attr.set_value($result, read-array($b, $array_of, $offset));
        }

        default { fail 'read-type: unsupported type: ' ~ $_.^name; }
        }
    }

    $result
}

sub write-array(buf8 $b, Any:U $ty, @array) {
    write-u32($b, @array.elems);

    given $ty {
    when u64 { for @array ->$e { write-u64($b, $e); } }
    when u32 { for @array ->$e { write-u32($b, $e); } }
    when u16 { for @array ->$e { write-u16($b, $e); } }
    when u8 { for @array ->$e { write-u8($b, $e); } }

    when i64 { for @array ->$e { write-i64($b, $e); } }
    when i32 { for @array ->$e { write-i32($b, $e); } }
    when i16 { for @array ->$e { write-i16($b, $e); } }
    when i8 { for @array ->$e { write-i8($b, $e); } }

    when f64 { for @array -> $e { write-f64($b, $e); } }
    when f32 { for @array -> $e { write-f32($b, $e); } }

    when Int { for @array ->$e { write-Int($b, $e); } }
    when Str { for @array ->$e { write-Str($b, $e); } }

    default { fail 'write-array: unsupported type: ' ~ $ty.^name; }
    }
}

sub read-array(buf8 $b, Any:U $ty, u64 $offset is rw) {
    my @result;

    my $elems = read-u32($b, $offset);
    given $ty {
    when u64 { for 1 .. $elems { @result.push: read-u64($b, $offset); } }
    when u32 { for 1 .. $elems { @result.push: read-u32($b, $offset); } }
    when u16 { for 1 .. $elems  { @result.push: read-u16($b, $offset); } }
    when u8 { for 1 .. $elems  { @result.push: read-u8($b, $offset); } }

    when i64 { for 1 .. $elems { @result.push: read-i64($b, $offset); } }
    when i32 { for 1 .. $elems { @result.push: read-i32($b, $offset); } }
    when i16 { for 1 .. $elems { @result.push: read-i16($b, $offset); } }
    when i8 { for 1 .. $elems { @result.push: read-i8($b, $offset); } }

    when i64 { for 1 .. $elems { @result.push: read-f64($b, $offset); } }
    when i32 { for 1 .. $elems { @result.push: read-f32($b, $offset); } }

    when Int { for 1 .. $elems { @result.push: read-Int($b, $offset); } }
    when Str { for 1 .. $elems { @result.push: read-Str($b, $offset); } }

    default { fail 'read-array: unsupported type: ' ~ $ty.^name; }
    }

    @result
}

sub write-u64(buf8 $b, u64 $x) {
    $b.push: ($x +& 0xFF_00_00_00_00_00_00_00) +> 0d56;
    $b.push: ($x +& 0x00_FF_00_00_00_00_00_00) +> 0d48;
    $b.push: ($x +& 0x00_00_FF_00_00_00_00_00) +> 0d40;
    $b.push: ($x +& 0x00_00_00_FF_00_00_00_00) +> 0d32;
    $b.push: ($x +& 0x00_00_00_00_FF_00_00_00) +> 0d24;
    $b.push: ($x +& 0x00_00_00_00_00_FF_00_00) +> 0d16;
    $b.push: ($x +& 0x00_00_00_00_00_00_FF_00) +> 0d08;
    $b.push: ($x +& 0x00_00_00_00_00_00_00_FF) +> 0d00;
}
sub write-u32(buf8 $b, u32 $x) {
    $b.push: ($x +& 0xFF_00_00_00) +> 0d24;
    $b.push: ($x +& 0x00_FF_00_00) +> 0d16;
    $b.push: ($x +& 0x00_00_FF_00) +> 0d08;
    $b.push: ($x +& 0x00_00_00_FF) +> 0d00;
}
sub write-u16(buf8 $b, u16 $x) {
    $b.push: ($x +& 0xFF_00) +> 0d08;
    $b.push: ($x +& 0x00_FF) +> 0d00;
}
sub write-u8(buf8 $b, u8 $x) {
    $b.push: $x;
}

sub write-i64(buf8 $b, i64 $x) { write-u64($b, $x); }
sub write-i32(buf8 $b, i32 $x) { write-u32($b, $x); }
sub write-i16(buf8 $b, i16 $x) { write-u16($b, $x); }
sub write-i8(buf8 $b, i8 $x) { write-u8($b, $x); }

sub write-Int(buf8 $b, Int $x) {
    my u64 $y = $x +& 0xFFFF_FFFF_FFFF_FFFF;
    write-u64($b, $y);
}

sub write-Str(buf8 $b, Str $s) {
    my utf8 $utf8 = $s.encode('UTF-8');
    write-u32($b, $utf8.bytes);
    $b.push($utf8);
}

sub write-f64(buf8 $b, f64 $x) { write-u64($b, f64-as-u64($x)); }
sub write-f32(buf8 $b, f32 $x) { write-u32($b, f32-as-u32($x)); }

sub read-u64(buf8 $b, u64 $offset is rw --> u64) {
    my u64 $result = 0
        +| $b[$offset++] +< 0d56
        +| $b[$offset++] +< 0d48
        +| $b[$offset++] +< 0d40
        +| $b[$offset++] +< 0d32
        +| $b[$offset++] +< 0d24
        +| $b[$offset++] +< 0d16
        +| $b[$offset++] +< 0d08
        +| $b[$offset++] +< 0d00
        ;
    $result
}
sub read-u32(buf8 $b, u64 $offset is rw --> u32)  {
    my u32 $result = 0
        +| $b[$offset++] +< 0d24
        +| $b[$offset++] +< 0d16
        +| $b[$offset++] +< 0d08
        +| $b[$offset++] +< 0d00
        ;
    $result
}
sub read-u16(buf8 $b, u64 $offset is rw --> u16)  {
    my u16 $result = 0
        +| $b[$offset++] +< 0d08
        +| $b[$offset++] +< 0d00
        ;
    $result
}
sub read-u8(buf8 $b, u64 $offset is rw --> u8)  {
    my u8 $result = $b[$offset++];
    $result
}

sub read-i64(buf8 $b, u64 $offset is rw --> i64) { read-u64($b, $offset) }
sub read-i32(buf8 $b, u64 $offset is rw --> i32) { read-u32($b, $offset) }
sub read-i16(buf8 $b, u64 $offset is rw --> i16) { read-u16($b, $offset) }
sub read-i8(buf8 $b, u64 $offset is rw --> i8) { read-u8($b, $offset) }

sub read-f64(buf8 $b, u64 $offset is rw --> f64) { u64-as-f64(read-u64($b, $offset)) }
sub read-f32(buf8 $b, u64 $offset is rw --> f32) { u32-as-f32(read-u32($b, $offset)) }

sub read-Int(buf8 $b, u64 $offset is rw --> Int) {
    my Int $result = read-u64($b, $offset);
    $result
}

sub read-Str(buf8 $b, u64 $offset is rw --> Str) {
    my $byte_len = read-u32($b, $offset);
    my Str $result = $b.subbuf($offset, $byte_len).decode('UTF-8');
    $offset += $byte_len;
    $result
}

=finish