Word reorderer (speaking)

-- The app reads a set of text lines from stdin, reorders the words in
-- them and sends the result to stdout. It is intended to create
-- exercises for language training purposes, where a student has to
-- reorder the words to restore the original sentence. Each set of
-- words is merely sorted alphabetically; if the words were in
-- alphabetical order originally, the set is reversed. The app can
-- handle dialogue lines i.e. ones that start with an em dash or a
-- plus sign.

import Data.List (intercalate, sortOn)
import Data.Char (toLower)

toValidChars :: String -> String
toValidChars = filter toValidChar
  where
    toValidChar = flip elem validChars

-- Below is a list of characters that are not removed from the initial
-- text. They are: word characters: letters (including ones with
-- diacritics), the apostrophe, the right single quotation mark
-- (sometimes used instead of the apostrophe), the hyphen; delimiters:
-- the space and the newline; the plus sign and the em dash (used to
-- introduce dialogue lines).

validChars :: String
validChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzóşăţ'’- +—\n"

toListOfStringsLists :: String -> [[String]]
toListOfStringsLists string = map words $ lines string

enhancedSorting :: [String] -> [String]
enhancedSorting list
  | sorter list == list = (reverse . sorter) list
  | otherwise = sorter list
  where
    sorter = sortOn (map toLower)

tailSorting :: [String] -> [String]
tailSorting [] = []
tailSorting (x:xs) = x : enhancedSorting xs

checkPlusAndEmDash :: String -> Bool
checkPlusAndEmDash x = x `elem` ["+", "—"]

selectiveSorting :: [String] -> [String]
selectiveSorting [] = []
selectiveSorting list
  | checkPlusAndEmDash listHead = tailSorting list
  | otherwise = enhancedSorting list
  where
    listHead = head list

selectiveIntercalation :: [String] -> String
selectiveIntercalation [] = []
selectiveIntercalation list@(x:xs)
  | checkPlusAndEmDash x = x ++ " " ++ intercalate ", " xs
  | otherwise = intercalate ", " list

singleWordReplacement :: [String] -> [String]
singleWordReplacement [] = []
singleWordReplacement list
  | checkPlusAndEmDash listHead && length list == 2 = listHead : ["…"]
  | length list == 1 = ["…"]
  | otherwise = list
  where
    listHead = head list

innerDashesRemoval :: [String] -> [String]
innerDashesRemoval [] = []
innerDashesRemoval (x:xs) = x : (xs >>= removeDash)
  where
    removeDash string
      | string == "—" = []
      | otherwise = [string]

replacementRemovalSorting :: [String] -> [String]
replacementRemovalSorting =
  innerDashesRemoval . singleWordReplacement . selectiveSorting

main :: IO ()
main = do
  input <- getContents
  mapM_
    ((putStrLn . selectiveIntercalation) . replacementRemovalSorting)
    (toListOfStringsLists $ toValidChars input)