Apply suggested changes

Author: BinderDavid

message-index/helper-tool.hs

@@ -1,11 +1,19 @@
 module Main where
 
 import Control.Monad (forM, forM_)
-import Data.Char (isSpace, toLower)
+import Data.Char (isLower, isSpace, toLower, toUpper)
 import System.Directory (createDirectory)
-import System.FilePath ((</>))
+import System.FilePath ((<.>), (</>))
+import System.IO (BufferMode (..), hSetBuffering, stdout)
 import Text.Read (readMaybe)
 
+-------------------------------------------------------------------------------
+-- Run this tool with `runghc` on the commandline:
+
+-- $ runghc helper-tool.hs
+
+-------------------------------------------------------------------------------
+
 -------------------------------------------------------------------------------
 -- Querying the user about the diagnostic
 -------------------------------------------------------------------------------
@@ -17,13 +25,13 @@ normalize = fmap toLower . strip
     strip = f . f
     f = reverse . dropWhile isSpace
 
--- Querying for the system: GHC / GHCup / Stack
+-- Querying for the tool: GHC / GHCup / Stack
 
-data System = GHC | GHCup | Stack deriving (Show)
+data Tool = GHC | GHCup | Stack deriving (Show)
 
-readSystem :: IO System
-readSystem = do
-  putStrLn "For which system do you want to generate a message?"
+readTool :: IO Tool
+readTool = do
+  putStrLn "Which tool's error code do you want to document?"
   putStrLn " 1) GHC"
   putStrLn " 2) GHCup"
   putStrLn " 3) Stack"
@@ -36,7 +44,10 @@ readSystem = do
     "ghcup" -> pure GHCup
     "3" -> pure Stack
     "stack" -> pure Stack
-    _ -> pure GHC
+    "" -> pure GHC
+    _ -> do
+      putStrLn "Didn't understand input. Please type a tool name or a number."
+      readTool
 
 -- Querying for the error code
 
@@ -61,7 +72,8 @@ type Title = String
 
 readTitle :: IO Title
 readTitle = do
-  putStrLn "What is the title of the error message."
+  putStrLn "What is the title of the error message?"
+  putStrLn "This is used as the title of the documentation page as well as in links to the page."
   putStr "Input: "
   getLine
 
@@ -71,6 +83,7 @@ type Summary = String
 readSummary :: IO Summary
 readSummary = do
   putStrLn "Give a short summary of the error message."
+  putStrLn "This appears on the overview page that lists all the documented errors and warnings."
   putStr "Input: "
   getLine
 
@@ -89,16 +102,20 @@ readSeverity = do
     "error" -> pure Error
     "2" -> pure Warning
     "warning" -> pure Warning
-    _ -> pure Error
+    "" -> pure Error
+    _ -> do
+      putStrLn "Please type \"error\" or \"warning\" or a number."
+      readSeverity
 
 -- Warning flag
 type WarningFlag = String
 
 -- | Only ask for a warning flag if Severity = Warning.
 readWarningFlag :: Severity -> IO (Maybe WarningFlag)
 readWarningFlag Warning = do
-  putStrLn "What is the warning flag which enables this warning."
+  putStrLn "What is the warning flag which enables this warning?"
   putStrLn "For example, enter \"-Wtabs\" if you are documenting GHC's warning about tabs in your source file."
+  putStrLn "You can leave this blank if you're not sure."
   putStr "Input: "
   Just <$> getLine
 readWarningFlag _ = pure Nothing
@@ -118,29 +135,30 @@ type Examples = [String]
 
 validateExampleName :: String -> Bool
 validateExampleName "" = False
-validateExampleName str = not (any isSpace str)
+validateExampleName str@(s : _) = not (any isSpace str) && isLower s
 
 -- | Only ask for examples if the system is GHC.
-readExamples :: System -> IO Examples
+readExamples :: Tool -> IO Examples
 readExamples GHC = do
   putStrLn "How many examples should be generated?"
   putStr "Input: "
   ln <- getLine
   case readMaybe ln :: Maybe Int of
     Nothing -> pure []
