Transliteration

-- The utility reads characters from stdin, removes the characters
-- that are not needed, replaces spaces with underscores and replaces
-- Cyrillic letters with the corresponding Latin letters or their
-- combinations. Then it sends the result to stdout.

import Data.Char (toLower, ord)
import System.Exit (die)
import qualified Data.Set as Set

main :: IO ()
main = do
  input <- getContents
  if null input
    then die "No input!"
    else
        mapM_ (putStrLn .
               cyrillicToLatin .
               spacesToUnderscores .
               extraCharsToHyphens .
               stringToLower) $
          lines input

stringToLower :: String -> String
stringToLower = map toLower

requiredChars :: String
requiredChars = ' ' : ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['А' .. 'Ё'] ++ ['а' .. 'ё']

cyrillicReplacements :: [String]
cyrillicReplacements = ["a", "b", "v", "g", "d", "ye", "zh", "z", "i", "j", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "ts", "ch", "sh", "shch", "-", "y", "-", "e", "yu", "ya", "-", "yo"]

requiredCharsSet :: Set.Set Char
requiredCharsSet = Set.fromList requiredChars

extraCharsToHyphens :: String -> String
extraCharsToHyphens = map (\x -> if Set.member x requiredCharsSet then x else '-')

spacesToUnderscores :: String -> String
spacesToUnderscores [] = []
spacesToUnderscores (x:xs)
  | x == ' ' = '_' : spacesToUnderscores xs
  | otherwise = x : spacesToUnderscores xs


cyrillicToLatin :: String -> String
cyrillicToLatin [] = []
cyrillicToLatin (x:xs) = aux x ++ cyrillicToLatin xs
  where
    aux char
      | char `elem` ['а' .. 'ё'] = cyrillicReplacements !! (ord char - 1072)
      | otherwise = [char]