{-# LANGUAGE LambdaCase, MultiWayIf #-}
module Distribution.Client.Init.Interactive.Command
(
createProject
, genPkgDescription
, genLibTarget
, genExeTarget
, genTestTarget
, 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')
createProject
:: Interactive m
=> Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> InitFlags
-> m ProjectSettings
createProject :: Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> InitFlags
-> m ProjectSettings
createProject Verbosity
v InstalledPackageIndex
pkgIx SourcePackageDb
srcDb InitFlags
initFlags = do
PackageType
pkgType <- InitFlags -> m PackageType
forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypePrompt InitFlags
initFlags
Bool
isMinimal <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getMinimal InitFlags
initFlags
Bool
doOverwrite <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
overwritePrompt InitFlags
initFlags
FilePath
pkgDir <- InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
getPackageDir InitFlags
initFlags
PkgDescription
pkgDesc <- Verbosity -> PkgDescription -> m PkgDescription
forall (m :: * -> *).
Interactive m =>
Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles Verbosity
v (PkgDescription -> m PkgDescription)
-> m PkgDescription -> m PkgDescription
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InitFlags -> SourcePackageDb -> m PkgDescription
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 = CabalSpecVersion -> Flag CabalSpecVersion
forall a. a -> Flag a
Flag CabalSpecVersion
cabalSpec }
case PackageType
pkgType of
PackageType
Library -> do
LibTarget
libTarget <- InitFlags -> InstalledPackageIndex -> m 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 (Maybe TestTarget -> Maybe TestTarget)
-> m (Maybe TestTarget) -> m (Maybe TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
Bool
comments <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'
ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
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
(LibTarget -> Maybe LibTarget
forall a. a -> Maybe a
Just LibTarget
libTarget) Maybe ExeTarget
forall a. Maybe a
Nothing Maybe TestTarget
testTarget
PackageType
Executable -> do
ExeTarget
exeTarget <- InitFlags -> InstalledPackageIndex -> m ExeTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
Bool
comments <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'
ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
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 Maybe LibTarget
forall a. Maybe a
Nothing
(ExeTarget -> Maybe ExeTarget
forall a. a -> Maybe a
Just ExeTarget
exeTarget) Maybe TestTarget
forall a. Maybe a
Nothing
PackageType
LibraryAndExecutable -> do
LibTarget
libTarget <- InitFlags -> InstalledPackageIndex -> m LibTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m LibTarget
genLibTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
ExeTarget
exeTarget <- PackageName -> ExeTarget -> ExeTarget
addLibDepToExe PackageName
pkgName (ExeTarget -> ExeTarget) -> m ExeTarget -> m ExeTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
InitFlags -> InstalledPackageIndex -> m ExeTarget
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m ExeTarget
genExeTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
Maybe TestTarget
testTarget <- PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
pkgName (Maybe TestTarget -> Maybe TestTarget)
-> m (Maybe TestTarget) -> m (Maybe TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags' InstalledPackageIndex
pkgIx
Bool
comments <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags'
ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
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 (LibTarget -> Maybe LibTarget
forall a. a -> Maybe a
Just LibTarget
libTarget)
(ExeTarget -> Maybe ExeTarget
forall a. a -> Maybe a
Just ExeTarget
exeTarget) Maybe TestTarget
testTarget
PackageType
TestSuite -> do
let initFlags'' :: InitFlags
initFlags'' = InitFlags
initFlags' { initializeTestSuite :: Flag Bool
initializeTestSuite = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True }
Maybe TestTarget
testTarget <- InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags -> InstalledPackageIndex -> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags'' InstalledPackageIndex
pkgIx
Bool
comments <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsPrompt InitFlags
initFlags''
ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
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
Maybe LibTarget
forall a. Maybe a
Nothing Maybe ExeTarget
forall a. Maybe a
Nothing Maybe TestTarget
testTarget
genPkgDescription
:: Interactive m
=> InitFlags
-> SourcePackageDb
-> m PkgDescription
genPkgDescription :: InitFlags -> SourcePackageDb -> m PkgDescription
genPkgDescription InitFlags
flags' SourcePackageDb
srcDb = do
CabalSpecVersion
csv <- InitFlags -> m CabalSpecVersion
forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionPrompt InitFlags
flags'
let flags :: InitFlags
flags = InitFlags
flags' { cabalVersion :: Flag CabalSpecVersion
cabalVersion = CabalSpecVersion -> Flag CabalSpecVersion
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
(PackageName
-> Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m PackageName
-> m (Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourcePackageDb -> InitFlags -> m PackageName
forall (m :: * -> *).
Interactive m =>
SourcePackageDb -> InitFlags -> m PackageName
packageNamePrompt SourcePackageDb
srcDb InitFlags
flags
m (Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m Version
-> m (SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m Version
forall (m :: * -> *). Interactive m => InitFlags -> m Version
versionPrompt InitFlags
flags
m (SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m SpecLicense
-> m (FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m SpecLicense
forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
licensePrompt InitFlags
flags
m (FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m FilePath
-> m (FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
authorPrompt InitFlags
flags
m (FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m FilePath
-> m (FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
emailPrompt InitFlags
flags
m (FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m FilePath
-> m (FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
homepagePrompt InitFlags
flags
m (FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription)
-> m FilePath
-> m (FilePath
-> Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
synopsisPrompt InitFlags
flags
m (FilePath
-> Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
-> m FilePath
-> m (Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
categoryPrompt InitFlags
flags
m (Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
-> m (Set FilePath) -> m (Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (Set FilePath)
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Set FilePath)
getExtraSrcFiles InitFlags
flags
m (Maybe (Set FilePath) -> PkgDescription)
-> m (Maybe (Set FilePath)) -> m PkgDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (Maybe (Set FilePath))
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
getExtraDocFiles InitFlags
flags
genLibTarget
:: Interactive m
=> InitFlags
-> InstalledPackageIndex
-> m LibTarget
genLibTarget :: 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 (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 (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 (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 (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 (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 (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
genExeTarget
:: Interactive m
=> InitFlags
-> InstalledPackageIndex
-> m ExeTarget
genExeTarget :: 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 (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 (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 (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 (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 (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 (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
genTestTarget
:: Interactive m
=> InitFlags
-> InstalledPackageIndex
-> m (Maybe TestTarget)
genTestTarget :: 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 (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 (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 (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 (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 (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 (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 (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 (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 (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
overwritePrompt :: Interactive m => InitFlags -> m Bool
overwritePrompt :: InitFlags -> m Bool
overwritePrompt InitFlags
flags = do
Bool
isOverwrite <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getOverwrite InitFlags
flags
FilePath -> DefaultPrompt Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
FilePath
"Do you wish to overwrite existing files (backups will be created) (y/n)"
(Bool -> DefaultPrompt Bool
forall t. t -> DefaultPrompt t
DefaultPrompt Bool
isOverwrite)
cabalVersionPrompt :: Interactive m => InitFlags -> m CabalSpecVersion
cabalVersionPrompt :: 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
FilePath
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
CabalSpecVersion -> m CabalSpecVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalSpecVersion -> m CabalSpecVersion)
-> CabalSpecVersion -> m CabalSpecVersion
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalSpecVersion
parseCabalVersion (FilePath -> FilePath
takeVersion FilePath
v)
where
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
_ = CabalSpecVersion
defaultCabalVersion
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 :: 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
PackageName
defName <- case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
Flag FilePath
b -> PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> m PackageName) -> PackageName -> m PackageName
forall a b. (a -> b) -> a -> b
$ FilePath -> PackageName
filePathToPkgName FilePath
b
Flag FilePath
NoFlag -> m PackageName
forall (m :: * -> *). Interactive m => m PackageName
currentDirPkgName
DefaultPrompt PackageName -> m PackageName
forall (m :: * -> *).
Interactive m =>
DefaultPrompt PackageName -> m PackageName
go (DefaultPrompt PackageName -> m PackageName)
-> DefaultPrompt PackageName -> m PackageName
forall a b. (a -> b) -> a -> b
$ PackageName -> DefaultPrompt PackageName
forall t. t -> DefaultPrompt t
DefaultPrompt PackageName
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 (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 <- 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 Bool
don'tUseName
then DefaultPrompt PackageName -> m PackageName
go DefaultPrompt PackageName
defName
else PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
n
else PackageName -> m PackageName
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 :: 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
FilePath
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 FilePath -> Maybe Version
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
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 (m :: * -> *) a. Monad m => a -> m a
return Version
v
licensePrompt :: Interactive m => InitFlags -> m SpecLicense
licensePrompt :: 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)
FilePath
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)
DefaultPrompt FilePath
forall t. DefaultPrompt t
MandatoryPrompt
Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
Bool
True
case CabalSpecVersion -> FilePath -> Maybe SpecLicense
forall a. Parsec a => CabalSpecVersion -> FilePath -> Maybe a
simpleParsec' CabalSpecVersion
csv FilePath
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 (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 (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 :: 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
$ do
FilePath
name <- m FilePath
forall (m :: * -> *). Interactive m => m FilePath
guessAuthorName
FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Author name" (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
name)
emailPrompt :: Interactive m => InitFlags -> m String
emailPrompt :: 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
$ do
FilePath
email' <- m FilePath
forall (m :: * -> *). Interactive m => m FilePath
guessAuthorEmail
FilePath -> DefaultPrompt FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt FilePath -> m FilePath
promptStr FilePath
"Maintainer email" (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
email')
homepagePrompt :: Interactive m => InitFlags -> m String
homepagePrompt :: 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 :: 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 :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s = FilePath
"(none)"
| Bool
otherwise = FilePath
s
mainFilePrompt :: Interactive m => InitFlags -> m HsFilePath
mainFilePrompt :: 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
FilePath
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 :: HsFilePath
hs = FilePath -> HsFilePath
toHsFilePath FilePath
fp
case HsFilePath -> HsFileType
_hsFileType HsFilePath
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 (m :: * -> *) a. Monad m => a -> m a
return HsFilePath
hs
testDirsPrompt :: Interactive m => InitFlags -> m [String]
testDirsPrompt :: 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
FilePath
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)
[FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]
languagePrompt :: Interactive m => InitFlags -> String -> m Language
languagePrompt :: 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)"
FilePath
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 -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
h2010)
Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
Bool
True
if
| FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
h2010 -> Language -> m Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
Haskell2010
| FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
h98 -> Language -> m Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
Haskell98
| FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
ghc2021 -> Language -> m Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
GHC2021
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum FilePath
l -> Language -> m Language
forall (m :: * -> *) a. Monad m => a -> m a
return (Language -> m Language) -> Language -> m Language
forall a b. (a -> b) -> a -> b
$ FilePath -> Language
UnknownLanguage FilePath
l
| Bool
otherwise -> do
FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn
(FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\nThe language must be alphanumeric. "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Please enter a different language."
InitFlags -> FilePath -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m Language
languagePrompt InitFlags
flags FilePath
pkgType
noCommentsPrompt :: Interactive m => InitFlags -> m Bool
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
Bool
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)
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
doComments)
appDirsPrompt :: Interactive m => InitFlags -> m [String]
appDirsPrompt :: 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
FilePath
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
[FilePath] -> m [FilePath]
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 (" 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"
srcDirsPrompt :: Interactive m => InitFlags -> m [String]
srcDirsPrompt :: 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
FilePath
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
[FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]