{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.Init.Command
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Implementation of the 'cabal init' command, which creates an initial .cabal
-- file for a project.
module Distribution.Client.Init.Interactive.Command
  ( -- * Commands
    createProject

    -- ** Target generation
  , genPkgDescription
  , genLibTarget
  , genExeTarget
  , genTestTarget

    -- ** Prompts
  , cabalVersionPrompt
  , packageNamePrompt
  , versionPrompt
  , licensePrompt
  , authorPrompt
  , emailPrompt
  , homepagePrompt
  , synopsisPrompt
  , categoryPrompt
  , mainFilePrompt
  , testDirsPrompt
  , languagePrompt
  , noCommentsPrompt
  , appDirsPrompt
  , dependenciesPrompt
  , srcDirsPrompt
  ) where

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

import Distribution.CabalSpecVersion (CabalSpecVersion (..), showCabalSpecVersion)
import Distribution.Client.Init.Defaults
import Distribution.Client.Init.FlagExtractors
import Distribution.Client.Init.NonInteractive.Heuristics (guessAuthorEmail, guessAuthorName)
import Distribution.Client.Init.Prompt
import Distribution.Client.Init.Types
import Distribution.Client.Init.Utils
import Distribution.Client.Types (SourcePackageDb (..))
import Distribution.FieldGrammar.Newtypes (SpecLicense (..))
import qualified Distribution.SPDX as SPDX
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Setup (Flag (..), fromFlagOrDefault)
import Distribution.Solver.Types.PackageIndex (elemByPackageName)
import Distribution.Types.PackageName (PackageName, unPackageName)
import Distribution.Version (Version)

import Distribution.License (knownLicenses)
import Distribution.Parsec (simpleParsec')
import Language.Haskell.Extension (Language (..))

-- | Main driver for interactive prompt code.
createProject
  :: Interactive m
  => Verbosity
  -> InstalledPackageIndex
  -> SourcePackageDb
  -> InitFlags
  -> m ProjectSettings
createProject :: forall (m :: * -> *).
Interactive m =>
Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> InitFlags
-> m ProjectSettings
createProject Verbosity
v InstalledPackageIndex
pkgIx SourcePackageDb
srcDb InitFlags
initFlags = do
  -- The workflow is as follows:
  --
  --  1. Get the package type, supplied as either a program input or
  --     via user prompt. This determines what targets will be built
  --     in later steps.
  --
  --  2. Generate package description and the targets specified by
  --     the package type. Once this is done, a prompt for building
  --     test suites is initiated, and this determines if we build
  --     test targets as well. Then we ask if the user wants to
  --     comment their .cabal file with pretty comments.
  --
  --  3. The targets are passed to the file creator script, and associated
  --     directories/files/modules are created, with the a .cabal file
  --     being generated as a final result.
  --

  pkgType <- InitFlags -> m PackageType
forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypePrompt InitFlags
initFlags
  isMinimal <- getMinimal initFlags
  doOverwrite <- overwritePrompt initFlags
  pkgDir <- getPackageDir initFlags
  pkgDesc <- fixupDocFiles v =<< genPkgDescription initFlags srcDb

  let pkgName = PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc
      cabalSpec = PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc
      mkOpts Bool
cs =
        Bool
-> Bool
-> Bool
-> Verbosity
-> FilePath
-> PackageType
-> PackageName
-> CabalSpecVersion
-> WriteOpts
WriteOpts
          Bool
doOverwrite
          Bool
isMinimal
          Bool
cs
          Verbosity
v
          FilePath
pkgDir
          PackageType
pkgType
          PackageName
pkgName
      initFlags' = InitFlags
initFlags{cabalVersion = Flag cabalSpec}

  case pkgType of
    PackageType
Library -> do
      libTarget <- InitFlags -> InstalledPackageIndex -> m LibTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m LibTarget
genLibTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
      testTarget <-
        addLibDepToTest pkgName
          <$> genTestTarget initFlags' pkgIx

      comments <- noCommentsPrompt initFlags'

      return $
        ProjectSettings
          (mkOpts comments cabalSpec)
          pkgDesc
          (Just libTarget)
          Nothing
          testTarget
    PackageType
Executable -> do
      exeTarget <- InitFlags -> InstalledPackageIndex -> m ExeTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
      comments <- noCommentsPrompt initFlags'

      return $
        ProjectSettings
          (mkOpts comments cabalSpec)
          pkgDesc
          Nothing
          (Just exeTarget)
          Nothing
    PackageType
LibraryAndExecutable -> do
      libTarget <- InitFlags -> InstalledPackageIndex -> m LibTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m LibTarget
genLibTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx

      exeTarget <-
        addLibDepToExe pkgName
          <$> genExeTarget initFlags' pkgIx

      testTarget <-
        addLibDepToTest pkgName
          <$> genTestTarget initFlags' pkgIx

      comments <- noCommentsPrompt initFlags'

      return $
        ProjectSettings
          (mkOpts comments cabalSpec)
          pkgDesc
          (Just libTarget)
          (Just exeTarget)
          testTarget
    PackageType
TestSuite -> do
      -- the line below is necessary because if both package type and test flags
      -- are *not* passed, the user will be prompted for a package type (which
      -- includes TestSuite in the list). It prevents that the user end up with a
      -- TestSuite target with initializeTestSuite set to NoFlag, thus avoiding the prompt.
      let initFlags'' :: InitFlags
initFlags'' = InitFlags
initFlags'{initializeTestSuite = Flag True}
      testTarget <- InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags'' InstalledPackageIndex
pkgIx

      comments <- noCommentsPrompt initFlags''

      return $
        ProjectSettings
          (mkOpts comments cabalSpec)
          pkgDesc
          Nothing
          Nothing
          testTarget

-- -------------------------------------------------------------------- --
-- Target and pkg description generation

-- | Extract flags relevant to a package description and interactively
-- generate a 'PkgDescription' object for creation. If the user specifies
-- the generation of a simple package, then a simple target with defaults
-- is generated.
genPkgDescription
  :: Interactive m
  => InitFlags
  -> SourcePackageDb
  -> m PkgDescription
genPkgDescription :: forall (m :: * -> *).
Interactive m =>
InitFlags -> SourcePackageDb -> m PkgDescription
genPkgDescription InitFlags
flags' SourcePackageDb
srcDb = do
  csv <- InitFlags -> m CabalSpecVersion
forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionPrompt InitFlags
flags'
  let flags = InitFlags
flags'{cabalVersion = Flag csv}
  PkgDescription csv
    <$> packageNamePrompt srcDb flags
    <*> versionPrompt flags
    <*> licensePrompt flags
    <*> authorPrompt flags
    <*> emailPrompt flags
    <*> homepagePrompt flags
    <*> synopsisPrompt flags
    <*> categoryPrompt flags
    <*> getExtraSrcFiles flags
    <*> getExtraDocFiles flags

-- | Extract flags relevant to a library target and interactively
-- generate a 'LibTarget' object for creation. If the user specifies
-- the generation of a simple package, then a simple target with defaults
-- is generated.
genLibTarget
  :: Interactive m
  => InitFlags
  -> InstalledPackageIndex
  -> m LibTarget
genLibTarget :: forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m LibTarget
genLibTarget InitFlags
flags InstalledPackageIndex
pkgs =
  [FilePath]
-> Language
-> NonEmpty ModuleName
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> LibTarget
LibTarget
    ([FilePath]
 -> Language
 -> NonEmpty ModuleName
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> LibTarget)
-> m [FilePath]
-> m (Language
      -> NonEmpty ModuleName
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> LibTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
srcDirsPrompt InitFlags
flags
    m (Language
   -> NonEmpty ModuleName
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> LibTarget)
-> m Language
-> m (NonEmpty ModuleName
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> LibTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"library"
    m (NonEmpty ModuleName
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> LibTarget)
-> m (NonEmpty ModuleName)
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> LibTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (NonEmpty ModuleName)
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (NonEmpty ModuleName)
getExposedModules InitFlags
flags
    m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> LibTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> LibTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
    m ([Extension] -> [Dependency] -> [Dependency] -> LibTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> LibTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Extension]
forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
    m ([Dependency] -> [Dependency] -> LibTarget)
-> m [Dependency] -> m ([Dependency] -> LibTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
    m ([Dependency] -> LibTarget) -> m [Dependency] -> m LibTarget
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags

-- | Extract flags relevant to a executable target and interactively
-- generate a 'ExeTarget' object for creation. If the user specifies
-- the generation of a simple package, then a simple target with defaults
-- is generated.
genExeTarget
  :: Interactive m
  => InitFlags
  -> InstalledPackageIndex
  -> m ExeTarget
genExeTarget :: forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
flags InstalledPackageIndex
pkgs =
  HsFilePath
-> [FilePath]
-> Language
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> ExeTarget
ExeTarget
    (HsFilePath
 -> [FilePath]
 -> Language
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> ExeTarget)
-> m HsFilePath
-> m ([FilePath]
      -> Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> ExeTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m HsFilePath
forall (m :: * -> *). Interactive m => InitFlags -> m HsFilePath
mainFilePrompt InitFlags
flags
    m ([FilePath]
   -> Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> ExeTarget)
-> m [FilePath]
-> m (Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> ExeTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
appDirsPrompt InitFlags
flags
    m (Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> ExeTarget)
-> m Language
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"executable"
    m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
    m ([Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> ExeTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Extension]
forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
    m ([Dependency] -> [Dependency] -> ExeTarget)
-> m [Dependency] -> m ([Dependency] -> ExeTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
    m ([Dependency] -> ExeTarget) -> m [Dependency] -> m ExeTarget
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags

-- | Extract flags relevant to a test target and interactively
-- generate a 'TestTarget' object for creation. If the user specifies
-- the generation of a simple package, then a simple target with defaults
-- is generated.
--
-- Note: this workflow is only enabled if the user answers affirmatively
-- when prompted, or if the user passes in the flag to enable
-- test suites at command line.
genTestTarget
  :: Interactive m
  => InitFlags
  -> InstalledPackageIndex
  -> m (Maybe TestTarget)
genTestTarget :: forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
flags InstalledPackageIndex
pkgs = InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt InitFlags
flags m Bool -> (Bool -> m (Maybe TestTarget)) -> m (Maybe TestTarget)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m (Maybe TestTarget)
forall {m :: * -> *}. Interactive m => Bool -> m (Maybe TestTarget)
go
  where
    go :: Bool -> m (Maybe TestTarget)
go Bool
initialized
      | Bool -> Bool
not Bool
initialized = Maybe TestTarget -> m (Maybe TestTarget)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestTarget
forall a. Maybe a
Nothing
      | Bool
otherwise =
          (TestTarget -> Maybe TestTarget)
-> m TestTarget -> m (Maybe TestTarget)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestTarget -> Maybe TestTarget
forall a. a -> Maybe a
Just (m TestTarget -> m (Maybe TestTarget))
-> m TestTarget -> m (Maybe TestTarget)
forall a b. (a -> b) -> a -> b
$
            HsFilePath
-> [FilePath]
-> Language
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> TestTarget
TestTarget
              (HsFilePath
 -> [FilePath]
 -> Language
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> TestTarget)
-> m HsFilePath
-> m ([FilePath]
      -> Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m HsFilePath
forall (m :: * -> *). Interactive m => m HsFilePath
testMainPrompt
              m ([FilePath]
   -> Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> TestTarget)
-> m [FilePath]
-> m (Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> TestTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
testDirsPrompt InitFlags
flags
              m (Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> TestTarget)
-> m Language
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> TestTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"test suite"
              m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> TestTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> TestTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
              m ([Extension] -> [Dependency] -> [Dependency] -> TestTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> TestTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Extension]
forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
              m ([Dependency] -> [Dependency] -> TestTarget)
-> m [Dependency] -> m ([Dependency] -> TestTarget)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
              m ([Dependency] -> TestTarget) -> m [Dependency] -> m TestTarget
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags

-- -------------------------------------------------------------------- --
-- Prompts

overwritePrompt :: Interactive m => InitFlags -> m Bool
overwritePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
overwritePrompt InitFlags
flags = do
  con <- InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
getPackageDir InitFlags
flags m FilePath -> (FilePath -> m [FilePath]) -> m [FilePath]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> m [FilePath]
forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listDirectory

  -- Do not ask useless overwrite question if directory is empty.
  if null con
    then return False
    else do
      isOverwrite <- getOverwrite flags
      promptYesNo
        "Do you wish to overwrite existing files (backups will be created) (y/n)"
        (DefaultPrompt isOverwrite)

cabalVersionPrompt :: Interactive m => InitFlags -> m CabalSpecVersion
cabalVersionPrompt :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionPrompt InitFlags
flags = InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion InitFlags
flags (m CabalSpecVersion -> m CabalSpecVersion)
-> m CabalSpecVersion -> m CabalSpecVersion
forall a b. (a -> b) -> a -> b
$ do
  v <-
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
"Please choose version of the Cabal specification to use"
      [FilePath]
ppVersions
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
ppDefault)
      ((FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a. a -> Maybe a
Just FilePath -> FilePath
takeVersion)
      Bool
False
  -- take just the version numbers for convenience
  return $ parseCabalVersion (takeVersion v)
  where
    -- only used when presenting the default in prompt
    takeVersion :: FilePath -> FilePath
takeVersion = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')

    ppDefault :: FilePath
ppDefault = CabalSpecVersion -> FilePath
displayCabalVersion CabalSpecVersion
defaultCabalVersion
    ppVersions :: [FilePath]
ppVersions = CabalSpecVersion -> FilePath
displayCabalVersion (CabalSpecVersion -> FilePath) -> [CabalSpecVersion] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CabalSpecVersion]
defaultCabalVersions

    parseCabalVersion :: String -> CabalSpecVersion
    parseCabalVersion :: FilePath -> CabalSpecVersion
parseCabalVersion FilePath
"1.24" = CabalSpecVersion
CabalSpecV1_24
    parseCabalVersion FilePath
"2.0" = CabalSpecVersion
CabalSpecV2_0
    parseCabalVersion FilePath
"2.2" = CabalSpecVersion
CabalSpecV2_2
    parseCabalVersion FilePath
"2.4" = CabalSpecVersion
CabalSpecV2_4
    parseCabalVersion FilePath
"3.0" = CabalSpecVersion
CabalSpecV3_0
    parseCabalVersion FilePath
"3.4" = CabalSpecVersion
CabalSpecV3_4
    parseCabalVersion FilePath
"3.12" = CabalSpecVersion
CabalSpecV3_12
    parseCabalVersion FilePath
_ = CabalSpecVersion
defaultCabalVersion -- 2.4
    displayCabalVersion :: CabalSpecVersion -> String
    displayCabalVersion :: CabalSpecVersion -> FilePath
displayCabalVersion CabalSpecVersion
v = case CabalSpecVersion
v of
      CabalSpecVersion
CabalSpecV2_0 -> FilePath
"2.0   (support for Backpack, internal sub-libs, '^>=' operator)"
      CabalSpecVersion
CabalSpecV2_2 -> FilePath
"2.2   (+ support for 'common', 'elif', redundant commas, SPDX)"
      CabalSpecVersion
CabalSpecV2_4 -> FilePath
"2.4   (+ support for '**' globbing)"
      CabalSpecVersion
CabalSpecV3_0 -> FilePath
"3.0   (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"
      CabalSpecVersion
CabalSpecV3_4 -> FilePath
"3.4   (+ sublibraries in 'mixins', optional 'default-language')"
      CabalSpecVersion
_ -> CabalSpecVersion -> FilePath
showCabalSpecVersion CabalSpecVersion
v

packageNamePrompt :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName
packageNamePrompt :: forall (m :: * -> *).
Interactive m =>
SourcePackageDb -> InitFlags -> m PackageName
packageNamePrompt SourcePackageDb
srcDb InitFlags
flags = InitFlags -> m PackageName -> m PackageName
forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageName -> m PackageName
getPackageName InitFlags
flags (m PackageName -> m PackageName) -> m PackageName -> m PackageName
forall a b. (a -> b) -> a -> b
$ do
  defName <- case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
    Flag FilePath
b -> FilePath -> m PackageName
forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName FilePath
b
    Flag FilePath
NoFlag -> m PackageName
forall (m :: * -> *). Interactive m => m PackageName
currentDirPkgName

  go $ DefaultPrompt defName
  where
    go :: DefaultPrompt PackageName -> m PackageName
go DefaultPrompt PackageName
defName =
      FilePath -> DefaultPrompt PackageName -> m PackageName
forall (m :: * -> *) t.
(Interactive m, Parsec t, Pretty t) =>
FilePath -> DefaultPrompt t -> m t
prompt FilePath
"Package name" DefaultPrompt PackageName
defName m PackageName -> (PackageName -> m PackageName) -> m PackageName
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PackageName
n ->
        if PackageName -> Bool
isPkgRegistered PackageName
n
          then do
            don'tUseName <- FilePath -> DefaultPrompt Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo (PackageName -> FilePath
promptOtherNameMsg PackageName
n) (Bool -> DefaultPrompt Bool
forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)
            if don'tUseName
              then go defName
              else return n
          else PackageName -> m PackageName
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
n

    isPkgRegistered :: PackageName -> Bool
isPkgRegistered = PackageIndex UnresolvedSourcePackage -> PackageName -> Bool
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> Bool
elemByPackageName (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
srcDb)

    inUseMsg :: PackageName -> FilePath
inUseMsg PackageName
pn =
      FilePath
"The name "
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
unPackageName PackageName
pn
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is already in use by another package on Hackage."

    promptOtherNameMsg :: PackageName -> FilePath
promptOtherNameMsg PackageName
pn = PackageName -> FilePath
inUseMsg PackageName
pn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Do you want to choose a different name (y/n)"

versionPrompt :: Interactive m => InitFlags -> m Version
versionPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m Version
versionPrompt InitFlags
flags = InitFlags -> m Version -> m Version
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Version -> m Version
getVersion InitFlags
flags m Version
go
  where
    go :: m Version
go = do
      vv <- FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Package version" (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt (FilePath -> DefaultPrompt FilePath)
-> FilePath -> DefaultPrompt FilePath
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
defaultVersion)
      case simpleParsec vv of
        Maybe Version
Nothing -> do
          FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"Version must be a valid PVP format (e.g. 0.1.0.0): "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
vv
          m Version
go
        Just Version
v -> Version -> m Version
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v

licensePrompt :: Interactive m => InitFlags -> m SpecLicense
licensePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
licensePrompt InitFlags
flags = InitFlags -> m SpecLicense -> m SpecLicense
forall (m :: * -> *).
Interactive m =>
InitFlags -> m SpecLicense -> m SpecLicense
getLicense InitFlags
flags (m SpecLicense -> m SpecLicense) -> m SpecLicense -> m SpecLicense
forall a b. (a -> b) -> a -> b
$ do
  let csv :: CabalSpecVersion
csv = CabalSpecVersion -> Flag CabalSpecVersion -> CabalSpecVersion
forall a. a -> Flag a -> a
fromFlagOrDefault CabalSpecVersion
defaultCabalVersion (InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags)
  l <-
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
"Please choose a license"
      (CabalSpecVersion -> [FilePath]
licenses CabalSpecVersion
csv)
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
"BSD-3-Clause")
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
True

  case simpleParsec' csv l of
    Maybe SpecLicense
Nothing -> do
      FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn
        ( FilePath
"The license must be a valid SPDX expression:"
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n - On the SPDX License List: https://spdx.org/licenses/"
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n - NONE, if you do not want to grant any license"
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n - LicenseRef-( alphanumeric | - | . )+"
        )
      InitFlags -> m SpecLicense
forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
licensePrompt InitFlags
flags
    Just SpecLicense
l' -> SpecLicense -> m SpecLicense
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SpecLicense
l'
  where
    licenses :: CabalSpecVersion -> [FilePath]
licenses CabalSpecVersion
csv =
      if CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2
        then LicenseId -> FilePath
SPDX.licenseId (LicenseId -> FilePath) -> [LicenseId] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LicenseId]
defaultLicenseIds
        else (License -> FilePath) -> [License] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap License -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow [License]
knownLicenses

authorPrompt :: Interactive m => InitFlags -> m String
authorPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
authorPrompt InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getAuthor InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ m (Maybe FilePath)
forall (m :: * -> *). Interactive m => m (Maybe FilePath)
guessAuthorName m (Maybe FilePath) -> (Maybe FilePath -> m FilePath) -> m FilePath
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> Maybe FilePath -> m FilePath
promptOrDefault FilePath
"Author name"

emailPrompt :: Interactive m => InitFlags -> m String
emailPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
emailPrompt InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getEmail InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ m (Maybe FilePath)
forall (m :: * -> *). Interactive m => m (Maybe FilePath)
guessAuthorEmail m (Maybe FilePath) -> (Maybe FilePath -> m FilePath) -> m FilePath
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> Maybe FilePath -> m FilePath
promptOrDefault FilePath
"Maintainer email"

homepagePrompt :: Interactive m => InitFlags -> m String
homepagePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
homepagePrompt InitFlags
flags =
  InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getHomepage InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$
    FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Project homepage URL" DefaultPrompt FilePath
forall t. DefaultPrompt t
OptionalPrompt

synopsisPrompt :: Interactive m => InitFlags -> m String
synopsisPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
synopsisPrompt InitFlags
flags =
  InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getSynopsis InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$
    FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Project synopsis" DefaultPrompt FilePath
forall t. DefaultPrompt t
OptionalPrompt

categoryPrompt :: Interactive m => InitFlags -> m String
categoryPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
categoryPrompt InitFlags
flags =
  InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getCategory InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
"Project category"
      [FilePath]
defaultCategories
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
"")
      ((FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a. a -> Maybe a
Just FilePath -> FilePath
matchNone)
      Bool
True
  where
    matchNone :: FilePath -> FilePath
matchNone FilePath
s
      | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s = FilePath
"(none)"
      | Bool
otherwise = FilePath
s

mainFilePrompt :: Interactive m => InitFlags -> m HsFilePath
mainFilePrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m HsFilePath
mainFilePrompt InitFlags
flags = InitFlags -> m HsFilePath -> m HsFilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m HsFilePath -> m HsFilePath
getMainFile InitFlags
flags m HsFilePath
go
  where
    defaultMainIs' :: FilePath
defaultMainIs' = HsFilePath -> FilePath
forall a. Show a => a -> FilePath
show HsFilePath
defaultMainIs
    go :: m HsFilePath
go = do
      fp <-
        FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
          FilePath
"What is the main module of the executable"
          [FilePath
defaultMainIs', FilePath
"Main.lhs"]
          (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultMainIs')
          Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
          Bool
True

      let hs = FilePath -> HsFilePath
toHsFilePath FilePath
fp

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

testDirsPrompt :: Interactive m => InitFlags -> m [String]
testDirsPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
testDirsPrompt InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getTestDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ do
  dir <- FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Test directory" (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultTestDir)
  return [dir]

languagePrompt :: Interactive m => InitFlags -> String -> m Language
languagePrompt :: forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
pkgType = InitFlags -> m Language -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Language -> m Language
getLanguage InitFlags
flags (m Language -> m Language) -> m Language -> m Language
forall a b. (a -> b) -> a -> b
$ do
  let h2010 :: FilePath
h2010 = FilePath
"Haskell2010"
      h98 :: FilePath
h98 = FilePath
"Haskell98"
      ghc2021 :: FilePath
ghc2021 = FilePath
"GHC2021 (requires at least GHC 9.2)"
      ghc2024 :: FilePath
ghc2024 = FilePath
"GHC2024 (requires at least GHC 9.10)"

  l <-
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      (FilePath
"Choose a language for your " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pkgType)
      [FilePath
h2010, FilePath
h98, FilePath
ghc2021, FilePath
ghc2024]
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
h2010)
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
True

  if
      | l == h2010 -> return Haskell2010
      | l == h98 -> return Haskell98
      | l == ghc2021 -> return GHC2021
      | l == ghc2024 -> return GHC2024
      | otherwise -> return $ UnknownLanguage l

noCommentsPrompt :: Interactive m => InitFlags -> m Bool
noCommentsPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
flags = InitFlags -> m Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getNoComments InitFlags
flags (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
  doComments <-
    FilePath -> DefaultPrompt Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
      FilePath
"Add informative comments to each field in the cabal file. (y/n)"
      (Bool -> DefaultPrompt Bool
forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)

  --
  -- if --no-comments is flagged, then we choose not to generate comments
  -- for fields in the cabal file, but it's a nicer UX to present the
  -- affirmative question which must be negated.
  --

  return (not doComments)

-- | Ask for the application root directory.
appDirsPrompt :: Interactive m => InitFlags -> m [String]
appDirsPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
appDirsPrompt InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getAppDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ do
  dir <-
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
promptMsg
      [FilePath
defaultApplicationDir, FilePath
"exe", FilePath
"src-exe"]
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultApplicationDir)
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
True

  return [dir]
  where
    promptMsg :: FilePath
promptMsg = case InitFlags -> Flag FilePath
mainIs InitFlags
flags of
      Flag FilePath
p -> FilePath
"Application (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") directory"
      Flag FilePath
NoFlag -> FilePath
"Application directory"

-- | Ask for the source (library) root directory.
srcDirsPrompt :: Interactive m => InitFlags -> m [String]
srcDirsPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
srcDirsPrompt InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getSrcDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ do
  dir <-
    FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
"Library source directory"
      [FilePath
defaultSourceDir, FilePath
"lib", FilePath
"src-lib"]
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultSourceDir)
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
True

  return [dir]

promptOrDefault :: Interactive m => String -> Maybe String -> m String
promptOrDefault :: forall (m :: * -> *).
Interactive m =>
FilePath -> Maybe FilePath -> m FilePath
promptOrDefault FilePath
s = m FilePath
-> (FilePath -> m FilePath) -> Maybe FilePath -> m FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
s DefaultPrompt FilePath
forall t. DefaultPrompt t
MandatoryPrompt) (FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
s (DefaultPrompt FilePath -> m FilePath)
-> (FilePath -> DefaultPrompt FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt)