#!/usr/bin/perl -w

$tmppar = "";

sub get_par_begin {
  my $s = shift(@_);
  $s =~ s/\r?\n$//;
  my $cntx;
  if (length($s) > 20) {
    $cntx = substr($s,0,20)."...";
  }
  else {
    $cntx = $s;
  }
  return $cntx;
}

sub get_par_begin_and_end {
  my $s = shift(@_);
  $s =~ s/\r?\n$//;
  my $cntx;
  if (length($s) > 40) {
    $cntx = &get_par_begin($s);
    $cntx .= substr($s,length($s)-20,20);
  }
  else {
    $cntx = $s;
  }
  return $cntx;
}

sub possible_compound {
  my $w = shift(@_);
  my $score = 0;
  $score++ if $w =~ /(ed|ing)$/;
  $score++ if $w =~ /-(like|side)$/;
  $score++ if $w =~ /^(full|half|mid|pre|self|great|little)-/;
  $score++ if $w =~ /^(twen|thir|four|fif|six|seven|eigh|nine)ty---(one|two|three|four|five|six|seven|eight|nine|first|second|third|fourth|fifth|sixth|seventh|eight|ninth)/i;
  $score-- if $w =~ /-(I|you|they|we|he|she|it|a)$/i;
  $score-- if $w =~ /-(no|as|the|at|and|or|if|but|what)$/;
  $score-- if $w =~ /-(am|is|are|was|were|would)(n't)?$/;
  $score-=2 if $w =~ /^[A-HJZa-z]\-/;
  my @tmp = split /---/, $w;
  $score-- if uc($tmp[0]) eq uc($tmp[1]);
  #return "COMPOUND YES" if $score > 0;
  #return "COMPOUND NO" if $score < 0;
  #return "";
  return $score;
}


sub count_double_quotes {
  my $par = shift(@_);
  my $count1 = 0;
  my $count2 = 0;
  while ($par =~ /``|''|"/s) {
    $count1 ++ if $& eq "``";
    $count1 -- if $& eq "''";
    $count2 ++ if $& eq '"';
    $par = $';
  }
  return $count1 + ($count2 % 2);
}

sub process_paragraph {
  $par =~ s/\r?\n$//;
  return if $par =~ /^\s*$/;
  print STDERR "Wrong paragraph start (".&get_par_begin($par).")\n" if $par =~ /^[^A-Z"'\(]/;
  print STDERR "Wrong paragraph end (".&get_par_begin_and_end($par).")\n" if $par !~ /["\.\?\!,;:\)]$|ā\x80\x94|ā\x80¦/ && $par !~ /^chapter/i;
  print STDERR "Unbalanced double quotes in paragraph \"".&get_par_begin($par)."\"\n" if &count_double_quotes($par) != 0;
  #my @words = split /\s+|ā\x80\x94|ā\x80\x93/, $par;
  my @words = split /\s+|\Wā\x80\x94|ā\x80\x94\W|\.\.\./, $par;
  for(my $i = 0; $i<=$#words; $i++) {
    my $w = $words[$i];
    $w =~ s/ā\x80\x94/---/g;
    $w =~ s/ā\x80\x93/--/g;
    $w =~ s/\\-//g;
    $w =~ s/\\[^ \\]+{?//;
    $w =~ s/}$//;
    $w =~ s/ā\x80¦//g;
    $w =~ s/^["'\(]+//;
    $w =~ s/['"\.,;\?!:\)]+$//;
    $w =~ s/-{2,3}$//;
    $w =~ s/^-{2,3}//;
    $w =~ s/'s$//;
    $w =~ s/'d$//;
    $w =~ s/'ll$//;
    $w =~ s/'ve$//;
    $w =~ s/'re$//;
    $vocabulary{$w}++;
    my $start = $i > 5 ? $i - 5 : 0;
    my $stop = $i < $#words - 5 ? $i+5 : $#words;
    my $context = $start != 0 ? "...":"";
    for (my $j = $start; $j <= $stop; $j++) {
      $context .= ($j==$i ? "*":"").$words[$j].($j==$i ? "* ":" ");
    }
    $context .= "..." if $stop != $#words;
    push @{$context{$w}}, $context;
    if ($w =~ /---/) {
      push @dashes, {"word" => $w, "context" => $context, "rank" => &possible_compound($w)};
    }
    elsif ($w !~ /^$/ && $w !~ /^[a-zA-Z'\-]+$/) {
      print STDERR "Non word '$w'\n$context\n\n";
    }
  }
}

sub spellcheck {
  use Text::Aspell;
  my $speller_GB = Text::Aspell->new;
  my $speller_US = Text::Aspell->new;
  $speller_GB->set_option('sug-mode','fast');
  $speller_US->set_option('sug-mode','fast');
  $speller_GB->set_option('lang','en_GB');
  $speller_US->set_option('lang','en_US');
  foreach $w (keys(%vocabulary)) {
    my @parts = split /-/,$w;
    foreach my $p (@parts) {
      if (! $speller_GB->check($p) && ! $speller_US->check($p)) {
        if ($vocabulary{$w} <= 2) {
          my @tmp = $speller_GB->suggest($p);
          push @{$bad_spell{$w}}, splice @tmp, 0, 6;
          @tmp = $speller_US->suggest($p);
          push @{$bad_spell{$w}}, splice @tmp, 0, 6;
        }
        else {
          $bad_spell{$w} = [];
        }
        last;
      }
    }
    
    # Sort and remove multiple occurences
    if (exists $bad_spell{$w}) {
      my @tmp1 = sort @{$bad_spell{$w}};
      my @tmp2 = ();
      while(@tmp1) {
        my $t = shift(@tmp1);
        push @tmp2, $t if $#tmp1 > -1 && $t ne $tmp1[0];
      }
      $bad_spell{$w} = \@tmp2;
    }
  }
}

sub read_par {
  $empty_before = $empty_after;
  $empty_after = 0;

  while(<>) {
    if (/^\s*$/) {
      $empty_after ++;
      if ($accumulator ne "") {
        $tmppar = $accumulator;
        $accumulator = "";
        $empty_after = 1;
      }
    }
    else {
      $accumulator .= $_;
      if ($tmppar ne "") {
        $par = $tmppar;
        $tmppar = "";
        return 1;
      }
    }
  }
  $par = $tmppar.$accumulator;
  return 0;
}

#########################
# 
# Main
#
#########################

$empty_before = 0;
$empty_after = 0;

$cont = 1;

#while($cont) {
#  #$previous_par = $par;
#  $cont = &read_par();
#  &process_paragraph();
#}
while (<>) {
  $par=$_;
  &process_paragraph();
}

print STDERR "\n* * * * * * *\n";
foreach my $d (sort {$b->{rank} <=> $a->{rank} } @dashes) {
  print STDERR "Dash problem '".$d->{word}."' [".$d->{rank}."]\n".
    $d->{context}."\n\n";
}

&spellcheck();
foreach my $w (sort { $vocabulary{$a} == $vocabulary{$b} ? $a cmp $b : $vocabulary{$a} <=> $vocabulary{$b} } keys(%bad_spell)) {
  print 
"$w $vocabulary{$w}\n".
($vocabulary{$w} < 3 ? join("\n",@{$context{$w}})."\n" : "").
"          ".join("\n          ",@{$bad_spell{$w}})."\n";
}
