{-# LANGUAGE LambdaCase, 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 Prelude ()
import Distribution.Client.Compat.Prelude hiding (putStr, putStrLn, getLine, last)

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

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


-- | 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.
  --

  PackageType
pkgType <- forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypePrompt InitFlags
initFlags
  Bool
isMinimal <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getMinimal InitFlags
initFlags
  Bool
doOverwrite <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
overwritePrompt InitFlags
initFlags
  FilePath
pkgDir <- forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
getPackageDir InitFlags
initFlags
  PkgDescription
pkgDesc <- forall (m :: * -> *).
Interactive m =>
Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles Verbosity
v forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
Interactive m =>
InitFlags -> SourcePackageDb -> m PkgDescription
genPkgDescription InitFlags
initFlags SourcePackageDb
srcDb

  let pkgName :: PackageName
pkgName = PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc
      cabalSpec :: CabalSpecVersion
cabalSpec = PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc
      mkOpts :: Bool -> CabalSpecVersion -> WriteOpts
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' = InitFlags
initFlags { cabalVersion :: Flag CabalSpecVersion
cabalVersion = forall a. a -> Flag a
Flag CabalSpecVersion
cabalSpec }

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

      Bool
comments <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'

      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc
        (forall a. a -> Maybe a
Just LibTarget
libTarget) forall a. Maybe a
Nothing Maybe TestTarget
testTarget

    PackageType
Executable -> do
      ExeTarget
exeTarget <- forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
      Bool
comments <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'

      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc forall a. Maybe a
Nothing
        (forall a. a -> Maybe a
Just ExeTarget
exeTarget) forall a. Maybe a
Nothing

    PackageType
LibraryAndExecutable -> do
      LibTarget
libTarget <- forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m LibTarget
genLibTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx

      ExeTarget
exeTarget <- PackageName -> ExeTarget -> ExeTarget
addLibDepToExe PackageName
pkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx

      Maybe TestTarget
testTarget <- PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
pkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx

      Bool
comments <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'

      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc (forall a. a -> Maybe a
Just LibTarget
libTarget)
        (forall a. a -> Maybe a
Just ExeTarget
exeTarget) Maybe TestTarget
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 Bool
initializeTestSuite = forall a. a -> Flag a
Flag Bool
True }
      Maybe TestTarget
testTarget <- forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags'' InstalledPackageIndex
pkgIx

      Bool
comments <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags''

      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc
        forall a. Maybe a
Nothing forall a. Maybe a
Nothing Maybe TestTarget
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
  CabalSpecVersion
csv <- forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionPrompt InitFlags
flags'
  let flags :: InitFlags
flags = InitFlags
flags' { cabalVersion :: Flag CabalSpecVersion
cabalVersion = forall a. a -> Flag a
Flag CabalSpecVersion
csv }
  CabalSpecVersion
-> PackageName
-> Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription
PkgDescription CabalSpecVersion
csv
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Interactive m =>
SourcePackageDb -> InitFlags -> m PackageName
packageNamePrompt SourcePackageDb
srcDb InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m Version
versionPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
licensePrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
authorPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
emailPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
homepagePrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
synopsisPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
categoryPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Set FilePath)
getExtraSrcFiles InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
getExtraDocFiles InitFlags
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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
srcDirsPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"library"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> m (NonEmpty ModuleName)
getExposedModules InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => InitFlags -> m HsFilePath
mainFilePrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
appDirsPrompt InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"executable"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (m :: * -> *). Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt InitFlags
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Interactive m => Bool -> m (Maybe TestTarget)
go
  where
    go :: Bool -> m (Maybe TestTarget)
go Bool
initialized
      | Bool -> Bool
not Bool
initialized = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      | Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HsFilePath
-> [FilePath]
-> Language
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> TestTarget
TestTarget
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => m HsFilePath
testMainPrompt
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
testDirsPrompt InitFlags
flags
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
"test suite"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
getOtherModules InitFlags
flags
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). Interactive m => InitFlags -> m [Extension]
getOtherExts InitFlags
flags
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgs InitFlags
flags
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
  Bool
isOverwrite <- forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getOverwrite InitFlags
flags
  forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
    FilePath
"Do you wish to overwrite existing files (backups will be created) (y/n)"
    (forall t. t -> DefaultPrompt t
DefaultPrompt Bool
isOverwrite)

cabalVersionPrompt :: Interactive m => InitFlags -> m CabalSpecVersion
cabalVersionPrompt :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionPrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    FilePath
v <- 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
      (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
ppDefault)
      (forall a. a -> Maybe a
Just FilePath -> FilePath
takeVersion)
      Bool
False
    -- take just the version numbers for convenience
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> CabalSpecVersion
parseCabalVersion (FilePath -> FilePath
takeVersion FilePath
v)
  where
    -- only used when presenting the default in prompt
    takeVersion :: FilePath -> FilePath
