#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Std;
use Text::Wrap;

my %opt;
getopts("n:mf:",\%opt);

die "no name" unless $opt{n};
my $name = $opt{n};
$name =~ s/\.[a-z]+$//;
$name =~ s/^.*\///;

my @l;
my %h;

# this is fun
my $cat;
my %cat;
my @cat;

my @lines = (<>);

if($opt{m}) {
    while($_ = shift @lines) {
        unshift(@lines, $_),last if /^\!/;
        print $_;
    }
}

while($_ = shift @lines) {
    next unless /\S/;
    next if /^\s*#/;
    if (/^([a-z0-9-]+)\s+(\S.*\S)\s*$/) {
        my @xs = ($1,$2);
        my $n = $1;
        my ($v,$d) = ($1,$2);
        $n =~ s/-([^-]*)/\u$1/g;
        #push @l,["\u$n",$1,$2];
        $h{$v} = {hname => "\u$n", oname => $v, desc => $d, cat => $cat  };
        push @{$cat{$cat}}, $v;
        unshift @xs, "\u$n";
        push @l,\@xs;
    } elsif (/^\@([a-z-]+)\s+(\S.*\S)\s*$/) {
        $h{$1} = { oname => $1, cat => $cat, desc => $2, vals => [split(/\s+/,$2)] };
        push @{$cat{$cat}}, $1;
    } elsif (/^!(.*)\s*$/) {
        push @cat,$1;
        $cat = $1;
        }
}

if($opt{m}) {
    my $fmt = "%-25s %s\n";

#    printf $fmt, "Option", "Description";
#    printf $fmt, "-"x6, "-"x75;
    foreach (@cat) {
    printf "\n$fmt", "$_", "";
    printf $fmt, "-"x6, "-"x75;
        #print "\n## $_\n\n";
        foreach my $j (sort @{$cat{$_}}) {
            printf $fmt,"_$h{$j}{oname}_", $h{$j}{desc};
        }
    }
    exit;
}

my @ds;
@l = sort { $a->[0] cmp $b->[0] } @l;
foreach (@l) {
    my $h = $_->[2];
    $h =~ s{/}{\\/}g;
    push @ds, (sprintf "%-17s -- ^ %s",$_->[0],$h);
}
@ds = (sort(@ds),(sprintf "%-17s -- ^ %s","Never",'Will never be set')) ;

print "module $name(Flag(..),process,helpMsg,helpFlags) where\n\n";
print "import qualified Data.Set as Set\n";
print "\n";
print "-- | Flags\n";
print "data Flag =\n      ";
print join "\n    | ", @ds;
print "\n    deriving(Eq,Ord,Bounded)\n";

print "\ninstance Show Flag where\n";
foreach (@l) {
    print "    show $_->[0] = \"$_->[1]\"\n";
}
    print "    show Never = \"never\"\n";
print "\n";

foreach (sort keys %h) {
    if ($h{$_}{hname}) {
        print "one \"$_\" = Right \$ Set.insert $h{$_}{hname}\n";
        print "one \"no-$_\" = Right \$ Set.delete $h{$_}{hname}\n";
    } else {
        print "one \"$_\" = Right \$ foldr (.) id [ f | Right f <- [ " . join(",",( map { "one \"$_\"" } @{$h{$_}{vals}})) . "]]\n"
    }
}
print "one x = Left x\n";

print "\n{-# NOINLINE process #-}\n";
print "process s xs = foldr f (s,[]) (map one xs) where\n";
print "   f (Right g) (s,xs) = (g s,xs)\n";
print "   f (Left x) (s,xs) = (s,x:xs)\n";

my $help = "";
$Text::Wrap::columns = 72;
$Text::Wrap::unexpand = 0;

foreach (@cat) {
    $help .= "\n-- $_ --\n";
    foreach my $j (sort @{$cat{$_}}) {
        my $name = $h{$j}{oname};
        $help .= wrap(sprintf("%-15s ", $name),' 'x16, $h{$j}{desc}) . "\n";
#        my @words = split /\s+/, $h{$j}{desc};
#        $help .= " $h{$j}{oname}\\n    $h{$j}{desc}\\n";
    }
}

#print STDERR $help, "\n";
$help =~ s/\n/\\n/g;

print "\n{-# NOINLINE helpMsg #-}\n";
print "helpMsg = \"$help\"\n";

print "helpFlags = [" . join(", ",map { "\"$_\"" } sort keys %h) . "]\n";