From 724995b12c32e68b493365e5ebe98b4ff50ee886 Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 09:53:29 +0200 Subject: [PATCH 1/7] Transform create-message-template to a cabal script --- message-index/create-message-template.hs | 4 ++++ 1 file changed, 4 insertions(+) mode change 100644 => 100755 message-index/create-message-template.hs diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs old mode 100644 new mode 100755 index 3b30097a..f8d8a0da --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -1,3 +1,7 @@ +#!/usr/bin/env cabal +{- cabal: +build-depends: base, haskeline, directory, filepath +-} module Main where import Control.Monad (forM, forM_) From 52f8bac5e4414cc9a788fddfff41ddd84ea56823 Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 10:33:44 +0200 Subject: [PATCH 2/7] Use InputT monad transformer instead of IO --- message-index/create-message-template.hs | 141 +++++++++++------------ 1 file changed, 69 insertions(+), 72 deletions(-) diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs index f8d8a0da..97d74c69 100755 --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -5,18 +5,15 @@ build-depends: base, haskeline, directory, filepath module Main where import Control.Monad (forM, forM_) +import Control.Monad.IO.Class (liftIO) import Data.Char (isLower, isSpace, toLower, toUpper) import System.Directory (createDirectory, createDirectoryIfMissing) import System.FilePath ((<.>), ()) +import System.Console.Haskeline 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 ------------------------------------------------------------------------------- -- Querying the user about the diagnostic @@ -33,15 +30,15 @@ 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" + outputStr "Input (Default = GHC): " + ln <- liftIO $ getLine case normalize ln of "1" -> pure GHC "ghc" -> pure GHC @@ -53,7 +50,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 @@ -62,48 +59,48 @@ 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." + outputStr "Input: " + ln <- liftIO getLine 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." + outputStr "Input: " + liftIO getLine -- 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." + outputStr "Input: " + liftIO getLine -- 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" + outputStr "Input (Default = Error): " + ln <- liftIO getLine case normalize ln of "1" -> pure Error "error" -> pure Error @@ -111,31 +108,31 @@ readSeverity = do "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." + outputStr "Input: " + Just <$> liftIO getLine 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." + outputStr "Input: " + liftIO getLine -- Examples type Examples = [String] @@ -145,23 +142,23 @@ 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?" + outputStr "Input: " + ln <- liftIO getLine 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 not contain spaces and begin with a lowercase letter." + outputStr "Input: " + ln <- liftIO getLine if validateExampleName ln then pure ln else readExample i -- Template @@ -177,25 +174,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) @@ -204,7 +201,7 @@ readTemplate = do ------------------------------------------------------------------------------- createFiles :: Template -> IO () -createFiles tmpl = do +createFiles tmpl = liftIO $ do putStrLn "" putStrLn "· Creating scaffolding..." @@ -272,5 +269,5 @@ createFiles tmpl = do main :: IO () main = do hSetBuffering stdout NoBuffering - tmpl <- readTemplate + tmpl <- runInputT defaultSettings readTemplate createFiles tmpl From d16473416216967b31ca16982700eededda15b16 Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 10:42:35 +0200 Subject: [PATCH 3/7] Use getInputLine instead of readline --- message-index/create-message-template.hs | 32 +++++++++++------------- 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs index 97d74c69..4274fcc2 100755 --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -15,6 +15,11 @@ import Text.Read (readMaybe) type ToolM a = InputT IO a +getInputLine' :: String -> ToolM String +getInputLine' s = do + ln <- getInputLine s + pure (maybe "" id ln) + ------------------------------------------------------------------------------- -- Querying the user about the diagnostic ------------------------------------------------------------------------------- @@ -37,8 +42,7 @@ readTool = do outputStrLn " 2) GHCup" outputStrLn " 3) Stack" outputStrLn " 4) Cabal" - outputStr "Input (Default = GHC): " - ln <- liftIO $ getLine + ln <- getInputLine' "Input (Default = GHC): " case normalize ln of "1" -> pure GHC "ghc" -> pure GHC @@ -63,8 +67,7 @@ readCode :: ToolM ErrorCode readCode = do outputStrLn "· What is the numeric code that you want to document?" outputStrLn "For example, enter \"01234\" if you want to document GHC-01234." - outputStr "Input: " - ln <- liftIO getLine + ln <- getInputLine' "Input: " case readMaybe ln :: Maybe Int of Nothing -> do outputStrLn "Could not parse the input as an integer. Only enter the numeric part of the error." @@ -78,8 +81,7 @@ readTitle :: ToolM Title readTitle = do 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." - outputStr "Input: " - liftIO getLine + getInputLine' "Input: " -- Summary type Summary = String @@ -88,8 +90,7 @@ readSummary :: ToolM Summary readSummary = do outputStrLn "· Give a short summary of the error message." outputStrLn "This appears on the overview page that lists all the documented errors and warnings." - outputStr "Input: " - liftIO getLine + getInputLine' "Input: " -- Severity data Severity = Error | Warning deriving (Show) @@ -99,8 +100,7 @@ readSeverity = do outputStrLn "· What is the severity of the diagnostic?" outputStrLn " 1) Error" outputStrLn " 2) Warning" - outputStr "Input (Default = Error): " - ln <- liftIO getLine + ln <- getInputLine' "Input (Default = Error): " case normalize ln of "1" -> pure Error "error" -> pure Error @@ -120,8 +120,7 @@ readWarningFlag Warning = do 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." - outputStr "Input: " - Just <$> liftIO getLine + Just <$> getInputLine' "Input: " readWarningFlag _ = pure Nothing -- Version @@ -131,8 +130,7 @@ readVersion :: ToolM Version readVersion = do 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." - outputStr "Input: " - liftIO getLine + getInputLine' "Input: " -- Examples type Examples = [String] @@ -145,8 +143,7 @@ validateExampleName str@(s : _) = not (any isSpace str) && isLower s readExamples :: Tool -> ToolM Examples readExamples GHC = do outputStrLn "· How many examples should be generated?" - outputStr "Input: " - ln <- liftIO getLine + ln <- getInputLine' "Input: " case readMaybe ln :: Maybe Int of Nothing -> pure [] Just n -> forM [1 .. n] readExample @@ -157,8 +154,7 @@ readExample i = do outputStrLn "" outputStrLn ("· Give a name for example " <> show i) outputStrLn "The name should not contain spaces and begin with a lowercase letter." - outputStr "Input: " - ln <- liftIO getLine + ln <- getInputLine' "Input: " if validateExampleName ln then pure ln else readExample i -- Template From af0d7366e7891e1aa052ada34878eb31edeeb1b2 Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 10:49:28 +0200 Subject: [PATCH 4/7] Fix hlint suggestion and update CONTRIBUTING.md --- CONTRIBUTING.md | 2 +- message-index/create-message-template.hs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b5f537a4..a0418900 100644 --- a/CONTRIBUTING.md +++ b/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 diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs index 4274fcc2..bf72ae77 100755 --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -7,9 +7,10 @@ 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.Console.Haskeline import System.IO (BufferMode (..), hSetBuffering, stdout) import Text.Read (readMaybe) @@ -18,7 +19,7 @@ type ToolM a = InputT IO a getInputLine' :: String -> ToolM String getInputLine' s = do ln <- getInputLine s - pure (maybe "" id ln) + pure (fromMaybe "" ln) ------------------------------------------------------------------------------- -- Querying the user about the diagnostic From ebd11e37c2995e8213475780231399a9743cab34 Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 16:45:01 +0200 Subject: [PATCH 5/7] Add some lower bounds --- message-index/create-message-template.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs index bf72ae77..e6a9eba4 100755 --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -1,6 +1,6 @@ #!/usr/bin/env cabal {- cabal: -build-depends: base, haskeline, directory, filepath +build-depends: base, haskeline >=0.8, directory >= 1.3, filepath >= 1.4 -} module Main where From 28cdf4f5e485dbb947beea85a2ce739054adda0b Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 23:15:44 +0200 Subject: [PATCH 6/7] Update message-index/create-message-template.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- message-index/create-message-template.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/message-index/create-message-template.hs b/message-index/create-message-template.hs index e6a9eba4..6d83388b 100755 --- a/message-index/create-message-template.hs +++ b/message-index/create-message-template.hs @@ -154,7 +154,7 @@ readExample :: Int -> ToolM String readExample i = do outputStrLn "" outputStrLn ("· Give a name for example " <> show i) - outputStrLn "The name should not contain spaces and begin with a lowercase letter." + 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 From 8924f197fa021aacbe694292adf7c6519c685aca Mon Sep 17 00:00:00 2001 From: David Binder Date: Sat, 8 Jun 2024 23:20:59 +0200 Subject: [PATCH 7/7] Fix golden test --- test/create-message-template/golden1.expected.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/create-message-template/golden1.expected.txt b/test/create-message-template/golden1.expected.txt index cd36627f..d2e77bc5 100644 --- a/test/create-message-template/golden1.expected.txt +++ b/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: