content: import Data.Function (on)
  import Data.List (groupBy, maximum, sortBy, sortOn)
  import qualified Data.Map as M
  import Data.Maybe (mapMaybe)
  import Data.Ord (comparing)
  
  ------------------------ TEXTONYMS -----------------------
  
  digitEncoded ::
    M.Map Char Char ->
    [String] ->
    [(String, String)]
  digitEncoded dict =
    mapMaybe $
      ((>>=) . traverse (`M.lookup` dict))
        <*> curry Just
  
  charDict :: M.Map Char Char
  charDict =
    M.fromList $
      concat $
        zipWith
          (fmap . flip (,))
          (head . show <$> [2 ..])
          (words "abc def ghi jkl mno pqrs tuv wxyz")
  
  definedSamples ::
    Int ->
    [[(String, String)]] ->
    [[(String, String)] -> Int] ->
    [[[(String, String)]]]
  definedSamples n xs fs =
    [take n . flip sortBy xs] <*> (flip . comparing <$> fs)
  
  --------------------------- TEST -------------------------
  main :: IO ()
  main = do
    let fp = "unixdict.txt"
    s <- readFile fp
    let encodings = digitEncoded charDict $ lines s
        codeGroups =
          groupBy
            (on (==) snd)
            . sortOn snd
            $ encodings
        textonyms = filter ((1 <) . length) codeGroups
    mapM_
      putStrLn
      [ "There are "
          <> show (length encodings)
          <> " words in "
          <> fp
          <> " which can be represented\n"
          <> "by the digit key mapping.",
        "\nThey require "
          <> show (length codeGroups)
          <> " digit combinations to represent them.",
        show (length textonyms)
          <> " digit combinations represent textonyms.",
        ""
      ]
    let codeLength = length . snd . head
        [ambiguous, longer] =
          definedSamples
            5
            textonyms
            [length, codeLength]
        [wa, wl] =
          maximum . fmap codeLength
            <$> [ambiguous, longer]
    mapM_ putStrLn $
      "Five most ambiguous:" :
      fmap (showTextonym wa) ambiguous
        <> ( "" :
             "Five longest:" :
             fmap
               (showTextonym wl)
               longer
           )
  
  ------------------------- DISPLAY ------------------------
  showTextonym :: Int -> [(String, String)] -> String
  showTextonym w ts =
    concat
      [ rjust w ' ' (snd (head ts)),
        " -> ",
        unwords $ fmap fst ts
      ]
    where
      rjust n c = (drop . length) <*> (replicate n c <>)
  