misc/bin/little

#!/usr/bin/env raku

#| print arguments or stdin as superscript
unit sub MAIN(*@args);

# char ranges {{{
my %uc = (
  A => 'ᴬ', B => 'ᴮ', D => 'ᴰ', E => 'ᴱ', G => 'ᴳ', H => 'ᴴ', I => 'ᴵ',
  J => 'ᴶ', K => 'ᴷ', L => 'ᴸ', M => 'ᴹ', N => 'ᴺ', O => 'ᴼ', P => 'ᴾ',
  R => 'ᴿ', T => 'ᵀ', U => 'ᵁ', W => 'ᵂ'
);
my %lc = (
  a => 'ᵃ', b => 'ᵇ', c => 'ᶜ', d => 'ᵈ', e => 'ᵉ', f => 'ᶠ',
  g => 'ᵍ', h => 'ʰ', i => 'ⁱ', j => 'ʲ', k => 'ᵏ', l => 'ˡ',
  m => 'ᵐ', n => 'ⁿ', o => 'ᵒ', p => 'ᵖ', r => 'ʳ', s => 'ˢ',
  t => 'ᵗ', u => 'ᵘ', v => 'ᵛ', w => 'ʷ', x => 'ˣ', y => 'ʸ',
  z => 'ᶻ'
);
my %num = (
  0 => '⁰', 1 => '¹', 2 => '²', 3 => '³',
  ([4..9] Z ['⁴'..'⁹']).Map
);
my %other = ('!' => 'ꜝ', '.' => '·', '(' => '⁽', ')' => '⁾');
# }}}
my %caseless = %lc, %num, %other;
my %cased = %uc, %caseless;


sub rejects(@chars, %map) { @chars.grep(* ∉ %map).unique.join(', ') }
sub non-ws($str) { $str.comb.grep(* !~~ /\s/) }

sub shrink(Str $str) {
  my $str-lc   = lc $str;
  my @chars    = non-ws $str;
  my @lc-chars = non-ws $str-lc;

  my $cased-rejects    = rejects @chars, %cased;
  my $caseless-rejects = rejects @lc-chars, %caseless;

  if !$cased-rejects {
    $str.trans: %cased
  } elsif !$caseless-rejects {
    note "using lowercase because no superscripts for $cased-rejects";
    $str-lc.trans: %caseless;
  } else {
    note "no superscripts for $caseless-rejects";
    ""
  }
}

if @args > 0 {
  say shrink @args.join: ' '
} else {
  say shrink $_ for $*IN.lines
}

# vim: set ft=little fdm=marker :