Source code in the haskell programming language

import Data.List (groupBy, intersperse, sort, transpose)
import Data.Char (ord, toUpper)
import Data.Function(on) 
import Numeric (showHex)


hexFromChar :: Char -> String
hexFromChar c = map toUpper $ showHex (ord c) ""
 
string :: String -> String
string xs = ('\"' : xs) <> "\""
 
char :: Char -> String
char c = ['\'', c, '\'']
 
size :: String -> String
size = show . length
 
positions :: (Int, Int) -> String
positions (a, b) = show a <> " " <> show b
 
forTable :: String -> [String]
forTable xs = string xs : go (allUnique xs)
  where
    go Nothing = [size xs, "yes", "", "", ""]
    go (Just (u, ij)) = [size xs, "no", char u, hexFromChar u, positions ij]
 
showTable :: Bool -> Char -> Char -> Char -> [[String]] -> String
showTable _ _ _ _ [] = []
showTable header ver hor sep contents =
  unlines $
  hr :
  (if header
     then z : hr : zs
     else intersperse hr zss) <>
  [hr]
  where
    vss = map (map length) contents
    ms = map maximum (transpose vss) :: [Int]
    hr = concatMap (\n -> sep : replicate n hor) ms <> [sep]
    top = replicate (length hr) hor
    bss = map (map (`replicate` ' ') . zipWith (-) ms) vss
    zss@(z:zs) =
      zipWith
        (\us bs -> concat (zipWith (\x y -> (ver : x) <> y) us bs) <> [ver])
        contents
        bss
 
table xs =
  showTable
    True
    '|'
    '-'
    '+'
    (["string", "length", "all unique", "1st diff", "hex", "positions"] :
     map forTable xs)
 
allUnique
  :: (Ord b, Ord a, Num b, Enum b)
  => [a] -> Maybe (a, (b, b))
allUnique xs = go . groupBy (on (==) fst) . sort . zip xs $ [0 ..]
  where
    go [] = Nothing
    go ([_]:us) = go us
    go (((u, i):(_, j):_):_) = Just (u, (i, j))
 
main :: IO ()
main =
  putStrLn $
  table ["", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ"]


import Data.List (groupBy, intercalate, sortOn)
import Data.Function (on)
import Numeric (showHex)
import Data.Char (ord)


------------- INDICES OF DUPLICATED CHARACTERS -----------

duplicatedCharIndices :: String -> Maybe (Char, [Int])
duplicatedCharIndices s
  | null duplicates = Nothing
  | otherwise =
    Just $
    ((,) . (snd . head) <*> fmap fst) (head (sortOn (fst . head) duplicates))
  where
    duplicates =
      filter ((1 <) . length) $
      groupBy (on (==) snd) $ sortOn snd $ zip [0 ..] s


--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn $
  fTable
    "First duplicated character, if any:"
    (fmap (<>) show <*> ((" (" <>) . (<> ")") . show . length))
    (maybe
       "None"
       (\(c, ixs) ->
           unwords
             [ show c
             , "(0x" <> showHex (ord c) ") at"
             , intercalate ", " (show <$> ixs)
             ]))
    duplicatedCharIndices
    ["", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ"]


------------------------- DISPLAY ------------------------

fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
fTable s xShow fxShow f xs =
  unlines $
  s : fmap (((<>) . rjust w ' ' . xShow) <*> ((" -> " <>) . fxShow . f)) xs
  where
    rjust n c = drop . length <*> (replicate n c <>)
    w = maximum (length . xShow <$> xs)


import qualified Safe as S
import qualified Data.Map.Strict as M
import Data.List (intercalate, foldl') --'
import Data.Ord (comparing)
import Numeric (showHex)
import Data.Char (ord)


----------- INDICES OF ANY DUPLICATED CHARACTERS ---------

duplicatedCharIndices :: String -> Maybe (Char, [Int])
duplicatedCharIndices xs =
  S.minimumByMay
    (comparing (head . snd))
    (M.toList
       (M.filter
          ((1 <) . length)
          (foldl' --'
             (\a (i, c) -> M.insert c (maybe [i] (<> [i]) (M.lookup c a)) a)
             M.empty
             (zip [0 ..] xs))))

-- OR, fusing filter, toList, and minimumByMay down to a single fold:
duplicatedCharIndices_ :: String -> Maybe (Char, [Int])
duplicatedCharIndices_ xs =
  M.foldrWithKey
    go
    Nothing
    (foldl' --'
       (\a (i, c) -> M.insert c (maybe [i] (<> [i]) (M.lookup c a)) a)
       M.empty
       (zip [0 ..] xs))
  where
    go k [_] mb = mb -- Unique
    go k xs Nothing = Just (k, xs) -- Duplicated
    go k xs@(x:_) (Just (c, ys@(y:_)))
      | x < y = Just (k, xs) -- Earlier duplication
      | otherwise = Just (c, ys)

--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn $
  fTable
    "First duplicated character, if any:"
    ((<>) <$> show <*> ((" (" <>) . (<> ")") . show . length))
    (maybe
       "None"
       (\(c, ixs) ->
           unwords
             [ show c
             , "(0x" <> showHex (ord c) ") at"
             , intercalate ", " (show <$> ixs)
             ]))
    duplicatedCharIndices_
    ["", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ"]

------------------------- DISPLAY ------------------------
fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
fTable s xShow fxShow f xs =
  unlines $
  s : fmap (((<>) . rjust w ' ' . xShow) <*> ((" -> " <>) . fxShow . f)) xs
  where
    rjust n c = drop . length <*> (replicate n c <>)
    w = maximum (length . xShow <$> xs)