use XML;
use GPT::Class;
use GPT::DumbGenerator;
use GPT::FileGenerator;
#use OOGenerator;

my $GCC_XML = %*ENV<GPT_GCCXML> || 'gccxml';
my $CASTXML_STD = 'c89';
my $CASTXML = False;

my $gmerge-stypedef;

sub MAIN(
          $header-file #= The header file
         , Bool :$all #= Generate everything
         , Str :$define-enum #= Try to generate enumeration from #define using the given starting pattern
         , Str :$ooc #= Do nothing
         , Bool :$enums #= Generate enumerations
         , Bool :$functions #= Generate functions
         , Bool :$structs #= Generate structures and unions
         , Bool :$externs #= Generate extern declaration
         , Bool :$list-types #= Mostly for debug purpose, list all the C type found
         , Bool :$list-files #= List all the files involved
         , Str :$files #= WIP Allow you to pick from which files you want to generate stuff. eg --files=myheader.h,mysubheader.h.
                       #=
                       #= You can also use file 'id' given by --list-files like   @f1,@f2
                       #=
                       #= You can also exclude file by putting - in front of the file
         , Bool :$merge-stypedef #= Merge a typedef pointing to a struct type to the struct name
         , Str  :$gptfile #= Use the given GPT file to generate a module, all other (gpt) options are ignored
         , Str :$castxml #= allow for gptrixie to use castxml, you need to specificy the C standard
         , *@gccoptions #= remaining options are passed to gccxml. eg -I /path/needed/by/header
         ) {
  if $define-enum.defined and ! $define-enum.index(':').defined {
      die "The define-enum option must be of the form enumname:pattern";
  }
  
  if $gptfile.defined {
    read-gpt-file($gptfile);
    $gmerge-stypedef = %GPT::FileGenerator::conf<merge-struct-typedef>:exists;
    my AllTheThings $att = do-magic($header-file, @gccoptions);
    generate-module($att);
    return 0;
  }
  if $castxml.defined {
    $CASTXML = True;
    $CASTXML_STD = $castxml if $castxml ne '';
  }
  $gmerge-stypedef =  $merge-stypedef;
  my @files = ();
  my @user-excludes = ();
  if $files {
    for $files.split(',') {
      if $_.starts-with('-') {
        @user-excludes.push($_.substr(1));
      } else {
        @files.push($_);
      }
    }
  }
  if @files !== Empty {
    note "Displaying content of : " ~ @files.join(', ');
  }
  if @user-excludes !== Empty {
    note "Excluding content of : " ~ @user-excludes.join(', ');
  }
  
  my AllTheThings $att = do-magic($header-file, @gccoptions);
  note 'Number of things founds';
  note '-Types: ' ~ $att.types.elems;
  note '-Structures: ' ~ $att.structs.elems;
  note '-Unions: ' ~ $att.unions.elems;
  note '-Enums: ' ~ $att.enums.elems;
  note '-Functions: ' ~ $att.functions.elems;
  note '-Variables: ' ~ $att.variables.elems;
  note '-Files: ' ~ $att.files.elems;
  note "Time to generate stuff\n\n";

  
  if $list-types {
    my %tdisplay;
    
    my %t = $att.types;
    for %t.kv -> $k, $v {
      for <FundamentalType StructType UnionType ArrayType TypeDefType> -> $cmp {
        if $v ~~ ::($cmp) {
          %tdisplay{$cmp}.push($v);
          %t{$k}:delete;
        }
      }
    }
    for <FundamentalType StructType UnionType ArrayType TypeDefType> -> $cmp {
      next unless %tdisplay{$cmp}:exists;
      say "====$cmp (" ~ @(%tdisplay{$cmp}).elems ~ ") ====";
      for @(%tdisplay{$cmp}) -> $t {
        say $t.id~ ':' ~$t;
      }
    }
    say "====OTHER====";
    for %t.values {
      say ~$_;
    }
    for $att.types.values {
      if $_ ~~ IndirectType {
        if $_.ref-type !~~ Type {
          say "Type Error: " ~ $_.id ~ " did not get resolved";
        }
      }
    }
  }
  if $list-files {
    for $att.files.keys.sort:{$^a.substr(1) > $^b.substr(1)} -> $k {
      sub count-stuff(@t, $file) {
        return (@t.grep:{$_.file-id eq $file}).elems;
      }
      my $func = count-stuff($att.functions, $k);
      my $enum = count-stuff($att.enums, $k);
      my $struct = count-stuff($att.structs.values, $k);
      printf "%-5s%s%-50s - Functions(%d), Enums(%d), Structures(%d)\n", $k, ' : ', $att.files{$k}, $func, $enum, $struct;
    }
  }
  #if $ooc {
  #  oog-config($ooc);
  #  oog-generate();
  #}
  
  if $define-enum {
    my ($enum-name, $enum-pattern) := $define-enum.split(':');
    my CEnum $e .= new(:name($enum-name), :id(-1));
    for $att.files.kv -> $k, $v {
      if $v.IO.basename ne 'gccxml_builtins.h' and $v.IO.basename !~~ /^std/ {
        my $fh = open $v;
        for $fh.lines -> $line {
          if $line ~~ /^"#"\s*"define" \s+ ($enum-pattern\S*) \s+ (<-[\/]>+)/ {
            my EnumValue $ev .= new;
            $ev.name = $0;
            $e.file-id = $k;
            $ev.init = $1;
            $e.values.push($ev);
          }
        }
      }
    }
    if $e.values.elems !== 0 {
      $att.enums.push($e);
    }    
  }
  # GENERATE STUFF (exclusion are made in sort-by-file)
  dg-init($att);
  if $enums or $all or $define-enum {
    my %h = dg-generate-enums();
    say '## Enumerations';
    my %sortedh = sort-by-file(%h.values);
    for %sortedh.kv -> $k, @v {
      say "\n# == {$att.files{$k}} ==\n";
      for @v -> $ob {
        say $ob<p6str>;
      }
    }
  }
  
  if $structs or $all {
    my %h = dg-generate-structs();
    say '## Structures' ~ "\n";
    my %sortedh = sort-by-file(%h.values);
    for %sortedh.kv -> $k, @v {
      say "\n# == {$att.files{$k}} ==\n";
      for @v.kv -> $i, $ob {
        if $ob<obj> ~~ Struct {
          if @v[$i + 1].defined and @v[$i + 1]<obj> ~~ AnonymousUnion and @v[$i + 1]<obj>.struct.defined {
            say @v[$i + 1]<p6str>;
          }
        }
        if !($ob<obj> ~~ AnonymousUnion and $ob<obj>.struct.defined) {
          say $ob<p6str>;
        }
      }
    }
  }
    
  if $functions or $all {
    say '## Extras stuff' ~ "\n";
    dg-generate-extra();
    my %h = dg-generate-functions();
    say '## Functions' ~ "\n";
    my %sortedh = sort-by-file(%h.values);
    for %sortedh.kv -> $k, @v {
      say "\n# == {$att.files{$k}} ==\n";
      for @v -> $ob {
        say $ob<p6str>;
      }
    }
  }
  
  if $externs or $all {
    say '## Externs' ~ "\n";
    my %h = dg-generate-externs();
    my %sortedh = sort-by-file(%h.values);
    for %sortedh.kv -> $k, @v {
      say "\n# == {$att.files{$k}} ==\n";
      for @v -> $ob {
        say $ob<p6str>;
      }
    }
  }
  
  sub files-filter($file-id, $file) returns Bool {
    my $basename = $file.IO.basename;
    
    #Autoexclude stuff
    return False if $basename ~~ /^std/;
    return False if $basename ~~ /^pthread/;
    return False if $basename eq 'libio.h';
    return False if $basename eq 'string.h';
    return False if $basename eq 'errno.h';
    return False if $file ~~ /'/usr/include/'.+?'-linux-gnu/bits/'/;
    return False if $file ~~ /'/usr/include/'.+?'-linux-gnu/sys/'/;
    
    if @files !== Empty {
      if $basename (<=) @files || ('@' ~ $file-id) (<=)  @files {
        return True;
      }
      return False;
    }
    if @user-excludes !== Empty {
      if $basename (<=) @user-excludes || ('@' ~ $file-id) (<=)  @user-excludes {
        return False;
      }
      return True;
    }
    return True;
  }
  
  sub sort-by-file(@array) {
    my %toret;
    for @array -> %s {
      %toret{%s<obj>.file-id}.push(%s) if files-filter(%s<obj>.file-id, $att.files{%s<obj>.file-id});
    }
    for %toret.keys -> $k {
      @(%toret{$k}).=sort: {$^a<obj>.start-line > $^b<obj>.start-line};
    }
    return %toret;
  }
}






