Use haskeline in create script (#513)

* Transform create-message-template to a cabal script

* Use InputT monad transformer instead of IO

* Use getInputLine instead of readline

* Fix hlint suggestion and update CONTRIBUTING.md

* Add some lower bounds

* Update message-index/create-message-template.hs

Co-authored-by: Jan Hrcek <[email protected]>

* Fix golden test

---------

Co-authored-by: Jan Hrcek <[email protected]>

Author: BinderDavid

CONTRIBUTING.md

@@ -26,7 +26,7 @@ issue][new-issue] and someone will help you out.)*
 [new-issue]: https://github.com/haskellfoundation/error-message-index/issues/new
 
 1. Change to the `message-index` directory.
-2. Execute `runghc create-message-template.hs` and answer the questions.
+2. Execute the cabal script `./create-message-template.hs` and answer the questions.
 3. Optionally commit the new files and create a draft pull request right away.
 
 The files created by the tool will need further editing, but it's never too

message-index/create-message-template.hs

@@ -1,18 +1,25 @@
+#!/usr/bin/env cabal
+{- cabal:
+build-depends: base, haskeline >=0.8, directory >= 1.3, filepath >= 1.4
+-}
 module Main where
 
 import Control.Monad (forM, forM_)
+import Control.Monad.IO.Class (liftIO)
 import Data.Char (isLower, isSpace, toLower, toUpper)
+import Data.Maybe (fromMaybe)
+import System.Console.Haskeline
 import System.Directory (createDirectory, createDirectoryIfMissing)
 import System.FilePath ((<.>), (</>))
 import System.IO (BufferMode (..), hSetBuffering, stdout)
 import Text.Read (readMaybe)
 
--------------------------------------------------------------------------------
--- Run this tool with `runghc` on the commandline:
-
--- $ runghc create-message-template.hs
+type ToolM a = InputT IO a
 
--------------------------------------------------------------------------------
+getInputLine' :: String -> ToolM String
+getInputLine' s = do
+  ln <- getInputLine s
+  pure (fromMaybe "" ln)
 
 -------------------------------------------------------------------------------
 -- Querying the user about the diagnostic
@@ -29,15 +36,14 @@ normalize = fmap toLower . strip
 
 data Tool = GHC | GHCup | Stack | Cabal deriving (Show)
 
-readTool :: IO Tool
+readTool :: ToolM Tool
 readTool = do
-  putStrLn "· Which tool's error code do you want to document?"
-  putStrLn " 1) GHC"
-  putStrLn " 2) GHCup"
-  putStrLn " 3) Stack"
-  putStrLn " 4) Cabal"
-  putStr "Input (Default = GHC): "
-  ln <- getLine
+  outputStrLn "· Which tool's error code do you want to document?"
+  outputStrLn " 1) GHC"
+  outputStrLn " 2) GHCup"
+  outputStrLn " 3) Stack"
+  outputStrLn " 4) Cabal"
+  ln <- getInputLine' "Input (Default = GHC): "
   case normalize ln of
     "1" -> pure GHC
     "ghc" -> pure GHC
@@ -49,7 +55,7 @@ readTool = do
     "cabal" -> pure Cabal
     "" -> pure GHC
     _ -> do
-      putStrLn "Didn't understand input. Please type a tool name or a number."
+      outputStrLn "Didn't understand input. Please type a tool name or a number."
       readTool
 
 -- Querying for the error code
@@ -58,80 +64,74 @@ readTool = do
 --   to preserve leading 0's.
 type ErrorCode = String
 
-readCode :: IO ErrorCode
+readCode :: ToolM ErrorCode
 readCode = do
-  putStrLn "· What is the numeric code that you want to document?"
-  putStrLn "For example, enter \"01234\" if you want to document GHC-01234."
-  putStr "Input: "
-  ln <- getLine
+  outputStrLn "· What is the numeric code that you want to document?"
+  outputStrLn "For example, enter \"01234\" if you want to document GHC-01234."
+  ln <- getInputLine' "Input: "
   case readMaybe ln :: Maybe Int of
     Nothing -> do
-      putStrLn "Could not parse the input as an integer. Only enter the numeric part of the error."
+      outputStrLn "Could not parse the input as an integer. Only enter the numeric part of the error."
       readCode
     Just _ -> pure ln
 
 -- Title
 type Title = String
 
-readTitle :: IO Title
+readTitle :: ToolM Title
 readTitle = do
-  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
+  outputStrLn "· What is the title of the error message?"
+  outputStrLn "This is used as the title of the documentation page as well as in links to the page."
+  getInputLine' "Input: "
 
 -- Summary
 type Summary = String
 
-readSummary :: IO Summary
+readSummary :: ToolM 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
+  outputStrLn "· Give a short summary of the error message."
+  outputStrLn "This appears on the overview page that lists all the documented errors and warnings."
+  getInputLine' "Input: "
 
 -- Severity
 data Severity = Error | Warning deriving (Show)
 
-readSeverity :: IO Severity
+readSeverity :: ToolM Severity
 readSeverity = do
