File Coverage

blib/lib/Lingua/EN/Grammarian.pm

Criterion	Covered	Total	%
statement	179	331	54.0
branch	62	100	62.0
condition	32	61	52.4
subroutine	23	59	38.9
pod	7	9	77.7
total	303	560	54.1

package Lingua::EN::Grammarian;
our $VERSION = '0.000005';

use 5.010; use warnings;
use Carp;

# Standard config files...
my $CAUTIONS_FILE = 'grammarian_cautions';
my $ERRORS_FILE   = 'grammarian_errors';

# Standard config file search path...
my @CONFIG_PATH = ( '/usr/local/share/grammarian/', "$ENV{HOME}/", "$ENV{PWD}/" );


# Export interface...
my @DEF_EXPORTS = qw<
    extract_cautions_from
    extract_errors_from
>;

my @ALL_EXPORTS = (
    @DEF_EXPORTS,
    qw<
        get_coverage_stats
        get_error_at
        get_next_error_at
        get_caution_at
        get_next_caution_at
        get_vim_error_regexes
        get_vim_caution_regexes
    >
);

sub import {
    my $self = shift;
    my @exports = @_ ? @_ : @DEF_EXPORTS;
    my $caller = caller;
    for my $exported_sub (map { /^:all$/i ? @ALL_EXPORTS : $_ } @exports) {
        no strict 'refs';
        my $impl = *{$exported_sub}{CODE};
        croak "$self does not provide $exported_sub()"
            if $exported_sub !~ /^(?:get_|extract_)/ || !$impl;
        *{$caller.'::'.$exported_sub} = $impl;
    }
}

# The data extracted from those files...
my %CAUTIONS_FOR;
my $CAUTIONS_REGEX;
my @VIM_CAUTION_REGEX_COMPONENTS;

my %CORRECTIONS_FOR;
my %EXPLANATION_FOR;
my $ERRORS_REGEX;
my @VIM_ERROR_REGEX_COMPONENTS;

my $VIM_REGEX_MAX_LEN = 20000;

# Improved \b...
my $SPACE_TRANSITION = qr{
  #  Preceded by...             And followed by...
     (?<=[[:space:][:punct:]])  (?=[^[:space:][:punct:]])
  |                         \A  (?=[^[:space:][:punct:]])
  | (?<=[^[:space:][:punct:]])  (?=[[:space:][:punct:]]|\z)
}xms;

# Extract that data...
if (! _load_cautions()) {
    warn qq{No "grammarian_cautions" file found in config search path:\n}
       . qq{\n}
       . join(q{}, map { qq{    $_\n} } @CONFIG_PATH)
       . qq{\n}
       . qq{(Did you forget to install it from the distribution?)\n};
}

if (! _load_errors()) {
    warn qq{No "grammarian_errors" file found in config search path:\n}
       . qq{\n}
       . join(q{}, map { qq{    $_\n} } @CONFIG_PATH)
       . qq{\n}
       . qq{(Did you forget to install it from the distribution?)\n};
}

sub _rewrite (&$) {
    my ($transform, $text) = @_;
    $transform->() for $text;
    return $text;
}

