Improve arg parsing error messages

src/Shrun/Configuration/Args/Parsing/ConsoleLogging.hs

@@ -101,7 +101,7 @@ lineTruncParser = Utils.withDisabledParser mainParser "console-log-line-trunc"
           ( mconcat
               [ OA.long "console-log-line-trunc",
                 Utils.mkHelp helpTxt,
-                OA.metavar "(NATURAL | detect)"
+                OA.metavar Trunc.lineTruncStr
               ]
           )
     helpTxt =
@@ -124,7 +124,7 @@ stripControlParser =
           ( mconcat
               [ OA.long "console-log-strip-control",
                 Utils.mkHelp helpTxt,
-                OA.metavar "(all | smart | none)"
+                OA.metavar StripControl.stripControlStr
               ]
           )
     helpTxt =

src/Shrun/Configuration/Args/Parsing/Core.hs

@@ -62,7 +62,7 @@ timeoutParser = Utils.withDisabledParser mainParser "timeout"
               [ OA.long "timeout",
                 OA.short 't',
                 Utils.mkHelp helpTxt,
-                OA.metavar "(NATURAL | STRING)"
+                OA.metavar Timeout.timeoutStr
               ]
           )
     helpTxt =

src/Shrun/Configuration/Args/Parsing/FileLogging.hs

@@ -137,7 +137,7 @@ lineTruncParser = Utils.withDisabledParser mainParser "file-log-line-trunc"
           ( mconcat
               [ OA.long "file-log-line-trunc",
                 Utils.mkHelp helpTxt,
-                OA.metavar "(NATURAL | detect)"
+                OA.metavar Trunc.lineTruncStr
               ]
           )
     helpTxt = "Like --console-log-line-trunc, but for --file-log."
@@ -153,7 +153,7 @@ fileLogStripControlParser =
           ( mconcat
               [ OA.long "file-log-strip-control",
                 Utils.mkHelp helpTxt,
-                OA.metavar "(all | smart | none)"
+                OA.metavar StripControl.stripControlStr
               ]
           )
     helpTxt =
@@ -192,7 +192,7 @@ fileLogSizeModeParser = Utils.withDisabledParser mainParser "file-log-size-mode"
           ( mconcat
               [ OA.long "file-log-size-mode",
                 Utils.mkHelp helpTxt,
-                OA.metavar FileSizeMode.expectedStr
+                OA.metavar FileSizeMode.fileSizeModeStr
               ]
           )
     helpTxt =

src/Shrun/Configuration/Data/CommandLogging/ReadStrategy.hs

@@ -11,6 +11,7 @@ where
 
 import Shrun.Data.Command (CommandP1)
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | Different read strategies for simplicity vs. potential prettier
 -- formatting.
@@ -42,14 +43,12 @@ parseReadStrategy getTxt =
   getTxt >>= \case
     "block" -> pure ReadBlock
     "block-line-buffer" -> pure ReadBlockLineBuffer
-    other ->
+    bad ->
       fail
