{-# LANGUAGE LambdaCase #-}
module Distribution.Client.Init.FlagExtractors
( -- * Flag extractors
  getPackageDir
, getSimpleProject
, getMinimal
, getCabalVersion
, getCabalVersionNoPrompt
, getPackageName
, getVersion
, getLicense
, getAuthor
, getEmail
, getHomepage
, getSynopsis
, getCategory
, getExtraSrcFiles
, getExtraDocFiles
, getPackageType
, getMainFile
, getInitializeTestSuite
, getTestDirs
, getLanguage
, getNoComments
, getAppDirs
, getSrcDirs
, getExposedModules
, getBuildTools
, getDependencies
, getOtherExts
, getOverwrite
, getOtherModules
  -- * Shared prompts
, simpleProjectPrompt
, initializeTestSuitePrompt
, packageTypePrompt
, testMainPrompt
, dependenciesPrompt
) where


import Prelude ()
import Distribution.Client.Compat.Prelude hiding (putStr, putStrLn, getLine, last)

import qualified Data.List.NonEmpty as NEL

import Distribution.CabalSpecVersion (CabalSpecVersion(..))
import Distribution.Version (Version)
import Distribution.ModuleName (ModuleName)
import Distribution.Types.Dependency (Dependency(..))
import Distribution.Types.PackageName (PackageName)
import Distribution.Client.Init.Defaults
import Distribution.FieldGrammar.Newtypes (SpecLicense)
import Distribution.Client.Init.Types
import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault, flagToMaybe)
import Distribution.Simple.Flag (flagElim)

import Language.Haskell.Extension (Language(..), Extension(..))
import Distribution.Client.Init.Prompt
import qualified Data.Set as Set
import Distribution.Simple.PackageIndex
import Distribution.Client.Init.Utils



-- -------------------------------------------------------------------- --
-- Flag extraction

getPackageDir :: Interactive m => InitFlags -> m FilePath
getPackageDir :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
getPackageDir = forall b a. b -> (a -> b) -> Flag a -> b
flagElim forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag FilePath
packageDir

-- | Ask if a simple project with sensible defaults should be created.
getSimpleProject :: Interactive m => InitFlags -> m Bool -> m Bool
getSimpleProject :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getSimpleProject InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
simpleProject InitFlags
flags)

-- | Extract minimal cabal file flag (implies nocomments)
getMinimal :: Interactive m => InitFlags -> m Bool
getMinimal :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getMinimal = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag Bool
minimal

-- | Get the version of the cabal spec to use.
--
-- The spec version can be specified by the InitFlags cabalVersion field. If
-- none is specified then the user is prompted to pick from a list of
-- supported versions (see code below).
getCabalVersion :: Interactive m => InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags)

getCabalVersionNoPrompt :: InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt :: InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt = forall a. a -> Flag a -> a
fromFlagOrDefault CabalSpecVersion
defaultCabalVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag CabalSpecVersion
cabalVersion

-- | Get the package name: use the package directory (supplied, or the current
--   directory by default) as a guess. It looks at the SourcePackageDb to avoid
--   using an existing package name.
getPackageName :: Interactive m => InitFlags -> m PackageName -> m PackageName
getPackageName :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageName -> m PackageName
getPackageName InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag PackageName
packageName InitFlags
flags)

-- | Package version: use 0.1.0.0 as a last resort, but try prompting the user
--  if possible.
getVersion :: Interactive m => InitFlags -> m Version -> m Version
getVersion :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m Version -> m Version
getVersion InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Version
version InitFlags
flags)

-- | Choose a license for the package.
-- The license can come from Initflags (license field), if it is not present
-- then prompt the user from a predefined list of licenses.
getLicense :: Interactive m => InitFlags -> m SpecLicense -> m SpecLicense
getLicense :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m SpecLicense -> m SpecLicense
getLicense InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag SpecLicense
license InitFlags
flags)

-- | The author's name. Prompt, or try to guess from an existing
--   darcs repo.
getAuthor :: Interactive m => InitFlags -> m String -> m String
getAuthor :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getAuthor InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
author InitFlags
flags)

-- | The author's email. Prompt, or try to guess from an existing
--   darcs repo.
getEmail :: Interactive m => InitFlags -> m String -> m String
getEmail :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getEmail InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
email InitFlags
flags)

-- | Prompt for a homepage URL for the package.
getHomepage :: Interactive m => InitFlags -> m String -> m String
getHomepage :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getHomepage InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
homepage InitFlags
flags)