sub _inflect_term {
    my ($term) = @_;

    my $PRONOUN_MARKER = qr{
        < (?: I | s?he | we | me | him | us | my | his | our | mine | hers | ours) >
    }xms;

    my %PRONOUN_EXPANSION_FOR = (
        ''    => q{I,you,she,he,it,we,they},
        ''  => q{she,he},
        ''   => q{he,she},
        ''   => q{we,you,they},
        ''   => q{me,you,her,him,it,us,them},
        ''  => q{her,him},
        ''  => q{him,her},
        ''   => q{us,you,them},
        ''   => q{my,your,hers,his,its,our,their},
        ''  => q{her,his},
        ''  => q{our,your,their},
        '' => q{mine,yours,hers,his,its,ours,theirs},
        '' => q{hers,his},
        '' => q{ours,yours,theirs},
    );


    # Preprocess  expansions...
    my @components = split /($PRONOUN_MARKER)/, $term;
    $term = q{};
    my $in_parens = 0;
    while (@components) {
        my ($prefix, $pronoun) = splice(@components, 0, 2);
        $in_parens += ($prefix=~tr/(//) - ($prefix=~tr/)//);
        $term .= $prefix;
        if ($pronoun) {
            $term .= ($in_parens ? '' : '(')
                . ($PRONOUN_EXPANSION_FOR{$pronoun} // $pronoun)
                . ($in_parens ? '' : ')')
        }
    }

    # Convert any parenthesized or starred set of alternatives...
    my @inflexions;
    $term =~ s{ (? \S*? (? \S? ) )
                (?:
                      (?                  e [*]       )
                    | (?                ch [*]       )
                    | (? (?<= [^aeiou] )  y [*]       )
                    | (?    (?<= [^aeiou] )  y [(] s [)] )
                    | (?               [*][*]    )
                    | (?                      [*]       )
                    | [(] (? [^)]+ ) [)]
                )
                }
                {
                my $ll = $+{last_letter};
                @inflexions = $+{e_star}      ? ( 'e',    'es',      'ed',     'ing')
                            : $+{ch_star}     ? ( 'ch', 'ches',    'ched',   'ching')
                            : $+{y_star}      ? ( 'y',   'ies',     'ied',    'ying')
                            : $+{y_s}         ? ( 'y',   'ies',                     )
                            : $+{double_star} ? (  '',     's',  $ll.'ed', $ll.'ing')
                            : $+{star}        ? (  '',     's',      'ed',     'ing')
                            : $+{alts}        ? ( ($+{root} ? '' : ()), split(',', $+{alts}) )
                            :                     ();

                qq{$+{root}*};
                }xmse;

    return @inflexions ? map { my $infl = $term; $infl =~ s{[*]}{$_}; $infl} @inflexions
                       : $term;
}

# Parse cautions file and convert to internal data structures...
sub _load_cautions {
    # Gather config from current directory and home directory...
    local @ARGV = grep { -e }
                  map { ("$_.$CAUTIONS_FILE", "$_$CAUTIONS_FILE") }
                  @CONFIG_PATH;

    # If no config, we're done...
    return if !@ARGV;

    # Store sets of terms together...
    my @term_sets = { terms => [], defns => [], inflexions => [] };

    # Parse configuration file...
    LINE:
    while (my $next_line = readline) {
        # Ignore comments...
        next LINE if $next_line =~ m{ \A \h* [#] }xms;

        # Blank lines delimit new term sets...
        if ($next_line =~ m{\A \h* \Z}xms) {
            push @term_sets, { terms => [], defns => [], inflexions => [] };
            next LINE;
        }

        # Parse config line...
        $next_line =~ m{
            \A
                (? -?  )
            \h* (? [^:]*? )
            (?:
                \h*  :
                \h*  (? .*? )
            )?
            \h*
            \Z
        }xms;

        # Unpack components...
        my $term      = $+{term};
        my $defn      = $+{defn} // q{};
        my $is_silent = length($+{is_silent});

        # Warn of bad config...
        if (!defined $term) {
            warn "Invalid entry in grammarian_cautions: $next_line";
            next LINE;
        }

        # Unpack any inflexions...
        my @inflexions = _inflect_term($term);

        my $original = shift @inflexions;
        if ($defn =~ /\S/) {
            push @{$term_sets[-1]{terms}}, $original;
            push @{$term_sets[-1]{defns}}, $defn;
        }

        # Store patterns to be matched...
        my $order = 0;
        for my $next_inflexion ($original, @inflexions) {
            push @{ $term_sets[-1]{inflexions}[$order++] }, {silent => $is_silent, term => $next_inflexion};
        }
    }


    # Compile list of cautions and the matching regex...
    my @regex_components;
    TERM_SET:
    for my $term_set (@term_sets) {
        next TERM_SET if !@{ $term_set->{terms} };

        use List::Util 'max';
        my $term_width = max map { length } @{ $term_set->{terms} };

        my $caution
            = join q{},
              map  { sprintf("%-*s : %s\n", $term_width, $term_set->{terms}[$_], $term_set->{defns}[$_]) }
              0..$#{ $term_set->{terms} };

        for my $inflexion_set (@{ $term_set->{inflexions} }) {
            my $inflexions = [ map { $_->{term} } @{ $inflexion_set } ];
            for my $term_data (@{ $inflexion_set }) {
                my $term = $term_data->{term};
                my $silent = $term_data->{silent};
                $CAUTIONS_FOR{lc $term} = {
                    display     => $silent,
                    explanation => $caution,
                    inflexions  => $inflexions
                };
                if (!$silent) {
                    push @regex_components, _rewrite { s{\h+}{\\s+}g } $term;
                    push @VIM_CAUTION_REGEX_COMPONENTS, _rewrite { s{\h+}{\\_s\\+}g } $term;
                }
            }
        }

    }

    my $cautions_regex = '\b(?' . join('|', reverse sort @regex_components) . ')\b';
    $CAUTIONS_REGEX = qr{$cautions_regex}i;

    return 1;
}

sub _gen_pres_participle_for {
        my ($verb) = @_;

           $verb =~ s/ie$/y/
        or $verb =~ s/ue$/u/
        or $verb =~ s/([auy])e$/$1/
        or $verb =~ s/ski$/ski/
        or $verb =~ s/[^b]i$//
        or $verb =~ s/^(are|were)$/be/
        or $verb =~ s/^(had)$/hav/
        or $verb =~ s/(hoe)$/$1/
        or $verb =~ s/([^e])e$/$1/
        or $verb =~ m/er$/
        or $verb =~ m/open$/
        or $verb =~ s/([^aeiou][aeiouy]([bdgmnprst]))$/$1$2/;

        return "${verb}ing";
}

sub _gen_verb_errors {
    my ($pres, $third, $past, $pastp, $presp) = @_;

    return (
        ($pres ne $third ? (
            "====[ Incorrect inflexion of verb for the specified pronoun ]=================",
            "              (he,she,it) $pres   -->      (he,she,it) $third                 ",
            "          (I,you,we,they) $third  -->  (I,you,we,they) $pres                  ",

            "====[ Incorrect inflexion of verb after a negated auxiliary ]=================",
            "(did,would,should,could,must,might)n't $third                                 "
           ."                                  --> (did,would,should,could,must,might)n't $pres",
        ):()),

            "====[ Incorrect inflexion of verb after a negated auxiliary ]=================",
            "(did,would,should,could,must,might)n't $past                                  "
           ."                                  --> (did,would,should,could,must,might)n't $pres",

        ($past ne $pastp ? (
            "====[ Incorrect use of participle instead of simple past or past perfect ]====",
            "          (I,you,we,they) $pastp  -->  (I,you,we,they) $past                  "
            ."                                 -->  (I,you,we,they) have $pastp            "
            ."                                 -->  (I,you,we,they) had $pastp             ",

            "              (he,she,it) $pastp  -->      (he,she,it) $past                  "
            ."                                 -->      (he,she,it) has $pastp             "
            ."                                 -->      (he,she,it) had $pastp             ",

            "====[ Incorrect use of simple past instead of past participle ]================",
            " (be,being,been,was,were) $past   -->     (be,being,been,was,were) $pastp      ",
            "    (has,had,have,having) $past   -->        (has,had,have,having) $pastp      ",
            " (be,being,been,was,were) $past   -->     (be,being,been,was,were) $pastp      ",

            "====[ Incorrect inflexion of verb after a negated auxiliary ]=================",
            "(did,would,should,could,must,might)n't $pastp                                 "
           ."                                  --> (did,would,should,could,must,might)n't $pres",
        ):()),

            "====[ Incorrect use of infinitive instead of past participle ]=================",
            " (be,being,been,was,were) $pres   -->     (be,being,been,was,were) $pastp      ",
            "    (has,had,have,having) $pres   -->        (has,had,have,having) $pastp      ",

            "====[ Incorrect use of participle instead of infinitive ]=================",
            "               to ($pastp,$presp) -->     to $pres                             ",
        ($third ne $pres ?
            "                        to $third -->     to $pres                             "
        :()),
        ($past ne $pastp ?
            "                         to $past -->     to $pres                             "
        :()),

            "====[ Incorrect use of present participle instead of past participle ]=========",
            "                    being $presp  -->   being $pastp                            ",

            "====[ Incorrect use of \"try and\" instead of \"try to\" ]=====================",
            "try and ($pres,$past,$pastp,$presp)  -->   try to $pres                        ",

            "====[ Incorrect inflexion of verb after \"try to\" ]===========================",
            "       try to ($past,$pastp,$presp)  -->      try to $pres                     ",
            "     tried to ($past,$pastp,$presp)  -->    tried to $pres                     ",
            "    trying to ($past,$pastp,$presp)  -->   trying to $pres                     ",
    );
}

sub _gen_absolute_adjective_errors {
    my ($adj, $modifier) = @_;
    $modifier //= '';

    my @QUALIFIERS = qw<
        somewhat   highly   extremely   totally   completely   absolutely   utterly
    >;
    my $QUALIFIERS = '(' . join(',', @QUALIFIERS) . ')';

    my @errors = (
        "====[ Incorrect use of modifier with ungradeable adjective ]===================",
        "           more $adj  -->  $adj                                                ",
        "           most $adj  -->  $adj                                                ",
        "          quite $adj  -->  $adj                                                ",
        "         rather $adj  -->  $adj                                                ",
        "           very $adj  -->  $adj                                                ",
        "    $QUALIFIERS $adj  -->  $adj                                                ",
    );

    if ($modifier) {
        $modifier =~ s{ \A [(] | [)] \z}{}xgms;
        for my $mod (split(',', $modifier)) {
            $errors[1] .=  " -->   more $mod $adj";
            $errors[2] .=  " -->   most $mod $adj";
            $errors[3] .=  " -->  quite $mod $adj";
            $errors[4] .=  " --> rather $mod $adj";
            $errors[5] .=  " -->   very $mod $adj";
        }
    }

    return @errors;
}

sub _load_errors {
    # Gather config from search path
    local @ARGV = grep { -e }
                  map { ("$_.$ERRORS_FILE", "$_$ERRORS_FILE") }
                  @CONFIG_PATH;

    # If no config, we're done...
    return if !@ARGV;

    # Extract corrections...
    my @regex_components;
    my $explanation = '????';
    my $last_was_explanation = 1;
    my @insertions;
    LINE:
    while (my $next_line = shift(@insertions) // readline) {

        # Ignore comment and empty lines...
        next LINE if $next_line =~ m{\A \h* (?: [#] | \Z )}xms;

        # Handle explanation lines...
        if ($next_line =~ m{\A \h* ===\S* \h* (.*?) \h* \S*===.* \Z }xms) {
            $explanation = $last_was_explanation ? "$explanation\n$1" : $1;
            $last_was_explanation = 1;
            next LINE;
        }
        $last_was_explanation = 0;

        # Generate errors from a  specification...
        if ($next_line =~ m{\A\h*  \h* (?\S+) \h* (?\S+) \h* (?\S+) \h* (?\S+)}xms) {
            push @insertions, _gen_verb_errors(@+{qw}, _gen_pres_participle_for($+{pres}));
            next LINE;
        }

        # Generate errors from an  specification...
        if ($next_line =~ m{\A\h*  \S+) \h*)?> \h* (?\S+) }xms) {
            push @insertions, _gen_absolute_adjective_errors( @+{qw< adjective modifier >} );
            next LINE;
        }

        # Extract error --> correction pair...
        $next_line =~ m{
            \A \h*
            (? .*? )
            \h* --> \h*
            (? .*? )
            \h* \Z
        }xms;
        my ($error, $correction) = @+{'error', 'correction'};

        # Ignore invalid lines...
        next LINE if !defined $error;

        # Expand inflected forms...
        my @error_inflexions = _inflect_term($error);
        my @corrections_inflections
            = map {[_inflect_term($_)]}
              split /\h+-->\h+/,
              $correction;

        # Iterated inflections in parallel...
        for my $next (0..$#error_inflexions) {
            my $error = $error_inflexions[$next];

            # Build normalized transform from error to each correction...
            for my $correction (@corrections_inflections) {
                my $normalized_error = _rewrite { s{\h+}{ }gxms } lc $error;
                push @{$CORRECTIONS_FOR{$normalized_error}},
                     $correction->[$next] // $correction->[-1];

                # Record explanation...
                $EXPLANATION_FOR{$normalized_error} = $explanation;
            }

            # Remember error for eventual regexes (with generalized whitespace)...
            push @regex_components, _rewrite { s{\h+}{\\s+}g } $error;
            push @VIM_ERROR_REGEX_COMPONENTS, _rewrite { s{\h+}{\\_s\\+}g } $error;
        }
    }

    # Build error-detecting regex...
    my $ERRORONEOUS_TERM = join('|', reverse sort @regex_components);
    $ERRORS_REGEX = qr{
        $SPACE_TRANSITION
        ( $ERRORONEOUS_TERM | (?&REPEATED_WORD) )
        $SPACE_TRANSITION

        (?(DEFINE)
            (?  (? \S++)  \s++  \k )
        )
    }ixms;

    return 1;
}

# Apply regexes to detect offending terms...
sub extract_cautions_from {
    my ($text) = @_;

    state %cautions_cache;
    if (!exists $cautions_cache{$text}) {
        my $cache = $cautions_cache{$text} = [];
        while ($text =~ m{\G .*? $CAUTIONS_REGEX}gcxms) {
            push @{$cache}, Lingua::EN::Grammarian::Caution->new($1,\$text);
        }
    }

    return @{ $cautions_cache{$text} };
}

sub extract_errors_from {
    my ($text) = @_;

    state %errors_cache;
    if (!exists $errors_cache{$text}) {
        my $cache = $errors_cache{$text} = [];
        while ($text =~ m{\G .*? $ERRORS_REGEX}gcxms) {
            push @{$cache}, Lingua::EN::Grammarian::Error->new($1,\$text);
        }
    }

    return @{ $errors_cache{$text} };
}

# Report coverage...
sub get_coverage_stats {
    return {
        cautions => scalar keys %CAUTIONS_FOR,
        errors   => scalar keys %CORRECTIONS_FOR,
    }
}

# Identify offences (if any) at a particular location...

sub get_error_at {
    my ($text, $index_or_line, $col) = @_;
    return _problem_in($text, [extract_errors_from($text)], $index_or_line, $col,\do{my $no_next});
}

sub get_next_error_at {
    my ($text, $index_or_line, $col) = @_;
    state $prev_error_index = -1;
    return _problem_in($text, [extract_errors_from($text)], $index_or_line, $col,\$prev_error_index);
}

sub get_caution_at {
    my ($text, $index_or_line, $col) = @_;
    return _problem_in($text, [extract_cautions_from($text)], $index_or_line, $col,\do{my $no_next});
}

sub get_next_caution_at {
    my ($text, $index_or_line, $col) = @_;
    state $prev_caution_index = -1;
    return _problem_in($text, [extract_cautions_from($text)], $index_or_line, $col,\$prev_caution_index);
}

sub _problem_in {
    my ($text, $problems_ref, $index_or_line, $col, $prev_findex_ref) = @_;

    # Convert line/col to index...
    if (defined $col) {
        $index_or_line -= 1;
        $text =~ m{( \A (?:  [^\n]* \n){$index_or_line} [^\n]{$col} )}xms
             or return;
        $index_or_line = length($1);
    }

    # Look for a hit...
    for my $problem (@{$problems_ref}) {
        my $findex = $problem->from->{index};
        my $tindex = $problem->to->{index};

        # Cursor is "in" a problem...
        if ($findex <= $index_or_line && $index_or_line <= $tindex && $findex != (${$prev_findex_ref} // -1)) {
            ${$prev_findex_ref} = $findex;
            return wantarray ? ($problem, 1)  # There's a problem and the cursor *is* over it
                             :  $problem;
        }

        # Cursor not in a problem, so return next problem...
        elsif ($findex > $index_or_line) {
            ${$prev_findex_ref} = $findex;
            return wantarray ? ($problem, 0)  # There's a problem and the cursor *isn't* over it
                             : undef;
        }
    }

    # Otherwise, it's a miss...
    return;
}


# Provide regexes for matching grammar problems in Vim...

sub get_vim_error_regexes {
    _build_vim_regex_from(@VIM_ERROR_REGEX_COMPONENTS);
}

sub get_vim_caution_regexes {
    _build_vim_regex_from(@VIM_CAUTION_REGEX_COMPONENTS);
}

sub _build_vim_regex_from {
    my @regex_components = reverse sort @_;

    my @regexes;
    for my $alternative (@regex_components) {
        $alternative =~ s/'/''/g;
        if (@regexes && length($regexes[-1]) + length($alternative) + 10 < $VIM_REGEX_MAX_LEN) {
            $regexes[-1] .= '\\|' . $alternative;
        }
        else {
            push @regexes, '\\c' . $alternative;
        }
    }
    return map { '\<\%('.$_.'\)\>' } @regexes;
}


my $UPPER_CASE_PAT   = qr{\A [[:upper:]]* \Z}xms;
my $LOWER_CASE_PAT   = qr{\A [[:lower:]]* \Z}xms;
my $TITLE_CASE_PAT   = qr{\A [[:upper:]][[:lower:]]* \Z}xms;

# Convert a term to have the same capitalization as an original paradigm...
my $_recase_like = sub {
    my ($paradigm, $target) = @_;

    # Process two strings word-by-word...
    my @paradigm_words = split($SPACE_TRANSITION, $paradigm);
    my @target_words   = split($SPACE_TRANSITION, $target  );

    while (@paradigm_words < @target_words) {
        push @paradigm_words, $paradigm_words[-1];
    }

    # Accumulate modified target by transforming each word...
    my $modified_target = "";
    for my $next_paradigm (@paradigm_words) {
        # If target completely processed, we're done...
        last if !@target_words;

        # Otherwise, convert target according to pattern of paradigm...
        $modified_target .= $next_paradigm =~ $UPPER_CASE_PAT ? uc(shift @target_words)
                          : $next_paradigm =~ $LOWER_CASE_PAT ? lc(shift @target_words)
                          : $next_paradigm =~ $TITLE_CASE_PAT ? ucfirst(lc(shift @target_words))
                          :                                     shift @target_words
                          ;
    }

    return $modified_target;
};

package Lingua::EN::Grammarian::Error; {
    use Hash::Util::FieldHash 'fieldhash';
    *_rewrite = *Lingua::EN::Grammarian::_rewrite;

    fieldhash my %match_for;
    fieldhash my %startpos_for;
    fieldhash my %endpos_for;

    sub new {
        my ($class, $term, $source_ref) = @_;

        my $newobj = bless \do{my $scalar}, $class;

        my $endindex   = pos(${$source_ref}) - 1;
        my $startindex = pos(${$source_ref}) - length($term);
        my $startline  = 1 + substr(${$source_ref},0,$startindex) =~ tr/\n//;
        my $endline    = 1 + substr(${$source_ref},0,$endindex) =~ tr/\n//;
        my $startcol   = 1 + length(Lingua::EN::Grammarian::_rewrite {s{\A.*\n}{}xms} substr(${$source_ref},0,$startindex));
        my $endcol     = 1 + length(Lingua::EN::Grammarian::_rewrite {s{\A.*\n}{}xms} substr(${$source_ref},0,$endindex));

        $match_for{$newobj}    = $term;
        $startpos_for{$newobj} = { index => $startindex, line => $startline, column => $startcol };
        $endpos_for{$newobj}   = { index => $endindex,   line => $endline,   column => $endcol   };

        return $newobj;
    }

    sub match { my $self = shift; return $match_for{$self} }
    use overload q{""} => sub { my $self = shift; return $match_for{$self} };

    sub from { my $self = shift; return $startpos_for{$self} }
    sub to   { my $self = shift; return $endpos_for{$self}   }

    sub explanation {
        my $self = shift;
        return $EXPLANATION_FOR{lc Lingua::EN::Grammarian::_rewrite {s{\s+}{ }g} $match_for{$self}}
            // "Repeated word";
    }

    sub explanation_hash {
        return {};
    }

    sub suggestions {
        my $self = shift;
        my $term = $match_for{$self};

        # Locate suggestions...
        my $corrections_ref
            = $CORRECTIONS_FOR{lc Lingua::EN::Grammarian::_rewrite {s{\s+}{ }g} $term}
            // [$term =~ m{\A (\S+) \s+ \1 \z}ixms ? $1 : () ];

        # Adjust their casings...
        return map { $_recase_like->($term, $_) } @{$corrections_ref};
    }
}

package Lingua::EN::Grammarian::Caution; {
    use Hash::Util::FieldHash 'fieldhash';

    fieldhash my %match_for;
    fieldhash my %startpos_for;
    fieldhash my %endpos_for;

    sub new {
        my ($class, $term, $source_ref) = @_;

        my $newobj = bless \do{my $scalar}, $class;

        my $endindex   = pos(${$source_ref}) - 1;
        my $startindex = pos(${$source_ref}) - length($term);
        my $startline  = 1 + substr(${$source_ref},0,$startindex) =~ tr/\n//;
        my $endline    = 1 + substr(${$source_ref},0,$endindex) =~ tr/\n//;
        my $startcol   = 1 + length(Lingua::EN::Grammarian::_rewrite { s{\A.*\n}{}xms } substr(${$source_ref},0,$startindex));
        my $endcol     = 1 + length(Lingua::EN::Grammarian::_rewrite { s{\A.*\n}{}xms } substr(${$source_ref},0,$endindex));

        $match_for{$newobj}    = $term;
        $startpos_for{$newobj} = { index => $startindex, line => $startline, column => $startcol };
        $endpos_for{$newobj}   = { index => $endindex,   line => $endline,   column => $endcol   };

        return $newobj;
    }

    sub match { my $self = shift; return $match_for{$self} }
    use overload q{""} => sub { my $self = shift; return $match_for{$self} };

    sub from { my $self = shift; return $startpos_for{$self} }
    sub to   { my $self = shift; return $endpos_for{$self}   }

    sub explanation {
        my $self = shift;
        my $target = lc Lingua::EN::Grammarian::_rewrite {s{\s+}{ }g} $match_for{$self};
        my $suggested = $CAUTIONS_FOR{$target};
        return if !defined $suggested;
        return $suggested->{explanation};
    }

    sub explanation_hash {
        my $self = shift;
        my $target = lc Lingua::EN::Grammarian::_rewrite {s{\s+}{ }g} $match_for{$self};
        my $suggested = $CAUTIONS_FOR{$target};
        return if !defined $suggested;
        return { split /\s+:\s+|\s*\n/, $suggested->{explanation} };
    }

    sub suggestions {
        my $self = shift;
        my $target = lc Lingua::EN::Grammarian::_rewrite {s{\s+}{ }g} $match_for{$self};
        my $suggested = $CAUTIONS_FOR{$target};
        return if !defined $suggested;

        # Reorder suggestions by relevance to term...
        return map  { $_recase_like->($match_for{$self}, $_) }
               sort {
                      $a eq $target  ?  -1
                    : $b eq $target  ?  +1
                    : $a cmp $b
               }
               @{ $suggested->{inflexions} }
    }
}


1; # Magic true value required at end of module
__END__