-        $ mconcat
-          [ "Unrecognized read strategy: '",
-            unpack other,
-            "'. Expected one of ",
-            readStrategyStr
-          ]
+        $ Utils.fmtUnrecognizedError
+          "read strategy"
+          readStrategyStr
+          (unpack bad)
 {-# INLINEABLE parseReadStrategy #-}
 
 -- | Available 'ReadStrategy' strings.

src/Shrun/Configuration/Data/ConsoleLogging/TimerFormat.hs

@@ -27,6 +27,7 @@ import Data.Time.Relative qualified as RT
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Data.Text (UnlinedText (UnsafeUnlinedText))
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | Determines how to format the timer.
 data TimerFormat
@@ -50,7 +51,12 @@ parseTimerFormat getTxt =
     "digital_full" -> pure DigitalFull
     "prose_compact" -> pure ProseCompact
     "prose_full" -> pure ProseFull
-    bad -> fail $ "Unrecognized timer-format: " <> unpack bad
+    bad ->
+      fail
+        $ Utils.fmtUnrecognizedError
+          "timer format"
+          timerFormatStr
+          (unpack bad)
 {-# INLINEABLE parseTimerFormat #-}
 
 -- | Available 'TimerFormat' strings.

src/Shrun/Configuration/Data/Core/Timeout.hs

@@ -5,11 +5,13 @@ module Shrun.Configuration.Data.Core.Timeout
   ( Timeout (..),
     parseTimeout,
     parseTimeoutStr,
+    timeoutStr,
   )
 where
 
 import Data.Time.Relative qualified as RT
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | Represents a timeout, which is a non-negative integer.
 newtype Timeout = MkTimeout
@@ -45,7 +47,15 @@ parseTimeout getNat getTxt =
 parseTimeoutStr :: (MonadFail f) => Text -> f Timeout
 parseTimeoutStr txt = case RT.fromString str of
   Right n -> pure $ MkTimeout $ RT.toSeconds n
-  Left err -> fail $ "Error reading time string: " <> err
+  Left bad ->
+    fail
+      $ Utils.fmtUnrecognizedError
+        "timeout"
+        timeoutStr
+        bad
   where
     str = unpack txt
 {-# INLINEABLE parseTimeoutStr #-}
+
+timeoutStr :: String
+timeoutStr = "(NATURAL | STRING)"

src/Shrun/Configuration/Data/FileLogging/FileSizeMode.hs

@@ -1,7 +1,7 @@
 module Shrun.Configuration.Data.FileLogging.FileSizeMode
   ( FileSizeMode (..),
     parseFileSizeMode,
-    expectedStr,
+    fileSizeModeStr,
   )
 where
 
@@ -12,6 +12,7 @@ import Data.Text qualified as T
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Prelude
 import Shrun.Utils qualified as U
+import Shrun.Utils qualified as Utils
 
 -- | Determines what to do if the log file surpasses the given size
 -- threshold.
@@ -39,13 +40,10 @@ parseFileSizeMode getTxt = do
         "delete" -> pure FileSizeModeDelete
         bad ->
           fail
-            $ mconcat
-              [ "Expected file-log-size-mode as one of ",
-                expectedStr,
-                " received: '",
-                unpack bad,
-                "'"
-              ]
+            $ Utils.fmtUnrecognizedError
+              "size mode"
+              fileSizeModeStr
+              (unpack bad)
       case U.parseByteText byteTxt of
         Right b -> pure $ cons b
         Left err -> fail $ "Could not parse --file-log-size-mode size: " <> unpack err
@@ -57,5 +55,5 @@ instance Default FileSizeMode where
       defBytes :: Bytes M Natural
       defBytes = MkBytes 50
 
-expectedStr :: String
-expectedStr = "(warn BYTES | delete BYTES | nothing)"
+fileSizeModeStr :: String
+fileSizeModeStr = "(warn BYTES | delete BYTES | nothing)"

src/Shrun/Configuration/Data/Notify/Action.hs

@@ -6,8 +6,8 @@ module Shrun.Configuration.Data.Notify.Action
   )
 where
 
-import Data.Text qualified as T
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | Determines for which actions we should send notifications.
 data NotifyAction
@@ -29,14 +29,12 @@ parseNotifyAction getTxt =
     "final" -> pure NotifyFinal
     "command" -> pure NotifyCommand
     "all" -> pure NotifyAll
-    other ->
+    bad ->
       fail
-        $ mconcat
-          [ "Unrecognized notify action: '",
-            T.unpack other,
-            "'. Expected one of ",
-            notifyActionStr
-          ]
+        $ Utils.fmtUnrecognizedError
+          "notify action"
+          notifyActionStr
+          (unpack bad)
 {-# INLINEABLE parseNotifyAction #-}
 
 -- | Available 'NotifyAction' strings.

src/Shrun/Configuration/Data/Notify/System.hs

@@ -23,7 +23,6 @@ module Shrun.Configuration.Data.Notify.System
 where
 
 import DBus.Client (Client)
-import Data.Text qualified as T
 import Shrun.Configuration.Data.ConfigPhase
   ( ConfigPhase
       ( ConfigPhaseArgs,
@@ -37,6 +36,7 @@ import Shrun.Configuration.Data.WithDisabled
   )
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | Maps DBus to its phased param.
 type DBusF :: ConfigPhase -> Type
@@ -113,14 +113,12 @@ parseNotifySystem getTxt =
     "dbus" -> pure $ DBus ()
     "notify-send" -> pure NotifySend
     "apple-script" -> pure AppleScript
-    other ->
+    bad ->
       fail
-        $ mconcat
-          [ "Unrecognized notify system: '",
-            T.unpack other,
-            "'. Expected one of ",
-            notifySystemStr
-          ]
+        $ Utils.fmtUnrecognizedError
+          "notify system"
+          notifySystemStr
+          (unpack bad)
 {-# INLINEABLE parseNotifySystem #-}
 
 -- | Available 'NotifySystem' strings.

src/Shrun/Configuration/Data/Notify/Timeout.hs

@@ -12,6 +12,7 @@ import GHC.Num (Num (fromInteger))
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Prelude
 import Shrun.Utils qualified as U
+import Shrun.Utils qualified as Utils
 import TOML (Value (Integer, String))
 
 -- | Determines notification timeout.
@@ -37,19 +38,39 @@ instance DecodeTOML NotifyTimeout where
     String bad -> invalidValue strErr (String bad)
     Integer i -> case toIntegralSized i of
       Just i' -> pure $ NotifyTimeoutSeconds i'
-      Nothing -> invalidValue tooLargeErr (Integer i)
+      Nothing -> invalidValue (tooLargeErr Nothing) (Integer i)
     badTy -> typeMismatch badTy
     where
-      tooLargeErr = "Timeout integer too large. Max is: " <> showt maxW16
       strErr = "Unexpected timeout. Only valid string is 'never'."
-      maxW16 = maxBound @Word16
+
+tooLargeErr :: Maybe Integer -> Text
+tooLargeErr Nothing = "Timeout integer too large. Max is: " <> showt maxW16
+tooLargeErr (Just i) =
+  mconcat
+    [ "Timeout integer '",
+      showt i,
+      "' too large. Max is: ",
+      showt maxW16
+    ]
+
+maxW16 :: Word16
+maxW16 = maxBound
 
 -- | Parses 'NotifyTimeout'.
 parseNotifyTimeout :: (MonadFail m) => m Text -> m NotifyTimeout
 parseNotifyTimeout getTxt =
   getTxt >>= \case
     "never" -> pure NotifyTimeoutNever
-    other -> NotifyTimeoutSeconds <$> U.readStripUnderscores other
+    other -> case U.readStripUnderscores @_ @Integer other of
+      Just nInt -> case toIntegralSized nInt of
+        Just nW16 -> pure $ NotifyTimeoutSeconds nW16
+        Nothing -> fail (unpack $ tooLargeErr (Just nInt))
+      Nothing ->
+        fail
+          $ Utils.fmtUnrecognizedError
+            "notify timeout"
+            notifyTimeoutStr
+            (unpack other)
 {-# INLINEABLE parseNotifyTimeout #-}
 
 -- | Available 'NotifyTimeout' strings.

src/Shrun/Configuration/Data/StripControl.hs

@@ -3,11 +3,13 @@ module Shrun.Configuration.Data.StripControl
     parseStripControl,
     ConsoleLogStripControl,
     FileLogStripControl,
+    stripControlStr,
   )
 where
 
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 data StripControlType
   = StripControlConsoleLog
@@ -41,13 +43,16 @@ parseStripControl getTxt =
     "smart" -> pure StripControlSmart
     bad ->
       fail
-        $ mconcat
-          [ "Wanted one of (all|none|smart), received: ",
-            unpack bad
-          ]
+        $ Utils.fmtUnrecognizedError
+          "strip control"
+          stripControlStr
+          (unpack bad)
 
 instance Default ConsoleLogStripControl where
   def = StripControlSmart
 
 instance Default FileLogStripControl where
   def = StripControlAll
+
+stripControlStr :: String
+stripControlStr = "(all | none | smart)"

src/Shrun/Configuration/Data/Truncation.hs

@@ -11,6 +11,7 @@ module Shrun.Configuration.Data.Truncation
     decodeCommandNameTrunc,
     decodeLineTrunc,
     configToLineTrunc,
+    lineTruncStr,
   )
 where
 
@@ -23,6 +24,7 @@ import Shrun.Configuration.Data.WithDisabled
       ),
   )
 import Shrun.Prelude
+import Shrun.Utils qualified as Utils
 
 -- | The different regions to apply truncation rules.
 data TruncRegion
@@ -77,16 +79,29 @@ parseLineTruncation ::
 parseLineTruncation getNat getTxt =
   Undetected
     <$> parseTruncation getNat
+    -- NOTE: [Detect second parser]
     <|> parseDetected getTxt
 {-# INLINEABLE parseLineTruncation #-}
 
+-- Because this parser is used second, its error message is what will be
+-- displayed.
+--
+-- see NOTE: [Detect second parser]
 parseDetected :: (MonadFail m) => m Text -> m LineTruncation
 parseDetected getTxt =
   getTxt >>= \case
     "detect" -> pure Detected
-    other -> fail $ "Wanted other, received: " <> unpack other
+    bad ->
+      fail
+        $ Utils.fmtUnrecognizedError
+          "line truncation"
+          lineTruncStr
+          (unpack bad)
 {-# INLINEABLE parseDetected #-}
 
+lineTruncStr :: String
+lineTruncStr = "(NATURAL | detect)"
+
 decodeCommandNameTrunc :: Decoder (Maybe (Truncation TruncCommandName))
 decodeCommandNameTrunc = getFieldOptWith tomlDecoder "command-name-trunc"
 

src/Shrun/Utils.hs

@@ -330,16 +330,17 @@ fmtUnrecognizedError ::
   a ->
   -- | Valid values.
   a ->
-  -- | Bad unrecognized value.
+  -- | Bad unrecognized value or error message.
   a ->
   -- | Error message.
   a
 fmtUnrecognizedError fieldName validVals badValue =
   mconcat
-    [ "Unrecognized ",
+    [ "Error parsing ",
       fieldName,
       ": '",
       badValue,
       "'. Expected one of ",
-      validVals
+      validVals,
+      "."
     ]