-- | Prompt for a project synopsis.
getSynopsis :: Interactive m => InitFlags -> m String -> m String
getSynopsis :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getSynopsis InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
synopsis InitFlags
flags)

-- | Prompt for a package category.
--   Note that it should be possible to do some smarter guessing here too, i.e.
--   look at the name of the top level source directory.
getCategory :: Interactive m => InitFlags -> m String -> m String
getCategory :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getCategory InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
category InitFlags
flags)

-- | Try to guess extra source files (don't prompt the user).
getExtraSrcFiles :: Interactive m => InitFlags -> m (Set String)
getExtraSrcFiles :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Set FilePath)
getExtraSrcFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Flag a -> b
flagElim forall a. Monoid a => a
mempty forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
extraSrc

-- | Try to guess extra source files (don't prompt the user).
getExtraDocFiles :: Interactive m => InitFlags -> m (Maybe (Set String))
getExtraDocFiles :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
getExtraDocFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Flag a -> b
flagElim (forall a. a -> Set a
Set.singleton FilePath
defaultChangelog) forall a. Ord a => [a] -> Set a
Set.fromList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
extraDoc

-- | Ask whether the project builds a library or executable.
getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
getPackageType :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageType -> m PackageType
getPackageType InitFlags
  { initializeTestSuite :: InitFlags -> Flag Bool
initializeTestSuite = Flag Bool
True
  , packageType :: InitFlags -> Flag PackageType
packageType         = Flag PackageType
NoFlag
  } m PackageType
_ = forall (m :: * -> *) a. Monad m => a -> m a
return PackageType
TestSuite
getPackageType InitFlags
flags m PackageType
act = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag PackageType
packageType InitFlags
flags) m PackageType
act

getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
getMainFile :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m HsFilePath -> m HsFilePath
getMainFile InitFlags
flags m HsFilePath
act = case InitFlags -> Flag FilePath
mainIs InitFlags
flags of
    Flag FilePath
a
      | FilePath -> Bool
isHsFilePath FilePath
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> HsFilePath
toHsFilePath FilePath
a
      | Bool
otherwise -> m HsFilePath
act
    Flag FilePath
NoFlag -> m HsFilePath
act

getInitializeTestSuite :: Interactive m => InitFlags -> m Bool -> m Bool
getInitializeTestSuite :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getInitializeTestSuite InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
initializeTestSuite InitFlags
flags)

getTestDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getTestDirs :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getTestDirs InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
testDirs InitFlags
flags)

-- | Ask for the Haskell base language of the package.
getLanguage :: Interactive m => InitFlags -> m Language -> m Language
getLanguage :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m Language -> m Language
getLanguage InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Language
language InitFlags
flags)

-- | Ask whether to generate explanatory comments.
getNoComments :: Interactive m => InitFlags -> m Bool -> m Bool
getNoComments :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getNoComments InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
noComments InitFlags
flags)

-- | Ask for the application root directory.
getAppDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getAppDirs :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getAppDirs InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
applicationDirs InitFlags
flags)

-- | Ask for the source (library) root directory.
getSrcDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getSrcDirs :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getSrcDirs InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
sourceDirs InitFlags
flags)

-- | Retrieve the list of exposed modules
getExposedModules :: Interactive m => InitFlags -> m (NonEmpty ModuleName)
getExposedModules :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m (NonEmpty ModuleName)
getExposedModules = forall (m :: * -> *) a. Monad m => a -> m a
return
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (ModuleName
myLibModule forall a. a -> [a] -> NonEmpty a
NEL.:| [])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flag a -> Maybe a
flagToMaybe
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [ModuleName]
exposedModules

-- | Retrieve the list of other modules
getOtherModules :: Interactive m => InitFlags -> m [ModuleName]
getOtherModules :: forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [ModuleName]
otherModules

-- | Retrieve the list of build tools
getBuildTools :: Interactive m => InitFlags -> m [Dependency]
getBuildTools :: forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools = forall b a. b -> (a -> b) -> Flag a -> b
flagElim (forall (m :: * -> *) a. Monad m => a -> m a
return []) (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a} {m :: * -> *}.
(Parsec a, Interactive m) =>
[a] -> FilePath -> m [a]
go []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
buildTools
  where
    go :: [a] -> FilePath -> m [a]
go [a]
acc FilePath
dep = case forall a. Parsec a => FilePath -> Either FilePath a
eitherParsec FilePath
dep of
      Left FilePath
e -> do
        forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse dependency: " forall a. [a] -> [a] -> [a]
