Word combinations splitter GTK

-- The app reads a column of text from stdin. Some lines in the column
-- may contain single words, some may contain word combinations. The
-- app splits word combinations into separate words or leaves them as
-- they are. It performs splitting either automatically or
-- interactively, depending on the mode selected by the user with the
-- help of a dialog window displayed at the launch.

import Graphics.UI.Gtk
import Control.Monad (void)
import System.Exit (die)

main :: IO ()
main = do
  input <- getContents
  initialDialogResponse <- runDialog "Choose a mode: " "Split all" "Check all"
  case initialDialogResponse of
    0 ->
      mapM_ (putStrLn . underscoresToSpaces . spacesToNewlines) $
      lines $ spaceBeforeBracket input
    1 -> mapM_ processItem $ lines $ spaceBeforeBracket input
    2 -> void (die "Aborted!")
    _ -> return ()

spaceBeforeBracket :: String -> String
spaceBeforeBracket [] = []
spaceBeforeBracket [x] = [x]
spaceBeforeBracket (x:y:ys)
  | x == ' ' && y == '(' = '_' : '(' : spaceBeforeBracket ys
  | otherwise = x : spaceBeforeBracket (y : ys)

runDialog :: String -> String -> String -> IO Int
runDialog dialogMessage buttonOne buttonTwo = do
  _ <- initGUI
  dialog <- dialogNew
  set
    dialog
    [ windowTitle := "Word combinations splitter"
    , windowDefaultWidth := 300
    , containerBorderWidth := 8
    ]

  label <- labelNew (Nothing :: Maybe String)
  labelSetMarkup label dialogMessage
  miscSetAlignment label 0.05 0
  upperPart <- dialogGetUpper dialog
  set upperPart [containerChild := label]

  button1 <- dialogAddButton dialog buttonOne (ResponseUser 0)
  button2 <- dialogAddButton dialog buttonTwo (ResponseUser 1)
  button3 <- dialogAddButton dialog "Abort" (ResponseUser 2)

  widgetShowAll dialog

  dialogExitStatus <- dialogRun dialog
  _ <- onClicked button1 mainQuit
  _ <- onClicked button2 mainQuit
  _ <- onClicked button3 mainQuit
  return $ (\(ResponseUser x) -> x) dialogExitStatus

spacesToNewlines :: String -> String
spacesToNewlines = map spaceToNewline
  where
    spaceToNewline x
      | x `elem` " \t" = '\n'
      | otherwise = x

underscoresToSpaces :: String -> String
underscoresToSpaces = map underscoreToSpace
  where
    underscoreToSpace x
      | x == '_' = ' '
      | otherwise = x

processItem :: String -> IO ()
processItem [] = return ()
processItem string
  | ' ' `elem` string || '\t' `elem` string = do
    processedDialogResponse <-
      runDialog
        ("Check: <b>" ++ underscoresToSpaces string ++ "</b>")
        "Split"
        "Skip"
    case processedDialogResponse of
      0 -> putStrLn $ underscoresToSpaces $ spacesToNewlines string
      1 -> putStrLn $ underscoresToSpaces string
      2 -> void (die "Aborted!")
      _ -> return ()
  | otherwise = putStrLn $ underscoresToSpaces string