-  putStrLn "· What is the severity of the diagnostic?"
-  putStrLn " 1) Error"
-  putStrLn " 2) Warning"
-  putStr "Input (Default = Error): "
-  ln <- getLine
+  outputStrLn "· What is the severity of the diagnostic?"
+  outputStrLn " 1) Error"
+  outputStrLn " 2) Warning"
+  ln <- getInputLine' "Input (Default = Error): "
   case normalize ln of
     "1" -> pure Error
     "error" -> pure Error
     "2" -> pure Warning
     "warning" -> pure Warning
     "" -> pure Error
     _ -> do
-      putStrLn "Please type \"error\" or \"warning\" or a number."
+      outputStrLn "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 :: Severity -> ToolM (Maybe WarningFlag)
 readWarningFlag Warning = do
-  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
+  outputStrLn "· What is the warning flag which enables this warning?"
+  outputStrLn "For example, enter \"-Wtabs\" if you are documenting GHC's warning about tabs in your source file."
+  outputStrLn "You can leave this blank if you're not sure."
+  Just <$> getInputLine' "Input: "
 readWarningFlag _ = pure Nothing
 
 -- Version
 type Version = String
 
-readVersion :: IO Version
+readVersion :: ToolM Version
 readVersion = do
-  putStrLn "· Which version of the tool emitted the numeric code (not the message) for the first time?"
-  putStrLn "Note: For GHC this is most likely 9.6.1."
-  putStr "Input: "
-  getLine
+  outputStrLn "· Which version of the tool emitted the numeric code (not the message) for the first time?"
+  outputStrLn "Note: For GHC this is most likely 9.6.1."
+  getInputLine' "Input: "
 
 -- Examples
 type Examples = [String]
@@ -141,23 +141,21 @@ validateExampleName "" = False
 validateExampleName str@(s : _) = not (any isSpace str) && isLower s
 
 -- | Only ask for examples if the system is GHC.
-readExamples :: Tool -> IO Examples
+readExamples :: Tool -> ToolM Examples
 readExamples GHC = do
-  putStrLn "· How many examples should be generated?"
-  putStr "Input: "
-  ln <- getLine
+  outputStrLn "· How many examples should be generated?"
+  ln <- getInputLine' "Input: "
   case readMaybe ln :: Maybe Int of
     Nothing -> pure []
     Just n -> forM [1 .. n] readExample
 readExamples _ = pure []
 
-readExample :: Int -> IO String
+readExample :: Int -> ToolM String
 readExample i = do
-  putStrLn ""
-  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
+  outputStrLn ""
+  outputStrLn ("· Give a name for example " <> show i)
+  outputStrLn "The name should begin with a lowercase letter and should not contain any spaces."
+  ln <- getInputLine' "Input: "
   if validateExampleName ln then pure ln else readExample i
 
 -- Template
@@ -173,25 +171,25 @@ data Template = MkTemplate
   }
   deriving (Show)
 
-readTemplate :: IO Template
+readTemplate :: ToolM Template
 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 ""
+  outputStrLn "This tool helps you create the scaffolding for a new error message on the error-message-index."
+  outputStrLn "You can leave any of the text fields blank and fill them in by hand later."
+  outputStrLn ""
   sys <- readTool
-  putStrLn ""
+  outputStrLn ""
   code <- readCode
-  putStrLn ""
+  outputStrLn ""
   title <- readTitle
-  putStrLn ""
+  outputStrLn ""
   summary <- readSummary
-  putStrLn ""
+  outputStrLn ""
   severity <- readSeverity
-  putStrLn ""
+  outputStrLn ""
   warningflag <- readWarningFlag severity
-  putStrLn ""
+  outputStrLn ""
   version <- readVersion
-  putStrLn ""
+  outputStrLn ""
   examples <- readExamples sys
   pure (MkTemplate sys code title summary severity warningflag version examples)
 
@@ -200,7 +198,7 @@ readTemplate = do
 -------------------------------------------------------------------------------
 
 createFiles :: Template -> IO ()
-createFiles tmpl = do
+createFiles tmpl = liftIO $ do
   putStrLn ""
   putStrLn "· Creating scaffolding..."
 
@@ -268,5 +266,5 @@ createFiles tmpl = do
 main :: IO ()
 main = do
   hSetBuffering stdout NoBuffering
-  tmpl <- readTemplate
+  tmpl <- runInputT defaultSettings readTemplate
   createFiles tmpl

test/create-message-template/golden1.expected.txt

@@ -27,10 +27,10 @@ Input:
 · How many examples should be generated?
 Input: 
 · Give a name for example 1
-The name should not contain spaces and begin with a lowercase letter.
+The name should begin with a lowercase letter and should not contain any spaces.
 Input: 
 · Give a name for example 2
-The name should not contain spaces and begin with a lowercase letter.
+The name should begin with a lowercase letter and should not contain any spaces.
 Input: 
 · Creating scaffolding...
 ·· Created file messages/GHC-101010/index.md with these contents: