Inidication that a field is optional for cabal init prompts

Author: ptkato

cabal-install/src/Distribution/Client/Init/FlagExtractors.hs

@@ -220,19 +220,19 @@ simpleProjectPrompt :: Interactive m => InitFlags -> m Bool
 simpleProjectPrompt flags = getSimpleProject flags $
     promptYesNo
       "Should I generate a simple project with sensible defaults"
-      (Just True)
+      (DefaultPrompt True)
 
 initializeTestSuitePrompt :: Interactive m => InitFlags -> m Bool
 initializeTestSuitePrompt flags = getInitializeTestSuite flags $
     promptYesNo
       "Should I generate a test suite for the library"
-      (Just True)
+      (DefaultPrompt True)
 
 packageTypePrompt :: Interactive m => InitFlags -> m PackageType
 packageTypePrompt flags = getPackageType flags $ do
     pt <- promptList "What does the package build"
       packageTypes
-      (Just "Executable")
+      (DefaultPrompt "Executable")
       Nothing
       False
 
@@ -256,7 +256,7 @@ testMainPrompt :: Interactive m => m HsFilePath
 testMainPrompt = do
     fp <- promptList "What is the main module of the test suite?"
       [defaultMainIs', "Main.lhs"]
-      (Just defaultMainIs')
+      (DefaultPrompt defaultMainIs')
       Nothing
       True
 

cabal-install/src/Distribution/Client/Init/Interactive/Command.hs

@@ -264,7 +264,7 @@ cabalVersionPrompt :: Interactive m => InitFlags -> m CabalSpecVersion
 cabalVersionPrompt flags = getCabalVersion flags $ do
     v <- promptList "Please choose version of the Cabal specification to use"
       ppVersions
-      (Just ppDefault)
+      (DefaultPrompt ppDefault)
       (Just takeVersion)
       False
     -- take just the version numbers for convenience
@@ -301,12 +301,12 @@ packageNamePrompt srcDb flags = getPackageName flags $ do
         Flag b -> return $ filePathToPkgName b
         NoFlag -> currentDirPkgName
 
-    go $ Just defName
+    go $ DefaultPrompt defName
   where
     go defName = prompt "Package name" defName >>= \n ->
       if isPkgRegistered n
       then do
-        don'tUseName <- promptYesNo (promptOtherNameMsg n) (Just True)
+        don'tUseName <- promptYesNo (promptOtherNameMsg n) (DefaultPrompt True)
         if don'tUseName
         then do
           putStrLn (inUseMsg n)
@@ -326,7 +326,7 @@ versionPrompt :: Interactive m => InitFlags -> m Version
 versionPrompt flags = getVersion flags go
   where
     go = do
-      vv <- promptStr "Package version" (Just $ prettyShow defaultVersion)
+      vv <- promptStr "Package version" (DefaultPrompt $ prettyShow defaultVersion)
       case simpleParsec vv of
         Nothing -> do
           putStrLn
@@ -339,7 +339,7 @@ licensePrompt :: Interactive m => InitFlags -> m SPDX.License
 licensePrompt flags = getLicense flags $ do
     l <- promptList "Please choose a license"
       licenses
-      Nothing
+      MandatoryPrompt
       Nothing
       True
 
@@ -353,24 +353,24 @@ licensePrompt flags = getLicense flags $ do
 
 authorPrompt :: Interactive m => InitFlags -> m String
 authorPrompt flags = getAuthor flags $
-    promptStr "Author name" Nothing
+    promptStr "Author name" OptionalPrompt
 
 emailPrompt :: Interactive m => InitFlags -> m String
 emailPrompt flags = getEmail flags $
-    promptStr "Maintainer email" Nothing
+    promptStr "Maintainer email" OptionalPrompt
 
 homepagePrompt :: Interactive m => InitFlags -> m String
 homepagePrompt flags = getHomepage flags $
-    promptStr "Project homepage URL" Nothing
+    promptStr "Project homepage URL" OptionalPrompt
 
 synopsisPrompt :: Interactive m => InitFlags -> m String
 synopsisPrompt flags = getSynopsis flags $
-    promptStr "Project synopsis" Nothing
+    promptStr "Project synopsis" OptionalPrompt
 
 categoryPrompt :: Interactive m => InitFlags -> m String
 categoryPrompt flags = getCategory flags $ promptList
       "Project category" defaultCategories
-      (Just "") (Just matchNone) True
+      (DefaultPrompt "") (Just matchNone) True
   where
     matchNone s
       | null s = "(none)"
@@ -383,7 +383,7 @@ mainFilePrompt flags = getMainFile flags go
     go = do
       fp <- promptList "What is the main module of the executable"
         [defaultMainIs', "Main.lhs"]
-        (Just defaultMainIs')
+        (DefaultPrompt defaultMainIs')
         Nothing
         True
 
@@ -402,14 +402,14 @@ mainFilePrompt flags = getMainFile flags go
 
 testDirsPrompt :: Interactive m => InitFlags -> m [String]
 testDirsPrompt flags = getTestDirs flags $ do
-    dir <- promptStr "Test directory" (Just defaultTestDir)
+    dir <- promptStr "Test directory" (DefaultPrompt defaultTestDir)
     return [dir]
 
 languagePrompt :: Interactive m => InitFlags -> String -> m Language
 languagePrompt flags pkgType = getLanguage flags $ do
     lang <- promptList ("Choose a language for your " ++ pkgType)
       ["Haskell2010", "Haskell98"]
-      (Just "Haskell2010")
+      (DefaultPrompt "Haskell2010")
       Nothing
       True
 
@@ -428,7 +428,7 @@ noCommentsPrompt :: Interactive m => InitFlags -> m Bool
 noCommentsPrompt flags = getNoComments flags $ do
     doComments <- promptYesNo
       "Add informative comments to each field in the cabal file. (y/n)"
-      (Just True)
+      (DefaultPrompt True)
 
     --
     -- if --no-comments is flagged, then we choose not to generate comments
@@ -443,7 +443,7 @@ appDirsPrompt :: Interactive m => InitFlags -> m [String]
 appDirsPrompt flags = getAppDirs flags $ do
     dir <- promptList promptMsg
       [defaultApplicationDir, "exe", "src-exe"]
-      (Just defaultApplicationDir)
+      (DefaultPrompt defaultApplicationDir)
       Nothing
       True
 
@@ -458,7 +458,7 @@ srcDirsPrompt :: Interactive m => InitFlags -> m [String]
 srcDirsPrompt flags = getSrcDirs flags $ do
     dir <- promptList "Library source directory"
       [defaultSourceDir, "lib", "src-lib"]
-      (Just defaultSourceDir)
+      (DefaultPrompt defaultSourceDir)
       Nothing
       True
 

cabal-install/src/Distribution/Client/Init/Prompt.hs

@@ -29,15 +29,15 @@ import Distribution.Client.Init.Types
 
 -- | Create a prompt with optional default value that returns a
 -- String.
-promptStr :: Interactive m => String -> Maybe String -> m String
+promptStr :: Interactive m => String -> DefaultPrompt String -> m String
 promptStr = promptDefault Right id
 
 -- | Create a yes/no prompt with optional default value.
 promptYesNo
     :: Interactive m
     => String
       -- ^ prompt message
-    -> Maybe Bool
+    -> DefaultPrompt Bool
       -- ^ optional default value
     -> m Bool
 promptYesNo =
@@ -53,16 +53,17 @@ promptYesNo =
 
 -- | Create a prompt with optional default value that returns a value
 --   of some Text instance.
-prompt :: (Interactive m, Parsec t, Pretty t) => String -> Maybe t -> m t
+prompt :: (Interactive m, Parsec t, Pretty t) => String -> DefaultPrompt t -> m t
 prompt = promptDefault eitherParsec prettyShow
 
 -- | Create a prompt from a prompt string and a String representation
 --   of an optional default value.
-mkDefPrompt :: String -> Maybe String -> String
+mkDefPrompt :: String -> DefaultPrompt String -> String
 mkDefPrompt msg def = msg ++ "?" ++ format def
   where
-    format Nothing = " "
-    format (Just s) = " [default: " ++ s ++ "] "
+    format MandatoryPrompt = " "
+    format OptionalPrompt = " [optional] "
+    format (DefaultPrompt s) = " [default: " ++ s ++ "] "
 
 -- | Create a prompt from a list of strings
 promptList
@@ -71,7 +72,7 @@ promptList
       -- ^ prompt
     -> [String]
       -- ^ choices
-    -> Maybe String
+    -> DefaultPrompt String
       -- ^ optional default value
     -> Maybe (String -> String)
       -- ^ modify the default value to present in-prompt
@@ -85,7 +86,7 @@ promptList msg choices def modDef hasOther = do
 
   -- Output nicely formatted list of options
   for_ prettyChoices $ \(i,c) -> do
-    let star = if Just c == def
+    let star = if DefaultPrompt c == def
           then "*"
           else " "
 
@@ -125,13 +126,13 @@ promptList msg choices def modDef hasOther = do
 
      input <- getLine
      case def of
-       Just d | null input -> return d
+       DefaultPrompt d | null input -> return d
        _ -> case readMaybe input of
          Nothing -> invalidChoice input
          Just n
            | n > 0, n <= numChoices -> return $ choices !! (n-1)
            | n == numChoices + 1, hasOther ->
-             promptStr "Please specify" Nothing
+             promptStr "Please specify" OptionalPrompt
            | otherwise -> invalidChoice (show n)
 
 -- | Create a prompt with an optional default value.
@@ -143,14 +144,14 @@ promptDefault
       -- ^ pretty-printer
     -> String
       -- ^ prompt message
-    -> Maybe t
+    -> (DefaultPrompt t)
       -- ^ optional default value
     -> m t
 promptDefault parse pprint msg def = do
   putStr $ mkDefPrompt msg (pprint <$> def)
   input <- getLine
   case def of
-    Just d | null input  -> return d
+    DefaultPrompt d | null input  -> return d
     _  -> case parse input of
       Right t  -> return t
       Left err -> do

cabal-install/src/Distribution/Client/Init/Types.hs

@@ -45,6 +45,8 @@ module Distribution.Client.Init.Types
 , ProjectSettings(..)
   -- * Formatters
 , FieldAnnotation(..)
+  -- * Other conveniences
+, DefaultPrompt(..)
 ) where
 
 
@@ -422,6 +424,14 @@ type IsLiterate = Bool
 --
 type IsSimple = Bool
 
+-- | Defines whether or not a prompt will have a default value,
+--   is optional, or is mandatory.
+data DefaultPrompt t
+  = DefaultPrompt t
+  | OptionalPrompt
+  | MandatoryPrompt
+  deriving (Eq, Functor)
+
 -- -------------------------------------------------------------------- --
 -- Field annotation for pretty formatters