-    (Just n) -> forM [1 .. n] readExample
+    Just n -> forM [1 .. n] readExample
 readExamples _ = pure []
 
 readExample :: Int -> IO String
 readExample i = do
   putStrLn ("Give a name for example " <> show i)
+  putStrLn "The name should not contain spaces and begin with a lowercase letter."
   putStr "Input: "
   ln <- getLine
   if validateExampleName ln then pure ln else readExample i
 
 -- Template
 data Template = MkTemplate
-  { system :: System,
+  { tool :: Tool,
     code :: ErrorCode,
     title :: Title,
     summary :: Summary,
@@ -156,7 +174,7 @@ readTemplate = do
   putStrLn "This tool helps you create the scaffolding for a new error message on the error-message-index."
   putStrLn "You can leave any of the text fields blank and fill them in by hand later."
   putStrLn ""
-  sys <- readSystem
+  sys <- readTool
   putStrLn ""
   code <- readCode
   putStrLn ""
@@ -184,7 +202,7 @@ createFiles tmpl = do
   putStrLn ""
 
   -- Create the new directory "messages/XXX-NNNNNN/" and "messages/XXX-NNNNNN/index.md"
-  let message_dir = "messages" </> case system tmpl of { GHC -> "GHC-"; GHCup -> "GHCup-"; Stack -> "S-" } ++ code tmpl
+  let message_dir = "messages" </> case tool tmpl of { GHC -> "GHC-"; GHCup -> "GHCup-"; Stack -> "S-" } ++ code tmpl
   createDirectory message_dir
   let toplvl_index =
         unlines
@@ -200,11 +218,14 @@ createFiles tmpl = do
   writeFile (message_dir </> "index.md") toplvl_index
 
   -- Create the example directories and entries:
-  -- - "messages/XXX-NNNNNN/" and "messages/XXX-NNNNNN/index.md"
-  -- - "messages/XXX-NNNNNN/before/" and "messages/XXX-NNNNNN/before/Module.hs"
-  -- - "messages/XXX-NNNNNN/after/" and "messages/XXX-NNNNNN/after/Module.hs"
+  -- - "messages/XXX-NNNNNN/" and "messages/XXX-NNNNNN/example-name/index.md"
+  -- - "messages/XXX-NNNNNN/example-name/before/" and "messages/XXX-NNNNNN/example-name/before/Module.hs"
+  -- - "messages/XXX-NNNNNN/example-name/after/" and "messages/XXX-NNNNNN/example-name/after/Module.hs"
   forM_ (examples tmpl) $ \example -> do
     let example_dir = message_dir </> example
+    let uppercase "" = ""
+        uppercase (s : ss) = toUpper s : ss
+    let example_name = uppercase example
     createDirectory example_dir
     createDirectory (example_dir </> "before")
     createDirectory (example_dir </> "after")
@@ -217,24 +238,25 @@ createFiles tmpl = do
     writeFile (example_dir </> "index.md") example_index
     let before_module =
           unlines
-            [ "module Example where",
+            [ "module " <> example_name <> " where",
               "",
               "-- Insert the example containing a bug here."
             ]
-    writeFile (example_dir </> "before" </> "Example.hs") before_module
+    writeFile (example_dir </> "before" </> example_name <.> "hs") before_module
     let after_module =
           unlines
-            [ "module Example where",
+            [ "module " <> example_name <> " where",
               "",
               "-- Insert the fixed example here."
             ]
-    writeFile (example_dir </> "after" </> "Example.hs") after_module
+    writeFile (example_dir </> "after" </> example_name <.> "hs") after_module
 
 -------------------------------------------------------------------------------
 -- Main
 -------------------------------------------------------------------------------
 
 main :: IO ()
 main = do
+  hSetBuffering stdout NoBuffering
   tmpl <- readTemplate
   createFiles tmpl