takeVersion = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ')

    ppDefault :: FilePath
ppDefault = CabalSpecVersion -> FilePath
displayCabalVersion CabalSpecVersion
defaultCabalVersion
    ppVersions :: [FilePath]
ppVersions = CabalSpecVersion -> FilePath
displayCabalVersion 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
_ = CabalSpecVersion
defaultCabalVersion -- 2.4

    displayCabalVersion :: CabalSpecVersion -> String
    displayCabalVersion :: CabalSpecVersion -> FilePath
displayCabalVersion CabalSpecVersion
v = case CabalSpecVersion
v of
      CabalSpecVersion
CabalSpecV1_24 -> FilePath
"1.24  (legacy)"
      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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageName -> m PackageName
getPackageName InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    PackageName
defName <- case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
        Flag FilePath
b -> forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName FilePath
b
        Flag FilePath
NoFlag -> forall (m :: * -> *). Interactive m => m PackageName
currentDirPkgName

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

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

    inUseMsg :: PackageName -> FilePath
inUseMsg PackageName
pn = FilePath
"The name "
      forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
unPackageName PackageName
pn
      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 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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m Version -> m Version
getVersion InitFlags
flags m Version
go
  where
    go :: m Version
go = do
      FilePath
vv <- forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Package version" (forall t. t -> DefaultPrompt t
DefaultPrompt forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow Version
defaultVersion)
      case forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
vv of
        Maybe Version
Nothing -> do
          forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn
            forall a b. (a -> b) -> a -> b
$ FilePath
"Version must be a valid PVP format (e.g. 0.1.0.0): "
            forall a. [a] -> [a] -> [a]
++ FilePath
vv
          m Version
go
        Just Version
v -> 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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m SpecLicense -> m SpecLicense
getLicense InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    let csv :: CabalSpecVersion
csv = forall a. a -> Flag a -> a
fromFlagOrDefault CabalSpecVersion
defaultCabalVersion (InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags)
    FilePath
l <- 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)
      forall t. DefaultPrompt t
MandatoryPrompt
      forall a. Maybe a
Nothing
      Bool
True

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

emailPrompt :: Interactive m => InitFlags -> m String
emailPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
emailPrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getEmail InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    FilePath
email' <- forall (m :: * -> *). Interactive m => m FilePath
guessAuthorEmail
    forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Maintainer email" (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
email')

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

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

categoryPrompt :: Interactive m => InitFlags -> m String
categoryPrompt :: forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
categoryPrompt InitFlags
flags = forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getCategory InitFlags
flags forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList
      FilePath
"Project category" [FilePath]
defaultCategories
      (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
"") (forall a. a -> Maybe a
Just FilePath -> FilePath
matchNone) Bool
True
  where
    matchNone :: FilePath -> FilePath
matchNone FilePath
s
      | 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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m HsFilePath -> m HsFilePath
getMainFile InitFlags
flags m HsFilePath
go
  where
    defaultMainIs' :: FilePath
defaultMainIs' = forall a. Show a => a -> FilePath
show HsFilePath
defaultMainIs
    go :: m HsFilePath
go = 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 executable"
        [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."
            ]
          m HsFilePath
go

        HsFileType
_ -> 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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getTestDirs InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    FilePath
dir <- forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Test directory" (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultTestDir)
    forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]

languagePrompt :: Interactive m => InitFlags -> String -> m Language
languagePrompt :: forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
pkgType = forall (m :: * -> *).
Interactive m =>
InitFlags -> m Language -> m Language
getLanguage InitFlags
flags 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)"

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

    if
      | FilePath
l forall a. Eq a => a -> a -> Bool
== FilePath
h2010       -> forall (m :: * -> *) a. Monad m => a -> m a
return Language
Haskell2010
      | FilePath
l forall a. Eq a => a -> a -> Bool
== FilePath
h98         -> forall (m :: * -> *) a. Monad m => a -> m a
return Language
Haskell98
      | FilePath
l forall a. Eq a => a -> a -> Bool
== FilePath
ghc2021     -> forall (m :: * -> *) a. Monad m => a -> m a
return Language
GHC2021
      | Bool
otherwise        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Language
UnknownLanguage FilePath
l

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

    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
doComments)

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

    forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]
  where
    promptMsg :: FilePath
promptMsg = case InitFlags -> Flag FilePath
mainIs InitFlags
flags of
      Flag FilePath
p -> FilePath
"Application (" forall a. [a] -> [a] -> [a]
++ FilePath
p 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 = forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getSrcDirs InitFlags
flags forall a b. (a -> b) -> a -> b
$ do
    FilePath
dir <- 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"]
      (forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultSourceDir)
      forall a. Maybe a
Nothing
      Bool
True

    forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]