sub do-magic($header, @other) {
  my %types;
  my %fields;
  my %structs;
  my @cfunctions;
  my @cenums;
  my %cunions;
  my %files;
  my @variables;
  
  my %times;

  my $t = now;
  if $CASTXML {
    my @arg = '--castxml-gccxml', "-std=$CASTXML_STD", '-o', 'plop.xml', $header, @other;
    note "Calling castxml : " ~ @arg.join(' ');
    run 'castxml', @arg;
  } else {
    note "Calling GCCXML : $GCC_XML $header -fxml=plop.xml", @other;
    run $GCC_XML,  $header, "-fxml=plop.xml", @other;
  }
  %times<gccxml> = now - $t;
  $t = now;
  note "Parsing the XML file";
  my $xml = from-xml-file('plop.xml');
  %times<parse-xml> = now - $t;
  $t = now;
  note "Doing magic";
  
  
  for $xml.elements() -> $elem {
    given $elem.name {
      when 'File' {
        %files{$elem<id>} = $elem<name>;
      }
      # == Types
      when 'FundamentalType' {
        my FundamentalType $t .= new(:id($elem<id>));
        $t.name = $elem<name>;
        %types{$t.id} = $t;
      }
      when 'FunctionType' {
         my FunctionType $t .= new(:id($elem<id>));
         $t.return-type-id = $elem<returns>;
         for $elem.elements() -> $arg {
           $t.arguments-type-id.push($arg<type>);
         }
         %types{$t.id} = $t;
      }
      when 'PointerType' {
        my PointerType $t .= new(:id($elem<id>));
        $t.ref-id = $elem<type>;
        $t.ref-type = %types{$t.ref-id} if %types{$t.ref-id}:exists;
        %types{$t.id} = $t;
      }
      when 'CvQualifiedType' {
        my QualifiedType $t .= new(:id($elem<id>));
        $t.ref-id = $elem<type>;
        $t.ref-type = %types{$t.ref-id} if %types{$t.ref-id}:exists;
        %types{$t.id} = $t;
      }
      when 'Typedef' {
        my TypeDefType $t .= new(:id($elem<id>));
        $t.ref-id = $elem<type>;
#         say $elem<name>;
#         say $t.ref-id;
        $t.ref-type = %types{$t.ref-id} if %types{$t.ref-id}:exists;
        $t.name = $elem<name>;
        %types{$t.id} = $t;
      }
      when 'ArrayType' {
        my $size = $elem<max>.subst('u', '') eq "0xffffffffffffffff" ?? '' !! $elem<max>.subst('u', '') + 1;   
        my ArrayType $t .= new(:id($elem<id>), :size($size));
        $t.ref-id = $elem<type>;
        %types{$t.id} = $t;
      }
      when 'ReferenceType' {
        my ReferenceType $t .= new(:id($elem<id>));
        $t.ref-id = $elem<type>;
        $t.ref-type = %types{$t.ref-id} if %types{$t.ref-id}:exists;
        %types{$t.id} = $t;
      }
      # == 'Real' Stuff
      when 'Field' {
        my $pf = Field.new();
        $pf.set-clocation($elem);
        $pf.file = %files{$pf.file-id};
        $pf.name = $elem<name>;
        $pf.type-id = $elem<type>;
        %fields{$elem<id>} = $pf;
        %structs{$elem<context>}.fields.push($pf) if %structs{$elem<context>}.defined;
        %cunions{$elem<context>}.members.push($pf) if %cunions{$elem<context>}.defined;
      }
      when 'Struct' {
        my $s = Struct.new;
        $s.name = $elem<name>.defined ?? $elem<name> !! $elem<mangled>; #FIXME
        $s.id = $elem<id>;
        $s.set-clocation($elem);
        $s.file = %files{$s.file-id};
        %structs{$s.id} = $s;
        my StructType $t .= new(:id($s.id), :name($s.name));
        %types{$t.id} = $t;
      }
      when 'Union' {
        my UnionType $t .= new(:id($elem<id>));
        %types{$t.id} = $t;
        my $u;
        with $elem<name> {
          $u = CUnion.new(:id($elem<id>));
          $u.name = $elem<name>;
        } else {
          $u = AnonymousUnion.new(:id($elem<id>));
          $u.struct = %structs{$elem<context>};
        }      
        $u.set-clocation($elem);
        %cunions{$u.id} = $u;
      }
      when 'Enumeration' {
        my CEnum $enum .= new(:id($elem<id>), :name($elem<name>));
        my EnumType $t .= new(:id($elem<id>), :name($elem<name>));
        %types{$t.id} = $t;
        $enum.set-clocation($elem);
        $enum.file = %files{$enum.file-id};
        for @($elem.elements()) -> $enumv {
          my EnumValue $nv .= new(:name($enumv.attribs<name>), :init($enumv.attribs<init>));
          $enum.values.push($nv);
        }
        @cenums.push($enum);
      }
      when 'Function' {
        next if $elem<name> ~~ /^__/;
        my Function $f .= new(:name($elem<name>), :id($elem<id>));
        $f.returns-id = $elem<returns>;
        $f.set-clocation($elem);
        $f.file = %files{$f.file-id};
        for @($elem.elements()) -> $param {
          next if $param.name ne 'Argument';
          my FunctionArgument $a .= new(:name($param.attribs<name>));
          $a.set-clocation($param);
          $a.file = %files{$a.file-id};
          $a.type-id = $param<type>;
          $f.arguments.push($a);
        }
        @cfunctions.push($f)
      }
      when 'Variable' {
        if $elem<extern> == 1 {
          my ExternVariable $e .= new(:id($elem<id>), :name($elem<name>));
          $e.type-id = $elem<type>;
          $e.set-clocation($elem);
          #$e.file = %files($e.file-id);
          @variables.push($e);
        }
      }
    }
  }
  

  #We probably can resolve every type now.
  sub resolvetype {
    my $change = True; #Do something like bubble sort, until we solve everytype, let's boucle
    while ($change) {
      $change = False;
      for %types.kv -> $id, $t {
	if $t ~~ IndirectType {
	  unless $t.ref-type:defined {
	    #say "Found an undef indirect id: "~ $t.ref-id;
	    $t.ref-type = %types{$t.ref-id};
	    $change = True;
	  }
	}
      }
    }
  }
  resolvetype();
  
  sub merge-stypedef {
    for %types.kv -> $id, $t {
      if $t ~~ TypeDefType and $t.ref-type ~~ StructType {
        %types{$id} = $t.ref-type;
        $t.ref-type.name = $t.name;
        %structs{$t.ref-id}.name = $t.name;
      }
    }
  }
  #Handle functionType
  for %types.kv -> $k, $v {
    if $v ~~ FunctionType {
      $v.return-type = %types{$v.return-type-id};
      for $v.arguments-type-id -> $id {
        $v.arguments-type.push(%types{$id});
      }
    }
  }
  
  merge-stypedef() if $gmerge-stypedef;
  for @cfunctions -> $f {
    $f.returns = %types{$f.returns-id};
    for $f.arguments -> $a {
      $a.type = %types{$a.type-id};
    }
  }
  for %fields.kv ->  $id, $f {
    $f.type = %types{$f.type-id};
    if $f.type ~~ UnionType {
      %cunions{$f.type.id}.field = $f if %cunions{$f.type.id} ~~ AnonymousUnion;
    }
  }
  for %cunions.kv -> $k, $cu {
    if $cu ~~ AnonymousUnion {
      $cu.gen-name = $cu.struct.name ~ "_" ~ $cu.field.name ~ "_Union";
    }
  }
  for @variables -> $v {
    $v.type = %types{$v.type-id};
    #say $v.name ~ ' - ' ~ $v.type;
  }
  
  %times<magic> = now - $t;
  note "Times -- gccxml: %times<gccxml> sec; xml parsing: %times<parse-xml> sec; magic: %times<magic>";
   my $att = AllTheThings.new;
   $att.files = %files;
   $att.types = %types;
   $att.functions = @cfunctions;
   $att.enums = @cenums;
   $att.structs = %structs;
   $att.unions = %cunions;
   $att.variables = @variables;
   return $att;
}

# say "\n==CSTRUCT==";
# for %struct.kv -> $k, $v {
#   say "-$k : {$v.name}";
#   for $v.fields -> $f {
#     say "   {$f.type.Str} ({$f.type-id})  '{$f.name}'";
#   }
# }
# 
# say "==FUNCTIONS==";
# 
# for @cfunctions -> $f {
#   my @tmp;
#   for $f.arguments -> $a {
#     @tmp.push($a.type ~ ' ' ~ $a.name);
#   }
#   say $f.returns ~ "\t\t" ~ $f.name ~ '(' ~ @tmp.join(', ') ~ ')';
# }

