#!/usr/bin/perl
use IPC::Open2;
use Config;
use File::Spec;
use FindBin qw<$Bin>;

my $drift_exe = File::Spec->catfile($Bin, "DrIFT$Config{_exe}");

-e "$Bin/../../DrIFT/src/DrIFT.hs" or exit;

# XXX - This is not at all portable.

$ENV{DERIVEPATH} = "$Bin/../src";

my ($in) = @ARGV or exit;
my ($dir) = $in =~ /^(.*)\.hs/;

mkdir $dir unless -d $dir;
my $out = $dir."/Instances.hs";
open TMP, "> $in.tmp" or die "Cannot open $out: $!";

open IN, $in or die $!;
while (<IN>) {
    if (/\{-!\s*global/) {
        print TMP $_;
        next;
    }
    if(/<DrIFT>/../<\/DrIFT>/) { next }

    # "EvalT m a" is not handled by DrIFT yet
    /^(?:data|newtype)\b(?!\s+\w+\s+\w+\s+\w+)(?!.*\bwhere)/ ... (/^(?![ \t]|--|data\b|newtype\b)/) or next;
    s/^newtype\b/data/;
    s/\[:([^\]]*):\]/[$1]/g;
    s/--.*$//;
    /\S/ or next;
    print TMP $_;
}
close IN;
close TMP;

my ($rh, $wh);

system(
    'ghc',
    '--make',
    '-o' => $drift_exe,
    "-i$Bin/../src/DrIFT",
    "-i$Bin/../../DrIFT/src",
    "$Bin/../../DrIFT/src/DrIFT.hs",
);
my $pid = open2(
    $rh, $wh, $drift_exe, "$in.tmp"
);

my @program = do { <$rh> };
waitpid($pid, 0);
exit unless @program;

# Rearrange the DrIFT header
@program[0..2] = @program[2,0,1];
my @scary_header = split /^/m, << "SCARY";




{- 
-- WARNING WARNING WARNING --

This is an autogenerated file from $in.

Do not edit this file.

All changes made here will be lost!

-- WARNING WARNING WARNING --
-}

#ifndef HADDOCK









SCARY

# splice(@program, 2, 0, @scary_header);

open IN, $in or die $!;
open OUT, "> $out" or die $!;
while (<IN>) {
    /OPTION/ or last;
	s{\Q../}{../../}; # Hack to fix includes (It's stupid!)
    print OUT $_;
}
print OUT @scary_header;
my $module;
while (<IN>) { 
	if (/^module \s+ (\S*)/x) {
		$module = $1;
		last;
	}
}
print OUT <<".";
module $module.Instances ()
where
import $module
import Data.Yaml.Syck
import DrIFT.YAML
import DrIFT.JSON
import DrIFT.Perl5
import DrIFT.Perl6Class
import Control.Monad
import qualified Data.ByteString as Buf

.

while (<IN>) {
	if(/<DrIFT>/../<\/DrIFT>/) {
		next if (/DrIFT/);
		print OUT;
	}
}

close IN;

shift(@program) until $program[0] =~ /Look, but Don't Touch/;

print OUT @program;

print OUT <<".";


#endif
.
close OUT;

unlink "$in.tmp";