Merge pull request #6727 from commercialhaskell/pvpBounds

Reduce code duplication, re pvpBoundsParser

Author: mpilgrem

package.yaml

@@ -243,6 +243,7 @@ library:
   - Stack.Options.NixParser
   - Stack.Options.PackageParser
   - Stack.Options.PathParser
+  - Stack.Options.PvpBoundsParser
   - Stack.Options.SDistParser
   - Stack.Options.ScriptParser
   - Stack.Options.SetupParser

src/Stack/Options/HpcReportParser.hs

@@ -2,26 +2,23 @@
 
 {-|
 Module      : Stack.Options.HpcReportParser
+Description : Parser for @stack hpc report@.
 License     : BSD-3-Clause
+
+Parser for @stack hpc report@.
 -}
 
 module Stack.Options.HpcReportParser
   ( hpcReportOptsParser
-  , pvpBoundsOption
   ) where
 
-import qualified Data.Text as T
 import           Options.Applicative
-                   ( Parser, completer, completeWith, help, long, metavar
-                   , option, readerError, strOption, switch
-                   )
+                   ( Parser, completer, help, long, metavar, strOption, switch )
 import           Options.Applicative.Builder.Extra
                    ( dirCompleter, fileExtCompleter, textArgument )
-import           Options.Applicative.Types ( readerAsk )
 import           Stack.Coverage ( HpcReportOpts (..) )
 import           Stack.Options.Completion ( targetCompleter )
 import           Stack.Prelude
-import           Stack.Types.PvpBounds ( PvpBounds, parsePvpBounds )
 
 -- | Parser for @stack hpc report@.
 hpcReportOptsParser :: Parser HpcReportOpts
@@ -45,18 +42,3 @@ hpcReportOptsParser = HpcReportOpts
         (  long "open"
         <> help "Open the report in the browser."
         )
-
-pvpBoundsOption :: Parser PvpBounds
-pvpBoundsOption = option readPvpBounds
-  (  long "pvp-bounds"
-  <> metavar "PVP-BOUNDS"
-  <> completeWith ["none", "lower", "upper", "both"]
-  <> help "How PVP version bounds should be added to Cabal file: none, lower, \
-          \upper, both."
-  )
- where
-  readPvpBounds = do
-    s <- readerAsk
-    case parsePvpBounds $ T.pack s of
-      Left e -> readerError e
-      Right v -> pure v

src/Stack/Options/PvpBoundsParser.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+Module      : Stack.Options.PvpBoundsParser
+Description : Parser for PVP bounds.
+License     : BSD-3-Clause
+
+Parser for PVP bounds.
+-}
+
+module Stack.Options.PvpBoundsParser
+  ( pvpBoundsParser
+  ) where
+
+import qualified Data.Text as T
+import           Options.Applicative
+                   ( Parser, completeWith, help, long, metavar, option
+                   , readerError
+                   )
+import           Options.Applicative.Types ( readerAsk )
+import           Stack.Prelude
+import           Stack.Types.PvpBounds ( PvpBounds (..), parsePvpBounds )
+
+-- | Parser for PVP bounds.
+pvpBoundsParser ::
+     Maybe Text
+     -- ^ Optional context for the option's help message.
+  -> Parser PvpBounds
+pvpBoundsParser context = option readPvpBounds
+  (  long "pvp-bounds"
+  <> metavar "PVP-BOUNDS"
+  <> completeWith ["none", "lower", "upper", "both"]
+  <> help (T.unpack helpMsg)
+  )
+ where
+  readPvpBounds = do
+    s <- readerAsk
+    case parsePvpBounds $ T.pack s of
+      Left e -> readerError e
+      Right v -> pure v
+  helpMsg =
+       helpMsgPrefix
+    <> " PVP version bounds should be added to Cabal file: none, lower, upper, \
+       \both."
+  helpMsgPrefix = maybe "How" (<> ", how") context

src/Stack/Options/SDistParser.hs