++ FilePath
e
        forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn FilePath
"Skipping..."

        forall (m :: * -> *) a. Monad m => a -> m a
return [a]
acc
      Right a
d -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
acc forall a. [a] -> [a] -> [a]
++ [a
d]

-- | Retrieve the list of dependencies
getDependencies
    :: Interactive m
    => InitFlags
    -> m [Dependency]
    -> m [Dependency]
getDependencies :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m [Dependency] -> m [Dependency]
getDependencies InitFlags
flags = forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [Dependency]
dependencies InitFlags
flags)


-- | Retrieve the list of extensions
getOtherExts :: Interactive m => InitFlags -> m [Extension]
getOtherExts :: forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.  InitFlags -> Flag [Extension]
otherExts

-- | Tell whether to overwrite files on write
--
getOverwrite :: Interactive m => InitFlags -> m Bool
getOverwrite :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getOverwrite = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.  InitFlags -> Flag Bool
overwrite

-- -------------------------------------------------------------------- --
-- Shared prompts

simpleProjectPrompt :: Interactive m => InitFlags -> m Bool
simpleProjectPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
simpleProjectPrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getSimpleProject InitFlags
flags forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
      FilePath
"Should I generate a simple project with sensible defaults"
      (forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)

initializeTestSuitePrompt :: Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getInitializeTestSuite InitFlags
flags forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
      FilePath
"Should I generate a test suite for the library"
      (forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)

packageTypePrompt :: Interactive m => InitFlags -> m PackageType
packageTypePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypePrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageType -> m PackageType
getPackageType InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    FilePath
pt <- forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList FilePath
"What does the package build"
      [FilePath]
packageTypes
      (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
"Executable")
      forall a. Maybe a
Nothing
      Bool
False

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe PackageType
Executable (FilePath -> Maybe PackageType
parsePackageType FilePath
pt)
  where
    packageTypes :: [FilePath]
packageTypes =
      [ FilePath
"Library"
      , FilePath
"Executable"
      , FilePath
"Library and Executable"
      , FilePath
"Test suite"
      ]

    parsePackageType :: FilePath -> Maybe PackageType
parsePackageType = \case
      FilePath
"Library" -> forall a. a -> Maybe a
Just PackageType
Library
      FilePath
"Executable" -> forall a. a -> Maybe a
Just PackageType
Executable
      FilePath
"Library and Executable" -> forall a. a -> Maybe a
Just PackageType
LibraryAndExecutable
      FilePath
"Test suite" -> forall a. a -> Maybe a
Just PackageType
TestSuite
      FilePath
_ -> forall a. Maybe a
Nothing

testMainPrompt :: Interactive m => m HsFilePath
testMainPrompt :: forall (m :: * -> *). Interactive m => m HsFilePath
testMainPrompt = do
    FilePath
fp <- forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList FilePath
"What is the main module of the test suite?"
      [FilePath
defaultMainIs', FilePath
"Main.lhs"]
      (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultMainIs')
      forall a. Maybe a
Nothing
      Bool
True

    let hs :: HsFilePath
hs = FilePath -> HsFilePath
toHsFilePath FilePath
fp

    case HsFilePath -> HsFileType
_hsFileType HsFilePath
hs of
      HsFileType
InvalidHsPath -> do
        forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ FilePath
"Main file "
          , forall a. Show a => a -> FilePath
show HsFilePath
hs
          , FilePath
" is not a valid haskell file. Source files must end in .hs or .lhs."
          ]
        forall (m :: * -> *). Interactive m => m HsFilePath
testMainPrompt
      HsFileType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return HsFilePath
hs
  where
    defaultMainIs' :: FilePath
defaultMainIs' = forall a. Show a => a -> FilePath
show HsFilePath
defaultMainIs

dependenciesPrompt
    :: Interactive m
    => InstalledPackageIndex
    -> InitFlags
    -> m [Dependency]
dependenciesPrompt :: forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgIx InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m [Dependency] -> m [Dependency]
getDependencies InitFlags
flags (forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep InstalledPackageIndex
pkgIx InitFlags
flags)

-- -------------------------------------------------------------------- --
-- utilities

-- | If a flag is defined, return its value or else execute
-- an interactive action.
--
fromFlagOrPrompt
    :: Interactive m
    => Flag a
    -> m a
    -> m a
fromFlagOrPrompt :: forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt Flag a
flag m a
action = forall b a. b -> (a -> b) -> Flag a -> b
flagElim m a
action forall (m :: * -> *) a. Monad m => a -> m a
return Flag a
flag