@@ -2,11 +2,10 @@
 
 {-|
 Module      : Stack.Options.SDistParser
-Description : Parse arguments for Stack's @sdist@ and @upload@ commands.
+Description : Parse arguments for Stack's @sdist@ command.
 License     : BSD-3-Clause
 
-Functions to parse command line arguments for Stack's @sdist@ and @upload@
-commands.
+Functions to parse command line arguments for Stack's @sdist@ command.
 -}
 
 module Stack.Options.SDistParser
@@ -20,9 +19,9 @@ import           Options.Applicative
 import           Options.Applicative.Builder.Extra ( boolFlags, dirCompleter )
 import           Stack.Prelude
 import           Stack.SDist ( SDistOpts (..) )
-import           Stack.Options.HpcReportParser ( pvpBoundsOption )
+import           Stack.Options.PvpBoundsParser ( pvpBoundsParser )
 
--- | Parse command line arguments for Stack's @sdist@ and @upload@ commands.
+-- | Parse command line arguments for Stack's @sdist@ command.
 sdistOptsParser :: Parser SDistOpts
 sdistOptsParser = SDistOpts
   <$> many (strArgument
@@ -31,7 +30,7 @@ sdistOptsParser = SDistOpts
         <> help "A relative path to a package directory. Can be specified \
                 \multiple times. If none specified, use all project packages."
         ))
-  <*> optional pvpBoundsOption
+  <*> optional (pvpBoundsParser Nothing)
   <*> ignoreCheckSwitch
   <*> buildPackageOption
   <*> optional (strOption

src/Stack/Options/UploadParser.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 {-|
 Module      : Stack.Options.UploadParser
@@ -12,25 +13,22 @@ module Stack.Options.UploadParser
   ( uploadOptsParser
   ) where
 
-import qualified Data.Text as T
 import           Options.Applicative
-                   ( Parser, completeWith, completer, flag, help, idm, long
-                   , metavar, option, readerError, short, strArgument, strOption
-                   , switch
+                   ( Parser, completer, flag, help, idm, long, metavar, short
+                   , strArgument, strOption, switch
                    )
 import           Options.Applicative.Builder.Extra
                    ( boolFlags, dirCompleter, firstBoolFlagsTrue )
-import           Options.Applicative.Types ( readerAsk )
+import           Stack.Options.PvpBoundsParser ( pvpBoundsParser )
 import           Stack.Prelude
 import           Stack.Upload ( UploadOpts (..), UploadVariant (..) )
-import           Stack.Types.PvpBounds ( PvpBounds (..), parsePvpBounds )
 
 -- | Parse command line arguments for Stack's @upload@ command.
 uploadOptsParser :: Parser UploadOpts
 uploadOptsParser = UploadOpts
   <$> itemsToWorkWithParser
   <*> documentationParser
-  <*> optional pvpBoundsOption
+  <*> optional (pvpBoundsParser (Just "For package upload"))
   <*> ignoreCheckSwitch
   <*> buildPackageOption
   <*> tarDirParser
@@ -48,20 +46,6 @@ uploadOptsParser = UploadOpts
     <> short 'd'
     <> help "Upload documentation for packages (not packages)."
     )
-  pvpBoundsOption :: Parser PvpBounds
-  pvpBoundsOption = option readPvpBounds
-    (  long "pvp-bounds"
-    <> metavar "PVP-BOUNDS"
-    <> completeWith ["none", "lower", "upper", "both"]
-    <> help "For package upload, how PVP version bounds should be added to \
-            \Cabal file: none, lower, upper, both."
-    )
-   where
-    readPvpBounds = do
-      s <- readerAsk
-      case parsePvpBounds $ T.pack s of
-        Left e -> readerError e
-        Right v -> pure v
   ignoreCheckSwitch = switch
       (  long "ignore-check"
       <> help "Do not check packages, for upload, for common mistakes."

stack.cabal

@@ -279,6 +279,7 @@ library
       Stack.Options.NixParser
       Stack.Options.PackageParser
       Stack.Options.PathParser
+      Stack.Options.PvpBoundsParser
       Stack.Options.SDistParser
       Stack.Options.ScriptParser
       Stack.Options.SetupParser