From 10687555d3c8524d5f5f373128ee80ccd56322bb Mon Sep 17 00:00:00 2001
From: Emily Pillmore <emilypi@cohomolo.gy>
Date: Tue, 4 May 2021 14:04:19 -0400
Subject: [PATCH] Rewrite `cabal init` command
* Restructures the `cabal init` command to fix historical
issues. All flags are preserved.
* Codebases for interactive and non-interactive flags
are disentangled.
* Data structures now exploit relevant stanza structure
and formatters only care about stanza data
* Heuristics and prompts have a pure and impure implementation.
* Sets default behavior to be `--interactive` as opposed to
`--non-interactive`.
* Rewrites tests to achieve 98% coverage
* Golden files now test every stanza individually
* Every flag is covered by a unit test
* Interactive, simple, and non-interactive workflows are
covered.
---
Cabal/src/Distribution/Fields/Pretty.hs | 13 +-
Cabal/src/Distribution/Simple/Test/ExeV10.hs | 4 +-
Cabal/src/Distribution/Simple/Test/LibV09.hs | 11 +-
cabal-install/cabal-install.cabal | 14 +-
cabal-install/main/Main.hs | 44 +-
.../src/Distribution/Client/Config.hs | 4 +-
.../src/Distribution/Client/GenBounds.hs | 4 +-
cabal-install/src/Distribution/Client/Init.hs | 56 +-
.../src/Distribution/Client/Init/Command.hs | 749 -----------
.../src/Distribution/Client/Init/Defaults.hs | 182 ++-
.../Distribution/Client/Init/FileCreators.hs | 851 ++++--------
.../Client/Init/FlagExtractors.hs | 267 ++++
.../src/Distribution/Client/Init/Format.hs | 338 +++++
.../Distribution/Client/Init/Heuristics.hs | 396 ------
.../Client/Init/Interactive/Command.hs | 459 +++++++
.../Client/Init/NonInteractive/Command.hs | 437 +++++++
.../Client/Init/NonInteractive/Heuristics.hs | 179 +++
.../src/Distribution/Client/Init/Prompt.hs | 243 ++--
.../src/Distribution/Client/Init/Simple.hs | 138 ++
.../src/Distribution/Client/Init/Types.hs | 505 +++++--
.../src/Distribution/Client/Init/Utils.hs | 293 ++++-
.../Distribution/Client/ProjectPlanning.hs | 4 +-
.../src/Distribution/Client/Setup.hs | 37 +-
.../src/Distribution/Client/Utils.hs | 139 +-
cabal-install/tests/UnitTests.hs | 5 +-
.../UnitTests/Distribution/Client/Init.hs | 241 +---
.../Distribution/Client/Init/Golden.hs | 367 ++++++
.../Distribution/Client/Init/Interactive.hs | 832 ++++++++++++
.../Client/Init/NonInteractive.hs | 1158 +++++++++++++++++
.../Distribution/Client/Init/Simple.hs | 151 +++
.../Distribution/Client/Init/Utils.hs | 82 ++
.../tests/fixtures/init/exe-only-golden.cabal | 20 -
.../cabal-lib-and-exe-no-comments.golden | 61 +
.../cabal-lib-and-exe-with-comments.golden} | 69 +-
.../golden/cabal/cabal-lib-no-comments.golden | 46 +
.../cabal/cabal-lib-with-comments.golden | 90 ++
.../exe/exe-build-tools-with-comments.golden | 21 +
.../golden/exe/exe-minimal-no-comments.golden | 5 +
.../exe/exe-simple-with-comments.golden | 12 +
.../init/golden/exe/exe-simple.golden | 13 +
.../init/golden/exe/exe-with-comments.golden | 18 +
.../tests/fixtures/init/golden/exe/exe.golden | 11 +
.../lib/lib-build-tools-with-comments.golden | 21 +
.../golden/lib/lib-minimal-no-comments.golden | 5 +
.../lib/lib-simple-with-comments.golden | 12 +
.../init/golden/lib/lib-simple.golden | 11 +
.../init/golden/lib/lib-with-comments.golden | 18 +
.../tests/fixtures/init/golden/lib/lib.golden | 11 +
.../pkg-desc/pkg-old-cabal-with-flags.golden | 45 +
.../init/golden/pkg-desc/pkg-simple.golden | 21 +
.../golden/pkg-desc/pkg-with-comments.golden | 46 +
.../golden/pkg-desc/pkg-with-flags.golden | 46 +
.../fixtures/init/golden/pkg-desc/pkg.golden | 46 +
.../test-build-tools-with-comments.golden | 24 +
.../test/test-minimal-no-comments.golden | 6 +
.../test/test-simple-with-comments.golden | 15 +
.../init/golden/test/test-simple.golden | 14 +
.../golden/test/test-with-comments.golden | 21 +
.../fixtures/init/golden/test/test.golden | 12 +
.../fixtures/init/lib-and-exe-golden.cabal | 31 -
.../init/lib-exe-and-test-golden.cabal | 43 -
cabal.project | 3 +-
.../cabal-lib-and-exe-no-comments.golden | 61 +
.../cabal-lib-and-exe-with-comments.golden | 111 ++
.../golden/cabal/cabal-lib-no-comments.golden | 46 +
.../cabal/cabal-lib-with-comments.golden | 90 ++
.../exe/exe-build-tools-with-comments.golden | 21 +
.../golden/exe/exe-minimal-no-comments.golden | 5 +
.../exe/exe-simple-with-comments.golden | 12 +
.../init/golden/exe/exe-with-comments.golden | 18 +
tests/fixtures/init/golden/exe/exe.golden | 11 +
.../lib/lib-build-tools-with-comments.golden | 21 +
.../golden/lib/lib-minimal-no-comments.golden | 5 +
.../lib/lib-simple-with-comments.golden | 12 +
.../init/golden/lib/lib-simple.golden | 11 +
.../init/golden/lib/lib-with-comments.golden | 18 +
tests/fixtures/init/golden/lib/lib.golden | 11 +
.../pkg-desc/pkg-old-cabal-with-flags.golden | 45 +
.../golden/pkg-desc/pkg-with-comments.golden | 46 +
.../golden/pkg-desc/pkg-with-flags.golden | 46 +
.../fixtures/init/golden/pkg-desc/pkg.golden | 46 +
.../test-build-tools-with-comments.golden | 24 +
.../test/test-minimal-no-comments.golden | 6 +
.../test/test-simple-with-comments.golden | 15 +
.../golden/test/test-with-comments.golden | 21 +
tests/fixtures/init/golden/test/test.golden | 12 +
86 files changed, 7286 insertions(+), 2448 deletions(-)
delete mode 100644 cabal-install/src/Distribution/Client/Init/Command.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/FlagExtractors.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/Format.hs
delete mode 100644 cabal-install/src/Distribution/Client/Init/Heuristics.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/Interactive/Command.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
create mode 100644 cabal-install/src/Distribution/Client/Init/Simple.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Init/NonInteractive.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Init/Simple.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Init/Utils.hs
delete mode 100644 cabal-install/tests/fixtures/init/exe-only-golden.cabal
create mode 100644 cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
rename cabal-install/tests/fixtures/init/{lib-exe-and-test-with-comments-golden.cabal => golden/cabal/cabal-lib-and-exe-with-comments.golden} (65%)
create mode 100644 cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe-simple.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/exe/exe.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib-simple.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/lib/lib.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-simple.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/pkg-desc/pkg.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test-minimal-no-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test-simple-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test-simple.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test-with-comments.golden
create mode 100644 cabal-install/tests/fixtures/init/golden/test/test.golden
delete mode 100644 cabal-install/tests/fixtures/init/lib-and-exe-golden.cabal
delete mode 100644 cabal-install/tests/fixtures/init/lib-exe-and-test-golden.cabal
create mode 100644 tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
create mode 100644 tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
create mode 100644 tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
create mode 100644 tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
create mode 100644 tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
create mode 100644 tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
create mode 100644 tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
create mode 100644 tests/fixtures/init/golden/exe/exe-with-comments.golden
create mode 100644 tests/fixtures/init/golden/exe/exe.golden
create mode 100644 tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
create mode 100644 tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
create mode 100644 tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
create mode 100644 tests/fixtures/init/golden/lib/lib-simple.golden
create mode 100644 tests/fixtures/init/golden/lib/lib-with-comments.golden
create mode 100644 tests/fixtures/init/golden/lib/lib.golden
create mode 100644 tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
create mode 100644 tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
create mode 100644 tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
create mode 100644 tests/fixtures/init/golden/pkg-desc/pkg.golden
create mode 100644 tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
create mode 100644 tests/fixtures/init/golden/test/test-minimal-no-comments.golden
create mode 100644 tests/fixtures/init/golden/test/test-simple-with-comments.golden
create mode 100644 tests/fixtures/init/golden/test/test-with-comments.golden
create mode 100644 tests/fixtures/init/golden/test/test.golden
diff --git a/Cabal/src/Distribution/Fields/Pretty.hs b/Cabal/src/Distribution/Fields/Pretty.hs
index 7af4728cee..dfca73a19d 100644
--- a/Cabal/src/Distribution/Fields/Pretty.hs
+++ b/Cabal/src/Distribution/Fields/Pretty.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE LambdaCase #-}
-- | Cabal-like file AST types: 'Field', 'Section' etc,
--
-- This (intermediate) data type is used for pretty-printing.
@@ -35,6 +36,7 @@ import qualified Text.PrettyPrint as PP
data PrettyField ann
= PrettyField ann FieldName PP.Doc
| PrettySection ann FieldName [PP.Doc] [PrettyField ann]
+ | PrettyEmpty
deriving (Functor, Foldable, Traversable)
-- | Prettyprint a list of fields.
@@ -74,8 +76,8 @@ showFields' rann post n = unlines . renderFields (Opts rann indent post)
indent2 xs = ' ' : ' ' : xs
data Opts ann = Opts
- { _optAnnotation ::(ann -> [String])
- , _optIndent ::(String -> String)
+ { _optAnnotation :: ann -> [String]
+ , _optIndent :: String -> String
, _optPostprocess :: ann -> [String] -> [String]
}
@@ -87,6 +89,7 @@ renderFields opts fields = flattenBlocks $ map (renderField opts len) fields
maxNameLength !acc [] = acc
maxNameLength !acc (PrettyField _ name _ : rest) = maxNameLength (max acc (BS.length name)) rest
maxNameLength !acc (PrettySection {} : rest) = maxNameLength acc rest
+ maxNameLength !acc (PrettyEmpty : rest) = maxNameLength acc rest
-- | Block of lines,
-- Boolean parameter tells whether block should be surrounded by empty lines
@@ -134,7 +137,9 @@ renderField opts@(Opts rann indent post) _ (PrettySection ann name args fields)
++
post ann [ PP.render $ PP.hsep $ PP.text (fromUTF8BS name) : args ]
++
- (map indent $ renderFields opts fields)
+ map indent (renderFields opts fields)
+
+renderField _ _ PrettyEmpty = Block NoMargin NoMargin mempty
-------------------------------------------------------------------------------
-- Transform from Parsec.Field
@@ -161,7 +166,7 @@ prettyFieldLines _ fls = PP.vcat
-- | Used in 'fromParsecFields'.
prettySectionArgs :: FieldName -> [P.SectionArg ann] -> [PP.Doc]
-prettySectionArgs _ = map $ \sa -> case sa of
+prettySectionArgs _ = map $ \case
P.SecArgName _ bs -> showToken $ fromUTF8BS bs
P.SecArgStr _ bs -> showToken $ fromUTF8BS bs
P.SecArgOther _ bs -> PP.text $ fromUTF8BS bs
diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
index 3a80f94027..345ee0807f 100644
--- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs
+++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
@@ -118,7 +118,7 @@ runTest pkg_descr lbi clbi flags suite = do
let suiteLog = buildLog exit
-- Write summary notice to log file indicating start of test suite
- appendFile (logFile suiteLog) $ summarizeSuiteStart $ testName'
+ appendFile (logFile suiteLog) $ summarizeSuiteStart testName'
-- Append contents of temporary log file to the final human-
-- readable log file
@@ -144,7 +144,7 @@ runTest pkg_descr lbi clbi flags suite = do
when isCoverageEnabled $
case PD.library pkg_descr of
Nothing ->
- die' verbosity $ "Error: test coverage is only supported for packages with a library component"
+ die' verbosity "Error: test coverage is only supported for packages with a library component"
Just library ->
markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library
diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs
index d667d7e0d4..2302e7773e 100644
--- a/Cabal/src/Distribution/Simple/Test/LibV09.hs
+++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs
@@ -158,12 +158,11 @@ runTest pkg_descr lbi clbi flags suite = do
notice verbosity $ summarizeSuiteFinish suiteLog
when isCoverageEnabled $
- case PD.library pkg_descr of
- Nothing ->
- die' verbosity $ "Error: test coverage is only supported for packages with a library component"
-
- Just library ->
- markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library
+ case PD.library pkg_descr of
+ Nothing ->
+ die' verbosity "Error: test coverage is only supported for packages with a library component"
+ Just library ->
+ markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library
return suiteLog
where
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 8e42a9bc7d..25c73f285e 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -119,12 +119,16 @@ library
Distribution.Client.IndexUtils.IndexState
Distribution.Client.IndexUtils.Timestamp
Distribution.Client.Init
- Distribution.Client.Init.Command
Distribution.Client.Init.Defaults
Distribution.Client.Init.FileCreators
- Distribution.Client.Init.Heuristics
+ Distribution.Client.Init.FlagExtractors
+ Distribution.Client.Init.Format
+ Distribution.Client.Init.Interactive.Command
+ Distribution.Client.Init.NonInteractive.Command
+ Distribution.Client.Init.NonInteractive.Heuristics
Distribution.Client.Init.Licenses
Distribution.Client.Init.Prompt
+ Distribution.Client.Init.Simple
Distribution.Client.Init.Types
Distribution.Client.Init.Utils
Distribution.Client.Install
@@ -203,6 +207,7 @@ library
directory >= 1.2.2.0 && < 1.4,
echo >= 0.1.3 && < 0.2,
edit-distance >= 0.2.2 && < 0.3,
+ exceptions,
filepath >= 1.4.0.0 && < 1.5,
hashable >= 1.0 && < 1.4,
HTTP >= 4000.1.5 && < 4000.4,
@@ -273,6 +278,11 @@ Test-Suite unit-tests
UnitTests.Distribution.Client.Glob
UnitTests.Distribution.Client.GZipUtils
UnitTests.Distribution.Client.Init
+ UnitTests.Distribution.Client.Init.Golden
+ UnitTests.Distribution.Client.Init.Interactive
+ UnitTests.Distribution.Client.Init.NonInteractive
+ UnitTests.Distribution.Client.Init.Simple
+ UnitTests.Distribution.Client.Init.Utils
UnitTests.Distribution.Client.Store
UnitTests.Distribution.Client.Tar
UnitTests.Distribution.Client.TreeDiffInstances
diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs
index fcbed90180..6bb112a26a 100644
--- a/cabal-install/main/Main.hs
+++ b/cabal-install/main/Main.hs
@@ -13,6 +13,7 @@
-- Entry point to the default cabal-install front-end.
-----------------------------------------------------------------------------
+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
module Main (main) where
import Distribution.Client.Setup
@@ -109,11 +110,12 @@ import Distribution.Client.Sandbox (loadConfigOrSandboxConfig
,updateInstallDirs)
import Distribution.Client.Tar (createTarGzFile)
import Distribution.Client.Types.Credentials (Password (..))
-import Distribution.Client.Init (initCabal)
+import Distribution.Client.Init (initCmd)
import Distribution.Client.Manpage (manpageCmd)
import Distribution.Client.ManpageFlags (ManpageFlags (..))
import Distribution.Client.Utils (determineNumJobs
,relaxEncodingErrors
+ ,cabalInstallVersion
)
import Distribution.Package (packageId)
@@ -219,9 +221,9 @@ mainWorker args = do
++ "defaults if you run 'cabal update'."
printOptionsList = putStr . unlines
printErrors errs = dieNoVerbosity $ intercalate "\n" errs
- printNumericVersion = putStrLn $ display cabalVersion
+ printNumericVersion = putStrLn $ display cabalInstallVersion
printVersion = putStrLn $ "cabal-install version "
- ++ display cabalVersion
+ ++ display cabalInstallVersion
++ "\ncompiled using version "
++ display cabalVersion
++ " of the Cabal library "
@@ -918,24 +920,24 @@ unpackAction getFlags extraArgs globalFlags = do
getAction getFlags extraArgs globalFlags
initAction :: InitFlags -> [String] -> Action
-initAction initFlags extraArgs globalFlags = do
- let verbosity = fromFlag (initVerbosity initFlags)
- when (extraArgs /= []) $
- die' verbosity $ "'init' doesn't take any extra arguments: " ++ unwords extraArgs
- config <- loadConfigOrSandboxConfig verbosity globalFlags
- let configFlags = savedConfigureFlags config `mappend`
- -- override with `--with-compiler` from CLI if available
- mempty { configHcPath = initHcPath initFlags }
- let initFlags' = savedInitFlags config `mappend` initFlags
- let globalFlags' = savedGlobalFlags config `mappend` globalFlags
- (comp, _, progdb) <- configCompilerAux' configFlags
- withRepoContext verbosity globalFlags' $ \repoContext ->
- initCabal verbosity
- (configPackageDB' configFlags)
- repoContext
- comp
- progdb
- initFlags'
+initAction initFlags extraArgs globalFlags
+ | not (null extraArgs) =
+ die' verbosity $ "'init' doesn't take any extra arguments: " ++ unwords extraArgs
+ | otherwise = do
+ confFlags <- loadConfigOrSandboxConfig verbosity globalFlags
+ -- override with `--with-compiler` from CLI if available
+ let confFlags' = savedConfigureFlags confFlags `mappend` compFlags
+ initFlags' = savedInitFlags confFlags `mappend` initFlags
+ globalFlags' = savedGlobalFlags confFlags `mappend` globalFlags
+
+ (comp, _, progdb) <- configCompilerAux' confFlags'
+
+ withRepoContext verbosity globalFlags' $ \repoContext ->
+ initCmd verbosity (configPackageDB' confFlags')
+ repoContext comp progdb initFlags'
+ where
+ verbosity = fromFlag (initVerbosity initFlags)
+ compFlags = mempty { configHcPath = initHcPath initFlags }
userConfigAction :: UserConfigFlags -> [String] -> Action
userConfigAction ucflags extraArgs globalFlags = do
diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
index e727753558..26ae5a87e3 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -841,8 +841,8 @@ commentSavedConfig = do
IT.cabalVersion = toFlag IT.defaultCabalVersion,
IT.language = toFlag Haskell2010,
IT.license = NoFlag,
- IT.sourceDirs = Just [IT.defaultSourceDir],
- IT.applicationDirs = Just [IT.defaultApplicationDir]
+ IT.sourceDirs = Flag [IT.defaultSourceDir],
+ IT.applicationDirs = Flag [IT.defaultApplicationDir]
},
savedInstallFlags = defaultInstallFlags,
savedClientInstallFlags= defaultClientInstallFlags,
diff --git a/cabal-install/src/Distribution/Client/GenBounds.hs b/cabal-install/src/Distribution/Client/GenBounds.hs
index 5fe5ffd8ba..3636f4ad66 100644
--- a/cabal-install/src/Distribution/Client/GenBounds.hs
+++ b/cabal-install/src/Distribution/Client/GenBounds.hs
@@ -18,7 +18,7 @@ module Distribution.Client.GenBounds (
import Prelude ()
import Distribution.Client.Compat.Prelude
-import Distribution.Client.Init
+import Distribution.Client.Utils
( incVersion )
import Distribution.Client.Freeze
( getFreezePkgs )
@@ -93,7 +93,7 @@ genBounds
-> GlobalFlags
-> FreezeFlags
-> IO ()
-genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do
+genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do
let cinfo = compilerInfo comp
cwd <- getCurrentDirectory
diff --git a/cabal-install/src/Distribution/Client/Init.hs b/cabal-install/src/Distribution/Client/Init.hs
index b7b37d2398..c463907581 100644
--- a/cabal-install/src/Distribution/Client/Init.hs
+++ b/cabal-install/src/Distribution/Client/Init.hs
@@ -13,13 +13,53 @@
--
-----------------------------------------------------------------------------
-module Distribution.Client.Init (
+module Distribution.Client.Init
+( -- * Commands
+ initCmd
+) where
- -- * Commands
- initCabal
- , incVersion
+import qualified Distribution.Client.Init.Interactive.Command as Interactive
+import qualified Distribution.Client.Init.NonInteractive.Command as NonInteractive
+import qualified Distribution.Client.Init.Simple as Simple
+import Distribution.Verbosity
+import Distribution.Client.Setup (RepoContext)
+import Distribution.Simple.Compiler
+import Distribution.Simple.Program (ProgramDb)
+import Distribution.Client.Init.Types
+import Distribution.Simple.Setup
+import Distribution.Client.IndexUtils
+import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))
+import Distribution.Client.Init.FileCreators
- ) where
-
-import Distribution.Client.Init.Command
- ( initCabal, incVersion )
+-- | This is the main driver for the init script.
+--
+initCmd
+ :: Verbosity
+ -> PackageDBStack
+ -> RepoContext
+ -> Compiler
+ -> ProgramDb
+ -> InitFlags
+ -> IO ()
+initCmd v packageDBs repoCtxt comp progdb initFlags = do
+ installedPkgIndex <- getInstalledPackages v comp packageDBs progdb
+ sourcePkgDb <- getSourcePackages v repoCtxt
+ hSetBuffering stdout NoBuffering
+ settings <- createProject v installedPkgIndex sourcePkgDb initFlags
+ writeProject settings
+ where
+ -- When no flag is set, default to interactive.
+ --
+ -- When `--interactive` is set, if we also set `--simple`,
+ -- then we interactive generate a simple project with sensible defaults.
+ --
+ -- If `--simple` is not set, default to interactive. When the flag
+ -- is explicitly set to `--non-interactive`, then we choose non-interactive.
+ --
+ createProject = case interactive initFlags of
+ NoFlag -> Interactive.createProject
+ Flag True
+ | fromFlagOrDefault False (simpleProject initFlags) ->
+ Simple.createProject
+ | otherwise -> Interactive.createProject
+ Flag False -> NonInteractive.createProject
diff --git a/cabal-install/src/Distribution/Client/Init/Command.hs b/cabal-install/src/Distribution/Client/Init/Command.hs
deleted file mode 100644
index 0842250cd1..0000000000
--- a/cabal-install/src/Distribution/Client/Init/Command.hs
+++ /dev/null
@@ -1,749 +0,0 @@
------------------------------------------------------------------------------
--- |
--- 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.Command
- ( -- * Commands
- initCabal
- , incVersion
-
- -- * Helpers
- , getSimpleProject
- , getLibOrExec
- , getCabalVersion
- , getPackageName
- , getVersion
- , getLicense
- , getAuthorInfo
- , getHomepage
- , getSynopsis
- , getCategory
- , getExtraSourceFiles
- , getAppDir
- , getSrcDir
- , getGenTests
- , getTestDir
- , getLanguage
- , getGenComments
- , getModulesBuildToolsAndDeps
- ) where
-
-import Prelude ()
-import Distribution.Client.Compat.Prelude hiding (empty)
-
-import System.IO
- ( hSetBuffering, stdout, BufferMode(..) )
-import System.Directory
- ( getCurrentDirectory, doesDirectoryExist, getDirectoryContents )
-import System.FilePath
- ( (</>), takeBaseName, equalFilePath )
-
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Map as M
-import Control.Monad
- ( (>=>) )
-import Control.Arrow
- ( (&&&), (***) )
-
-import Distribution.CabalSpecVersion
- ( CabalSpecVersion (..), showCabalSpecVersion )
-import Distribution.Version
- ( Version, mkVersion, alterVersion, majorBoundVersion
- , orLaterVersion, earlierVersion, intersectVersionRanges, VersionRange )
-import Distribution.ModuleName
- ( ModuleName ) -- And for the Text instance
-import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo, exposed )
-import qualified Distribution.Package as P
-import qualified Distribution.SPDX as SPDX
-import Language.Haskell.Extension ( Language(..) )
-
-import Distribution.Client.Init.Defaults
- ( defaultApplicationDir, defaultCabalVersion, myLibModule, defaultSourceDir )
-import Distribution.Client.Init.FileCreators
- ( writeLicense, writeChangeLog, createDirectories, createLibHs, createMainHs
- , createTestSuiteIfEligible, writeCabalFile )
-import Distribution.Client.Init.Prompt
- ( prompt, promptYesNo, promptStr, promptList, maybePrompt
- , promptListOptional )
-import Distribution.Client.Init.Utils
- ( eligibleForTestSuite, message )
-import Distribution.Client.Init.Types
- ( InitFlags(..), PackageType(..), Category(..)
- , displayPackageType )
-import Distribution.Client.Init.Heuristics
- ( guessPackageName, guessAuthorNameMail, guessMainFileCandidates,
- SourceFileEntry(..),
- scanForModules, neededBuildPrograms )
-
-import Distribution.Simple.Flag
- ( maybeToFlag )
-import Distribution.Simple.Setup
- ( Flag(..), flagToMaybe )
-import Distribution.Simple.Configure
- ( getInstalledPackages )
-import Distribution.Simple.Compiler
- ( PackageDBStack, Compiler )
-import Distribution.Simple.Program
- ( ProgramDb )
-import Distribution.Simple.PackageIndex
- ( InstalledPackageIndex, moduleNameIndex )
-import Distribution.Simple.Utils
- ( die' )
-
-import Distribution.Solver.Types.PackageIndex
- ( elemByPackageName )
-
-import Distribution.Client.IndexUtils
- ( getSourcePackages )
-import Distribution.Client.Types
- ( SourcePackageDb(..) )
-import Distribution.Client.Setup
- ( RepoContext(..) )
-
-initCabal :: Verbosity
- -> PackageDBStack
- -> RepoContext
- -> Compiler
- -> ProgramDb
- -> InitFlags
- -> IO ()
-initCabal verbosity packageDBs repoCtxt comp progdb initFlags = do
-
- installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
- sourcePkgDb <- getSourcePackages verbosity repoCtxt
-
- hSetBuffering stdout NoBuffering
-
- initFlags' <- extendFlags verbosity installedPkgIndex sourcePkgDb initFlags
-
- case license initFlags' of
- Flag SPDX.NONE -> return ()
- _ -> writeLicense initFlags'
- writeChangeLog initFlags'
- createDirectories (sourceDirs initFlags')
- createLibHs initFlags'
- createDirectories (applicationDirs initFlags')
- createMainHs initFlags'
- createTestSuiteIfEligible initFlags'
- success <- writeCabalFile initFlags'
-
- when success $ generateWarnings initFlags'
-
----------------------------------------------------------------------------
--- Flag acquisition -----------------------------------------------------
----------------------------------------------------------------------------
-
--- | Fill in more details in InitFlags by guessing, discovering, or prompting
--- the user.
-extendFlags :: Verbosity -> InstalledPackageIndex -> SourcePackageDb -> InitFlags -> IO InitFlags
-extendFlags verbosity pkgIx sourcePkgDb =
- getSimpleProject
- >=> getLibOrExec
- >=> getCabalVersion
- >=> getPackageName verbosity sourcePkgDb False
- >=> getVersion
- >=> getLicense
- >=> getAuthorInfo
- >=> getHomepage
- >=> getSynopsis
- >=> getCategory
- >=> getExtraSourceFiles
- >=> getAppDir
- >=> getSrcDir
- >=> getGenTests
- >=> getTestDir
- >=> getLanguage
- >=> getGenComments
- >=> getModulesBuildToolsAndDeps pkgIx
-
--- | Combine two actions which may return a value, preferring the first. That
--- is, run the second action only if the first doesn't return a value.
-infixr 1 ?>>
-(?>>) :: IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a)
-f ?>> g = do
- ma <- f
- if isJust ma
- then return ma
- else g
-
--- | Ask if a simple project with sensible defaults should be created.
-getSimpleProject :: InitFlags -> IO InitFlags
-getSimpleProject flags = do
- simpleProj <- return (flagToMaybe $ simpleProject flags)
- ?>> maybePrompt flags
- (promptYesNo
- "Should I generate a simple project with sensible defaults"
- (Just True))
- return $ case maybeToFlag simpleProj of
- Flag True ->
- flags { interactive = Flag False
- , simpleProject = Flag True
- , packageType = Flag LibraryAndExecutable
- , cabalVersion = Flag defaultCabalVersion
- }
- simpleProjFlag@_ ->
- flags { simpleProject = simpleProjFlag }
-
-
--- | Get the version of the cabal spec to use.
---
--- The spec version can be specified by the InitFlags cabalVersion field. If
--- none is specified then the user is prompted to pick from a list of
--- supported versions (see code below).
-getCabalVersion :: InitFlags -> IO InitFlags
-getCabalVersion flags = do
- cabVer <- return (flagToMaybe $ cabalVersion flags)
- ?>> maybePrompt flags (either (const defaultCabalVersion) id `fmap`
- promptList "Please choose version of the Cabal specification to use"
- [CabalSpecV1_10, CabalSpecV2_0, CabalSpecV2_2, CabalSpecV2_4, CabalSpecV3_0]
- (Just defaultCabalVersion) displayCabalVersion False)
- ?>> return (Just defaultCabalVersion)
-
- return $ flags { cabalVersion = maybeToFlag cabVer }
-
- where
- displayCabalVersion :: CabalSpecVersion -> String
- displayCabalVersion v = case v of
- CabalSpecV1_10 -> "1.10 (legacy)"
- CabalSpecV2_0 -> "2.0 (+ support for Backpack, internal sub-libs, '^>=' operator)"
- CabalSpecV2_2 -> "2.2 (+ support for 'common', 'elif', redundant commas, SPDX)"
- CabalSpecV2_4 -> "2.4 (+ support for '**' globbing)"
- CabalSpecV3_0 -> "3.0 (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"
- _ -> showCabalSpecVersion v
-
-
-
--- | Get the package name: use the package directory (supplied, or the current
--- directory by default) as a guess. It looks at the SourcePackageDb to avoid
--- using an existing package name.
-getPackageName :: Verbosity -> SourcePackageDb -> Bool -> InitFlags -> IO InitFlags
-getPackageName verbosity sourcePkgDb forceAsk flags = do
- guess <- maybe (getCurrentDirectory >>= guessPackageName) pure
- =<< traverse guessPackageName (flagToMaybe $ packageDir flags)
-
- pkgName' <- case (flagToMaybe $ packageName flags) >>= maybeForceAsk of
- Just pkgName -> return $ Just $ pkgName
- _ -> maybePrompt flags (prompt "Package name" (Just guess))
- let pkgName = fromMaybe guess pkgName'
-
- chooseAgain <- if isPkgRegistered pkgName
- then do
- answer' <- maybePrompt flags (promptYesNo (promptOtherNameMsg pkgName) (Just True))
- case answer' of
- Just answer -> return answer
- _ -> die' verbosity $ inUseMsg pkgName
- else
- return False
-
- if chooseAgain
- then getPackageName verbosity sourcePkgDb True flags
- else return $ flags { packageName = Flag pkgName }
-
- where
- maybeForceAsk x = if forceAsk then Nothing else Just x
-
- isPkgRegistered pkg = elemByPackageName (packageIndex sourcePkgDb) pkg
-
- inUseMsg pkgName = "The name " ++ (P.unPackageName pkgName) ++
- " is already in use by another package on Hackage."
-
- promptOtherNameMsg pkgName = (inUseMsg pkgName) ++
- " Do you want to choose a different name"
-
--- | Package version: use 0.1.0.0 as a last resort, but try prompting the user
--- if possible.
-getVersion :: InitFlags -> IO InitFlags
-getVersion flags = do
- let v = Just $ mkVersion [0,1,0,0]
- v' <- return (flagToMaybe $ version flags)
- ?>> maybePrompt flags (prompt "Package version" v)
- ?>> return v
- return $ flags { version = maybeToFlag v' }
-
--- | Choose a license for the package.
---
--- The license can come from Initflags (license field), if it is not present
--- then prompt the user from a predefined list of licenses.
-getLicense :: InitFlags -> IO InitFlags
-getLicense flags = do
- elic <- return (fmap Right $ flagToMaybe $ license flags)
- ?>> maybePrompt flags (promptList "Please choose a license" listedLicenses (Just SPDX.NONE) prettyShow True)
-
- case elic of
- Nothing -> return flags { license = NoFlag }
- Just (Right lic) -> return flags { license = Flag lic }
- Just (Left str) -> case eitherParsec str of
- Right lic -> return flags { license = Flag lic }
- -- on error, loop
- Left err -> do
- putStrLn "The license must be a valid SPDX expression."
- putStrLn err
- getLicense flags
- where
- -- perfectly we'll have this and writeLicense (in FileCreators)
- -- in a single file
- listedLicenses =
- SPDX.NONE :
- map (\lid -> SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing))
- [ SPDX.BSD_2_Clause
- , SPDX.BSD_3_Clause
- , SPDX.Apache_2_0
- , SPDX.MIT
- , SPDX.MPL_2_0
- , SPDX.ISC
-
- , SPDX.GPL_2_0_only
- , SPDX.GPL_3_0_only
- , SPDX.LGPL_2_1_only
- , SPDX.LGPL_3_0_only
- , SPDX.AGPL_3_0_only
-
- , SPDX.GPL_2_0_or_later
- , SPDX.GPL_3_0_or_later
- , SPDX.LGPL_2_1_or_later
- , SPDX.LGPL_3_0_or_later
- , SPDX.AGPL_3_0_or_later
- ]
-
--- | The author's name and email. Prompt, or try to guess from an existing
--- darcs repo.
-getAuthorInfo :: InitFlags -> IO InitFlags
-getAuthorInfo flags = do
- (authorName, authorEmail) <-
- (flagToMaybe *** flagToMaybe) `fmap` guessAuthorNameMail
- authorName' <- return (flagToMaybe $ author flags)
- ?>> maybePrompt flags (promptStr "Author name" authorName)
- ?>> return authorName
-
- authorEmail' <- return (flagToMaybe $ email flags)
- ?>> maybePrompt flags (promptStr "Maintainer email" authorEmail)
- ?>> return authorEmail
-
- return $ flags { author = maybeToFlag authorName'
- , email = maybeToFlag authorEmail'
- }
-
--- | Prompt for a homepage URL for the package.
-getHomepage :: InitFlags -> IO InitFlags
-getHomepage flags = do
- hp <- queryHomepage
- hp' <- return (flagToMaybe $ homepage flags)
- ?>> maybePrompt flags (promptStr "Project homepage URL" hp)
- ?>> return hp
-
- return $ flags { homepage = maybeToFlag hp' }
-
--- | Right now this does nothing, but it could be changed to do some
--- intelligent guessing.
-queryHomepage :: IO (Maybe String)
-queryHomepage = return Nothing -- get default remote darcs repo?
-
--- | Prompt for a project synopsis.
-getSynopsis :: InitFlags -> IO InitFlags
-getSynopsis flags = do
- syn <- return (flagToMaybe $ synopsis flags)
- ?>> maybePrompt flags (promptStr "Project synopsis" Nothing)
-
- return $ flags { synopsis = maybeToFlag syn }
-
--- | Prompt for a package category.
--- Note that it should be possible to do some smarter guessing here too, i.e.
--- look at the name of the top level source directory.
-getCategory :: InitFlags -> IO InitFlags
-getCategory flags = do
- cat <- return (flagToMaybe $ category flags)
- ?>> fmap join (maybePrompt flags
- (promptListOptional "Project category" [Codec ..]))
- return $ flags { category = maybeToFlag cat }
-
--- | Try to guess extra source files (don't prompt the user).
-getExtraSourceFiles :: InitFlags -> IO InitFlags
-getExtraSourceFiles flags = do
- extraSrcFiles <- return (extraSrc flags)
- ?>> Just `fmap` guessExtraSourceFiles flags
-
- return $ flags { extraSrc = extraSrcFiles }
-
-defaultChangeLog :: FilePath
-defaultChangeLog = "CHANGELOG.md"
-
--- | Try to guess things to include in the extra-source-files field.
--- For now, we just look for things in the root directory named
--- 'readme', 'changes', or 'changelog', with any sort of
--- capitalization and any extension.
-guessExtraSourceFiles :: InitFlags -> IO [FilePath]
-guessExtraSourceFiles flags = do
- dir <-
- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
- files <- getDirectoryContents dir
- let extraFiles = filter isExtra files
- if any isLikeChangeLog extraFiles
- then return extraFiles
- else return (defaultChangeLog : extraFiles)
-
- where
- isExtra = likeFileNameBase ("README" : changeLogLikeBases)
- isLikeChangeLog = likeFileNameBase changeLogLikeBases
- likeFileNameBase candidates = (`elem` candidates) . map toUpper . takeBaseName
- changeLogLikeBases = ["CHANGES", "CHANGELOG"]
-
--- | Ask whether the project builds a library or executable.
-getLibOrExec :: InitFlags -> IO InitFlags
-getLibOrExec flags = do
- pkgType <- return (flagToMaybe $ packageType flags)
- ?>> maybePrompt flags (either (const Executable) id `fmap`
- promptList "What does the package build"
- [Executable, Library, LibraryAndExecutable]
- Nothing displayPackageType False)
- ?>> return (Just Executable)
-
- -- If this package contains an executable, get the main file name.
- mainFile <- if pkgType == Just Library then return Nothing else
- getMainFile flags
-
- return $ flags { packageType = maybeToFlag pkgType
- , mainIs = maybeToFlag mainFile
- }
-
-
--- | Try to guess the main file of the executable, and prompt the user to choose
--- one of them. Top-level modules including the word 'Main' in the file name
--- will be candidates, and shorter filenames will be preferred.
-getMainFile :: InitFlags -> IO (Maybe FilePath)
-getMainFile flags =
- return (flagToMaybe $ mainIs flags)
- ?>> do
- candidates <- guessMainFileCandidates flags
- let showCandidate = either (++" (does not yet exist, but will be created)") id
- defaultFile = listToMaybe candidates
- maybePrompt flags (either id (either id id) `fmap`
- promptList "What is the main module of the executable"
- candidates
- defaultFile showCandidate True)
- ?>> return (fmap (either id id) defaultFile)
-
--- | Ask if a test suite should be generated for the library.
-getGenTests :: InitFlags -> IO InitFlags
-getGenTests flags = do
- genTests <- return (flagToMaybe $ initializeTestSuite flags)
- -- Only generate a test suite if the package contains a library.
- ?>> if (packageType flags) == Flag Executable then return (Just False) else return Nothing
- ?>> maybePrompt flags
- (promptYesNo
- "Should I generate a test suite for the library"
- (Just True))
- return $ flags { initializeTestSuite = maybeToFlag genTests }
-
--- | Ask for the test suite root directory.
-getTestDir :: InitFlags -> IO InitFlags
-getTestDir flags = do
- dirs <- return (testDirs flags)
- -- Only need testDirs when test suite generation is enabled.
- ?>> if not (eligibleForTestSuite flags) then return (Just []) else return Nothing
- ?>> fmap (fmap ((:[]) . either id id)) (maybePrompt
- flags
- (promptList "Test directory" ["test"] (Just "test") id True))
-
- return $ flags { testDirs = dirs }
-
--- | Ask for the Haskell base language of the package.
-getLanguage :: InitFlags -> IO InitFlags
-getLanguage flags = do
- lang <- return (flagToMaybe $ language flags)
- ?>> maybePrompt flags
- (either UnknownLanguage id `fmap`
- promptList "What base language is the package written in"
- [Haskell2010, Haskell98]
- (Just Haskell2010) prettyShow True)
- ?>> return (Just Haskell2010)
-
- if invalidLanguage lang
- then putStrLn invalidOtherLanguageMsg >> getLanguage flags
- else return $ flags { language = maybeToFlag lang }
-
- where
- invalidLanguage (Just (UnknownLanguage t)) = any (not . isAlphaNum) t
- invalidLanguage _ = False
-
- invalidOtherLanguageMsg = "\nThe language must be alphanumeric. " ++
- "Please enter a different language."
-
--- | Ask whether to generate explanatory comments.
-getGenComments :: InitFlags -> IO InitFlags
-getGenComments flags = do
- genComments <- return (not <$> flagToMaybe (noComments flags))
- ?>> maybePrompt flags (promptYesNo promptMsg (Just False))
- ?>> return (Just False)
- return $ flags { noComments = maybeToFlag (fmap not genComments) }
- where
- promptMsg = "Add informative comments to each field in the cabal file (y/n)"
-
--- | Ask for the application root directory.
-getAppDir :: InitFlags -> IO InitFlags
-getAppDir flags = do
- appDirs <- noAppDirIfLibraryOnly
- ?>> guessAppDir flags
- ?>> promptUserForApplicationDir
- ?>> setDefault
- return $ flags { applicationDirs = appDirs }
- where
- -- If the packageType==Library, ignore defined appdir.
- noAppDirIfLibraryOnly :: IO (Maybe [String])
- noAppDirIfLibraryOnly
- | packageType flags == Flag Library = return $ Just []
- | otherwise = return $ applicationDirs flags
-
- -- Set the default application directory.
- setDefault :: IO (Maybe [String])
- setDefault = pure (Just [defaultApplicationDir])
-
- -- Prompt the user for the application directory (defaulting to "app").
- -- Returns 'Nothing' if in non-interactive mode, otherwise will always
- -- return a 'Just' value ('Just []' if no separate application directory).
- promptUserForApplicationDir :: IO (Maybe [String])
- promptUserForApplicationDir = fmap (either (:[]) id) <$> maybePrompt
- flags
- (promptList
- ("Application " ++ mainFile ++ "directory")
- [[defaultApplicationDir], ["src-exe"], []]
- (Just [defaultApplicationDir])
- showOption True)
-
- showOption :: [String] -> String
- showOption [] = "(none)"
- showOption (x:_) = x
-
- -- The name
- mainFile :: String
- mainFile = case mainIs flags of
- Flag mainPath -> "(" ++ mainPath ++ ") "
- _ -> ""
-
--- | Try to guess app directory. Could try harder; for the
--- moment just looks to see whether there is a directory called 'app'.
-guessAppDir :: InitFlags -> IO (Maybe [String])
-guessAppDir flags = do
- dir <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
- appIsDir <- doesDirectoryExist (dir </> "app")
- return $ if appIsDir
- then Just ["app"]
- else Nothing
-
--- | Ask for the source (library) root directory.
-getSrcDir :: InitFlags -> IO InitFlags
-getSrcDir flags = do
- srcDirs <- noSourceDirIfExecutableOnly
- ?>> guessSourceDir flags
- ?>> promptUserForSourceDir
- ?>> setDefault
-
- return $ flags { sourceDirs = srcDirs }
-
- where
- -- If the packageType==Executable, then ignore source dir
- noSourceDirIfExecutableOnly :: IO (Maybe [String])
- noSourceDirIfExecutableOnly
- | packageType flags == Flag Executable = return $ Just []
- | otherwise = return $ sourceDirs flags
-
- -- Set the default source directory.
- setDefault :: IO (Maybe [String])
- setDefault = pure (Just [defaultSourceDir])
-
- -- Prompt the user for the source directory (defaulting to "app").
- -- Returns 'Nothing' if in non-interactive mode, otherwise will always
- -- return a 'Just' value ('Just []' if no separate application directory).
- promptUserForSourceDir :: IO (Maybe [String])
- promptUserForSourceDir = fmap (either (:[]) id) <$> maybePrompt
- flags
- (promptList
- ("Library source directory")
- [[defaultSourceDir], ["lib"], ["src-lib"], []]
- (Just [defaultSourceDir])
- showOption True)
-
- showOption :: [String] -> String
- showOption [] = "(none)"
- showOption (x:_) = x
-
-
--- | Try to guess source directory. Could try harder; for the
--- moment just looks to see whether there is a directory called 'src'.
-guessSourceDir :: InitFlags -> IO (Maybe [String])
-guessSourceDir flags = do
- dir <-
- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
- srcIsDir <- doesDirectoryExist (dir </> "src")
- return $ if srcIsDir
- then Just ["src"]
- else Nothing
-
--- | Check whether a potential source file is located in one of the
--- source directories.
-isSourceFile :: Maybe [FilePath] -> SourceFileEntry -> Bool
-isSourceFile Nothing sf = isSourceFile (Just ["."]) sf
-isSourceFile (Just srcDirs) sf = any (equalFilePath (relativeSourcePath sf)) srcDirs
-
--- | Get the list of exposed modules and extra tools needed to build them.
-getModulesBuildToolsAndDeps :: InstalledPackageIndex -> InitFlags -> IO InitFlags
-getModulesBuildToolsAndDeps pkgIx flags = do
- dir <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
-
- sourceFiles0 <- scanForModules dir
-
- let sourceFiles = filter (isSourceFile (sourceDirs flags)) sourceFiles0
-
- Just mods <- return (exposedModules flags)
- ?>> (return . Just . map moduleName $ sourceFiles)
-
- tools <- return (buildTools flags)
- ?>> (return . Just . neededBuildPrograms $ sourceFiles)
-
- deps <- return (dependencies flags)
- ?>> Just <$> importsToDeps flags
- (fromString "Prelude" : -- to ensure we get base as a dep
- ( nub -- only need to consider each imported package once
- . filter (`notElem` mods) -- don't consider modules from
- -- this package itself
- . concatMap imports
- $ sourceFiles
- )
- )
- pkgIx
-
- exts <- return (otherExts flags)
- ?>> (return . Just . nub . concatMap extensions $ sourceFiles)
-
- -- If we're initializing a library and there were no modules discovered
- -- then create an empty 'MyLib' module.
- -- This gets a little tricky when 'sourceDirs' == 'applicationDirs' because
- -- then the executable needs to set 'other-modules: MyLib' or else the build
- -- fails.
- let (finalModsList, otherMods) = case (packageType flags, mods) of
-
- -- For an executable leave things as they are.
- (Flag Executable, _) -> (mods, otherModules flags)
-
- -- If a non-empty module list exists don't change anything.
- (_, (_:_)) -> (mods, otherModules flags)
-
- -- Library only: 'MyLib' in 'other-modules' only.
- (Flag Library, _) -> ([myLibModule], Nothing)
-
- -- For a 'LibraryAndExecutable' we need to have special handling.
- -- If we don't have a module list (Nothing or empty), then create a Lib.
- (_, []) ->
- if sourceDirs flags == applicationDirs flags
- then ([myLibModule], Just [myLibModule])
- else ([myLibModule], Nothing)
-
- return $ flags { exposedModules = Just finalModsList
- , otherModules = otherMods
- , buildTools = tools
- , dependencies = deps
- , otherExts = exts
- }
-
--- | Given a list of imported modules, retrieve the list of dependencies that
--- provide those modules.
-importsToDeps :: InitFlags -> [ModuleName] -> InstalledPackageIndex -> IO [P.Dependency]
-importsToDeps flags mods pkgIx = do
-
- let modMap :: M.Map ModuleName [InstalledPackageInfo]
- modMap = M.map (filter exposed) $ moduleNameIndex pkgIx
-
- modDeps :: [(ModuleName, Maybe [InstalledPackageInfo])]
- modDeps = map (id &&& flip M.lookup modMap) mods
-
- message flags "\nGuessing dependencies..."
- nub . catMaybes <$> traverse (chooseDep flags) modDeps
-
--- Given a module and a list of installed packages providing it,
--- choose a dependency (i.e. package + version range) to use for that
--- module.
-chooseDep :: InitFlags -> (ModuleName, Maybe [InstalledPackageInfo])
- -> IO (Maybe P.Dependency)
-
-chooseDep flags (m, Nothing)
- = message flags ("\nWarning: no package found providing " ++ prettyShow m ++ ".")
- >> return Nothing
-
-chooseDep flags (m, Just [])
- = message flags ("\nWarning: no package found providing " ++ prettyShow m ++ ".")
- >> return Nothing
-
- -- We found some packages: group them by name.
-chooseDep flags (m, Just ps)
- = case pkgGroups of
- -- if there's only one group, i.e. multiple versions of a single package,
- -- we make it into a dependency, choosing the latest-ish version (see toDep).
- [grp] -> Just <$> toDep grp
- -- otherwise, we refuse to choose between different packages and make the user
- -- do it.
- grps -> do message flags ("\nWarning: multiple packages found providing "
- ++ prettyShow m
- ++ ": " ++ intercalate ", " (fmap (prettyShow . P.pkgName . NE.head) grps))
- message flags "You will need to pick one and manually add it to the Build-depends: field."
- return Nothing
- where
- pkgGroups = NE.groupBy ((==) `on` P.pkgName) (map P.packageId ps)
-
- desugar = maybe True (< CabalSpecV2_0) $ flagToMaybe (cabalVersion flags)
-
- -- Given a list of available versions of the same package, pick a dependency.
- toDep :: NonEmpty P.PackageIdentifier -> IO P.Dependency
-
- -- If only one version, easy. We change e.g. 0.4.2 into 0.4.*
- toDep (pid:|[]) = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) P.mainLibSet --TODO sublibraries
-
- -- Otherwise, choose the latest version and issue a warning.
- toDep pids = do
- message flags ("\nWarning: multiple versions of " ++ prettyShow (P.pkgName . NE.head $ pids) ++ " provide " ++ prettyShow m ++ ", choosing the latest.")
- return $ P.Dependency (P.pkgName . NE.head $ pids)
- (pvpize desugar . maximum . fmap P.pkgVersion $ pids)
- P.mainLibSet --TODO take into account sublibraries
-
--- | Given a version, return an API-compatible (according to PVP) version range.
---
--- If the boolean argument denotes whether to use a desugared
--- representation (if 'True') or the new-style @^>=@-form (if
--- 'False').
---
--- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the
--- same as @0.4.*@).
-pvpize :: Bool -> Version -> VersionRange
-pvpize False v = majorBoundVersion v
-pvpize True v = orLaterVersion v'
- `intersectVersionRanges`
- earlierVersion (incVersion 1 v')
- where v' = alterVersion (take 2) v
-
--- | Increment the nth version component (counting from 0).
-incVersion :: Int -> Version -> Version
-incVersion n = alterVersion (incVersion' n)
- where
- incVersion' 0 [] = [1]
- incVersion' 0 (v:_) = [v+1]
- incVersion' m [] = replicate m 0 ++ [1]
- incVersion' m (v:vs) = v : incVersion' (m-1) vs
-
--- | Generate warnings for missing fields etc.
-generateWarnings :: InitFlags -> IO ()
-generateWarnings flags = do
- message flags ""
- when (synopsis flags `elem` [NoFlag, Flag ""])
- (message flags "Warning: no synopsis given. You should edit the .cabal file and add one.")
-
- message flags "You may want to edit the .cabal file and add a Description field."
diff --git a/cabal-install/src/Distribution/Client/Init/Defaults.hs b/cabal-install/src/Distribution/Client/Init/Defaults.hs
index 7f87a28f1f..7a629dc4bb 100644
--- a/cabal-install/src/Distribution/Client/Init/Defaults.hs
+++ b/cabal-install/src/Distribution/Client/Init/Defaults.hs
@@ -12,21 +12,52 @@
--
-----------------------------------------------------------------------------
-module Distribution.Client.Init.Defaults (
- defaultApplicationDir
- , defaultSourceDir
- , defaultCabalVersion
- , myLibModule
- ) where
-
-import Prelude (String)
-
-import Distribution.ModuleName
- ( ModuleName ) -- And for the Text instance
-import qualified Distribution.ModuleName as ModuleName
- ( fromString )
-import Distribution.CabalSpecVersion
- ( CabalSpecVersion (..))
+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
+module Distribution.Client.Init.Defaults
+
+( -- * default init values
+ defaultApplicationDir
+, defaultSourceDir
+, defaultCabalVersion
+, defaultCabalVersions
+, defaultPackageType
+, defaultLicense
+, defaultLicenseIds
+, defaultMainIs
+, defaultChangelog
+, defaultCategories
+, defaultInitFlags
+, defaultLanguage
+, defaultVersion
+, defaultTestDir
+ -- * MyLib defaults
+, myLibModule
+, myLibTestFile
+, myLibFile
+, myLibHs
+, myExeHs
+, myLibExeHs
+, myTestHs
+) where
+
+
+import Distribution.ModuleName (ModuleName)
+import qualified Distribution.ModuleName as ModuleName(fromString)
+import Distribution.CabalSpecVersion (CabalSpecVersion (..))
+import Distribution.Client.Init.Types (PackageType(..), InitFlags(..), HsFilePath, toHsFilePath)
+import qualified Distribution.SPDX.License as SPDX
+import qualified Distribution.SPDX.LicenseId as SPDX
+import Distribution.Simple.Flag (toFlag)
+import Distribution.Verbosity (normal)
+import Distribution.Types.Version
+import Distribution.Simple
+
+
+-- -------------------------------------------------------------------- --
+-- Default flag and init values
+
+defaultVersion :: Version
+defaultVersion = mkVersion [0,1,0,0]
defaultApplicationDir :: String
defaultApplicationDir = "app"
@@ -34,8 +65,127 @@ defaultApplicationDir = "app"
defaultSourceDir :: String
defaultSourceDir = "src"
+defaultTestDir :: String
+defaultTestDir = "test"
+
defaultCabalVersion :: CabalSpecVersion
-defaultCabalVersion = CabalSpecV2_4
+defaultCabalVersion = CabalSpecV3_0
+
+defaultPackageType :: PackageType
+defaultPackageType = Executable
+
+defaultChangelog :: FilePath
+defaultChangelog = "CHANGELOG.md"
+
+defaultLicense :: SPDX.License
+defaultLicense = SPDX.NONE
+
+defaultMainIs :: HsFilePath
+defaultMainIs = toHsFilePath "Main.hs"
+
+defaultLanguage :: Language
+defaultLanguage = Haskell2010
+
+defaultLicenseIds :: [SPDX.LicenseId]
+defaultLicenseIds =
+ [ SPDX.BSD_2_Clause
+ , SPDX.BSD_3_Clause
+ , SPDX.Apache_2_0
+ , SPDX.MIT
+ , SPDX.MPL_2_0
+ , SPDX.ISC
+ , SPDX.GPL_2_0_only
+ , SPDX.GPL_3_0_only
+ , SPDX.LGPL_2_1_only
+ , SPDX.LGPL_3_0_only
+ , SPDX.AGPL_3_0_only
+ , SPDX.GPL_2_0_or_later
+ , SPDX.GPL_3_0_or_later
+ , SPDX.LGPL_2_1_or_later
+ , SPDX.LGPL_3_0_or_later
+ , SPDX.AGPL_3_0_or_later
+ ]
+
+defaultCategories :: [String]
+defaultCategories =
+ [ "Codec"
+ , "Concurrency"
+ , "Control"
+ , "Data"
+ , "Database"
+ , "Development"
+ , "Distribution"
+ , "Game"
+ , "Graphics"
+ , "Language"
+ , "Math"
+ , "Network"
+ , "Sound"
+ , "System"
+ , "Testing"
+ , "Text"
+ , "Web"
+ ]
+
+defaultCabalVersions :: [CabalSpecVersion]
+defaultCabalVersions =
+ [ CabalSpecV1_10
+ , CabalSpecV2_0
+ , CabalSpecV2_2
+ , CabalSpecV2_4
+ , CabalSpecV3_0
+ , CabalSpecV3_4
+ ]
+
+defaultInitFlags :: InitFlags
+defaultInitFlags = mempty { initVerbosity = toFlag normal }
+
+-- -------------------------------------------------------------------- --
+-- MyLib defaults
myLibModule :: ModuleName
myLibModule = ModuleName.fromString "MyLib"
+
+myLibTestFile :: HsFilePath
+myLibTestFile = toHsFilePath "MyLibTest.hs"
+
+myLibFile :: HsFilePath
+myLibFile = toHsFilePath "MyLib.hs"
+
+-- | Default MyLib.hs file. Used when no Lib.hs exists.
+myLibHs :: String
+myLibHs = unlines
+ [ "module MyLib (someFunc) where"
+ , ""
+ , "someFunc :: IO ()"
+ , "someFunc = putStrLn \"someFunc\""
+ ]
+
+myExeHs :: [String]
+myExeHs =
+ [ "module Main where"
+ , ""
+ , "main :: IO ()"
+ , "main = putStrLn \"Hello, Haskell!\""
+ ]
+
+myLibExeHs :: [String]
+myLibExeHs =
+ [ "module Main where"
+ , ""
+ , "import qualified MyLib (someFunc)"
+ , ""
+ , "main :: IO ()"
+ , "main = do"
+ , " putStrLn \"Hello, Haskell!\""
+ , " MyLib.someFunc"
+ ]
+
+-- | Default MyLibTest.hs file.
+myTestHs :: String
+myTestHs = unlines
+ [ "module Main (main) where"
+ , ""
+ , "main :: IO ()"
+ , "main = putStrLn \"Test suite not yet implemented.\""
+ ]
diff --git a/cabal-install/src/Distribution/Client/Init/FileCreators.hs b/cabal-install/src/Distribution/Client/Init/FileCreators.hs
index 5e4cc6ab95..7ce2c26be9 100644
--- a/cabal-install/src/Distribution/Client/Init/FileCreators.hs
+++ b/cabal-install/src/Distribution/Client/Init/FileCreators.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
@@ -12,640 +13,280 @@
-- Functions to create files during 'cabal init'.
--
-----------------------------------------------------------------------------
+module Distribution.Client.Init.FileCreators
+( -- * Commands
+ writeProject
+, writeLicense
+, writeChangeLog
+, prepareLibTarget
+, prepareExeTarget
+, prepareTestTarget
+) where
+
+import Prelude hiding (writeFile)
+import Distribution.Client.Compat.Prelude hiding (head, empty, writeFile)
+
+import Distribution.Client.Utils (getCurrentYear)
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Licenses
+ ( bsd2, bsd3, gplv2, gplv3, lgpl21, lgpl3, agplv3, apache20, mit, mpl20, isc )
+import Distribution.Client.Init.Types hiding (putStrLn, putStr, message)
+import qualified Distribution.Client.Init.Types as T
+import Distribution.Fields.Pretty (PrettyField(..), showFields')
+import qualified Distribution.SPDX as SPDX
+import Distribution.Types.PackageName
-module Distribution.Client.Init.FileCreators (
+import System.Directory hiding (doesDirectoryExist, doesFileExist, createDirectory, renameDirectory, copyFile)
+import System.FilePath ((</>), (<.>))
- -- * Commands
- writeLicense
- , writeChangeLog
- , createDirectories
- , createLibHs
- , createMainHs
- , createTestSuiteIfEligible
- , writeCabalFile
+import Distribution.Client.Init.Format
- -- * For testing
- , generateCabalFile
- ) where
-import Prelude ()
-import Distribution.Client.Compat.Prelude hiding (empty)
+-- -------------------------------------------------------------------- --
+-- File generation
-import System.FilePath
- ( (</>), (<.>), takeExtension )
+writeProject :: ProjectSettings -> IO ()
+writeProject (ProjectSettings opts pkgDesc libTarget exeTarget testTarget)
+ | null pkgName = do
+ message opts "\nError: no package name given, so no .cabal file can be generated\n"
+ | otherwise = do
-import Distribution.Types.Dependency
-import Distribution.Types.VersionRange
+ -- clear prompt history a bit"
+ message opts ""
-import Data.Time
- ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone )
-import System.Directory
- ( getCurrentDirectory, doesFileExist, copyFile
- , createDirectoryIfMissing )
+ writeLicense opts pkgDesc
+ writeChangeLog opts pkgDesc
-import Text.PrettyPrint hiding ((<>), mode, cat)
+ let pkgFields = mkPkgDescription opts pkgDesc
-import Distribution.Client.Init.Defaults
- ( defaultCabalVersion, myLibModule )
-import Distribution.Client.Init.Licenses
- ( bsd2, bsd3, gplv2, gplv3, lgpl21, lgpl3, agplv3, apache20, mit, mpl20, isc )
-import Distribution.Client.Init.Utils
- ( eligibleForTestSuite, message )
-import Distribution.Client.Init.Types
- ( InitFlags(..), BuildType(..), PackageType(..) )
-
-import Distribution.CabalSpecVersion
-import Distribution.Compat.Newtype
- ( Newtype )
-import Distribution.Fields.Field
- ( FieldName )
-import Distribution.License
- ( licenseFromSPDX )
-import qualified Distribution.ModuleName as ModuleName
- ( toFilePath )
-import Distribution.FieldGrammar.Newtypes
- ( SpecVersion(..) )
-import Distribution.PackageDescription.FieldGrammar
- ( formatDependencyList, formatExposedModules, formatHsSourceDirs,
- formatOtherExtensions, formatOtherModules, formatExtraSourceFiles )
-import Distribution.Simple.Flag
- ( maybeToFlag )
-import Distribution.Simple.Setup
- ( Flag(..), flagToMaybe )
-import Distribution.Simple.Utils
- ( toUTF8BS )
-import Distribution.Fields.Pretty
- ( PrettyField(..), showFields' )
+ libStanza <- prepareLibTarget opts libTarget
+ exeStanza <- prepareExeTarget opts exeTarget
+ testStanza <- prepareTestTarget opts testTarget
-import qualified Distribution.SPDX as SPDX
+ writeCabalFile opts $ pkgFields ++ [libStanza, exeStanza, testStanza]
+
+ when (null $ _pkgSynopsis pkgDesc) $
+ message opts "\nWarning: no synopsis given. You should edit the .cabal file and add one."
-import Distribution.Utils.Path -- TODO
+ message opts "You may want to edit the .cabal file and add a Description field."
+ where
+ pkgName = unPackageName $ _optPkgName opts
+
+
+prepareLibTarget
+ :: WriteOpts
+ -> Maybe LibTarget
+ -> IO (PrettyField FieldAnnotation)
+prepareLibTarget _ Nothing = return PrettyEmpty
+prepareLibTarget opts (Just libTarget) = do
+ void $ writeDirectoriesSafe opts srcDirs
+ -- avoid writing when conflicting exposed paths may
+ -- exist.
+ when (expMods == (myLibModule :| [])) $ do
+ writeFileSafe opts libPath myLibHs
+
+ return $ mkLibStanza opts libTarget
+ where
+ expMods = _libExposedModules libTarget
+ srcDirs = _libSourceDirs libTarget
+ libPath = case srcDirs of
+ path:_ -> path </> _hsFilePath myLibFile
+ _ -> _hsFilePath myLibFile
+
+prepareExeTarget
+ :: WriteOpts
+ -> Maybe ExeTarget
+ -> IO (PrettyField FieldAnnotation)
+prepareExeTarget _ Nothing = return PrettyEmpty
+prepareExeTarget opts (Just exeTarget) = do
+ void $ writeDirectoriesSafe opts appDirs
+ void $ writeFileSafe opts mainPath mainHs
+ return $ mkExeStanza opts exeTarget
+ where
+ exeMainIs = _exeMainIs exeTarget
+ pkgType = _optPkgType opts
+ appDirs = _exeApplicationDirs exeTarget
+ mainFile = _hsFilePath exeMainIs
+ mainPath = case appDirs of
+ appPath:_ -> appPath </> mainFile
+ _ -> mainFile
+
+ mainHs = unlines . mkLiterate exeMainIs $
+ if pkgType == LibraryAndExecutable
+ then myLibExeHs
+ else myExeHs
+
+prepareTestTarget
+ :: WriteOpts
+ -> Maybe TestTarget
+ -> IO (PrettyField FieldAnnotation)
+prepareTestTarget _ Nothing = return PrettyEmpty
+prepareTestTarget opts (Just testTarget) = do
+ void $ writeDirectoriesSafe opts testDirs'
+ void $ writeFileSafe opts testPath myTestHs
+ return $ mkTestStanza opts testTarget
+ where
+ testDirs' = _testDirs testTarget
+ testMainIs = _hsFilePath $ _testMainIs testTarget
+ testPath = case testDirs' of
+ p:_ -> p </> testMainIs
+ _ -> testMainIs
+
+writeCabalFile
+ :: WriteOpts
+ -> [PrettyField FieldAnnotation]
+ -- ^ .cabal fields
+ -> IO ()
+writeCabalFile opts fields = do
+ message opts $ "\nGenerating " ++ cabalFileName ++ "..."
+ exists <- doesFileExist cabalFileName
+
+ if exists && doOverwrite then do
+ removeFile cabalFileName
+ writeFileSafe opts cabalFileName cabalContents
+ else writeFileSafe opts cabalFileName cabalContents
+ where
+ doOverwrite = _optOverwrite opts
----------------------------------------------------------------------------
--- File generation ------------------------------------------------------
----------------------------------------------------------------------------
+ cabalContents = showFields'
+ annCommentLines
+ postProcessFieldLines
+ 4 fields
--- | Write the LICENSE file, as specified in the InitFlags license field.
+ cabalFileName = pkgName ++ ".cabal"
+ pkgName = unPackageName $ _optPkgName opts
+
+-- | Write the LICENSE file.
--
--- For licences that contain the author's name(s), the values are taken
+-- For licenses that contain the author's name(s), the values are taken
-- from the 'authors' field of 'InitFlags', and if not specified will
-- be the string "???".
--
--- If the license type is unknown no license file will be created and
+-- If the license type is unknown no license file will be prepared and
-- a warning will be raised.
-writeLicense :: InitFlags -> IO ()
-writeLicense flags = do
- message flags "\nGenerating LICENSE..."
+--
+writeLicense :: WriteOpts -> PkgDescription -> IO ()
+writeLicense writeOpts pkgDesc = do
year <- show <$> getCurrentYear
- let authors = fromMaybe "???" . flagToMaybe . author $ flags
- let isSimpleLicense :: SPDX.License -> Maybe SPDX.LicenseId
- isSimpleLicense (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)) = Just lid
- isSimpleLicense _ = Nothing
- let licenseFile =
- case flagToMaybe (license flags) >>= isSimpleLicense of
- Just SPDX.BSD_2_Clause -> Just $ bsd2 authors year
- Just SPDX.BSD_3_Clause -> Just $ bsd3 authors year
- Just SPDX.Apache_2_0 -> Just apache20
- Just SPDX.MIT -> Just $ mit authors year
- Just SPDX.MPL_2_0 -> Just mpl20
- Just SPDX.ISC -> Just $ isc authors year
-
- -- GNU license come in "only" and "or-later" flavours
- -- license file used are the same.
- Just SPDX.GPL_2_0_only -> Just gplv2
- Just SPDX.GPL_3_0_only -> Just gplv3
- Just SPDX.LGPL_2_1_only -> Just lgpl21
- Just SPDX.LGPL_3_0_only -> Just lgpl3
- Just SPDX.AGPL_3_0_only -> Just agplv3
-
- Just SPDX.GPL_2_0_or_later -> Just gplv2
- Just SPDX.GPL_3_0_or_later -> Just gplv3
- Just SPDX.LGPL_2_1_or_later -> Just lgpl21
- Just SPDX.LGPL_3_0_or_later -> Just lgpl3
- Just SPDX.AGPL_3_0_or_later -> Just agplv3
-
- _ -> Nothing
-
- case licenseFile of
- Just licenseText -> writeFileSafe flags "LICENSE" licenseText
- Nothing -> message flags "Warning: unknown license type, you must put a copy in LICENSE yourself."
-
--- | Returns the current calendar year.
-getCurrentYear :: IO Integer
-getCurrentYear = do
- u <- getCurrentTime
- z <- getCurrentTimeZone
- let l = utcToLocalTime z u
- (y, _, _) = toGregorian $ localDay l
- return y
-
-defaultChangeLog :: FilePath
-defaultChangeLog = "CHANGELOG.md"
+ case licenseFile year (_pkgAuthor pkgDesc) of
+ Just licenseText -> do
+ message writeOpts "\nCreating LICENSE..."
+ writeFileSafe writeOpts "LICENSE" licenseText
+ Nothing -> message writeOpts "Warning: unknown license type, you must put a copy in LICENSE yourself."
+ where
+ getLid (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)) =
+ Just lid
+ getLid _ = Nothing
+
+ licenseFile year auth = case getLid $ _pkgLicense pkgDesc of
+ Just SPDX.BSD_2_Clause -> Just $ bsd2 auth year
+ Just SPDX.BSD_3_Clause -> Just $ bsd3 auth year
+ Just SPDX.Apache_2_0 -> Just apache20
+ Just SPDX.MIT -> Just $ mit auth year
+ Just SPDX.MPL_2_0 -> Just mpl20
+ Just SPDX.ISC -> Just $ isc auth year
+ Just SPDX.GPL_2_0_only -> Just gplv2
+ Just SPDX.GPL_3_0_only -> Just gplv3
+ Just SPDX.LGPL_2_1_only -> Just lgpl21
+ Just SPDX.LGPL_3_0_only -> Just lgpl3
+ Just SPDX.AGPL_3_0_only -> Just agplv3
+ Just SPDX.GPL_2_0_or_later -> Just gplv2
+ Just SPDX.GPL_3_0_or_later -> Just gplv3
+ Just SPDX.LGPL_2_1_or_later -> Just lgpl21
+ Just SPDX.LGPL_3_0_or_later -> Just lgpl3
+ Just SPDX.AGPL_3_0_or_later -> Just agplv3
+ _ -> Nothing
-- | Writes the changelog to the current directory.
-writeChangeLog :: InitFlags -> IO ()
-writeChangeLog flags = when ((defaultChangeLog `elem`) $ fromMaybe [] (extraSrc flags)) $ do
- message flags ("Generating "++ defaultChangeLog ++"...")
- writeFileSafe flags defaultChangeLog changeLog
+--
+writeChangeLog :: WriteOpts -> PkgDescription -> IO ()
+writeChangeLog opts pkgDesc
+ | defaultChangelog `elem` _pkgExtraSrcFiles pkgDesc = do
+ message opts ("Creating " ++ defaultChangelog ++"...")
+ writeFileSafe opts defaultChangelog changeLog
+ | otherwise = return ()
where
changeLog = unlines
- [ "# Revision history for " ++ pname
+ [ "# Revision history for " ++ prettyShow (_pkgName pkgDesc)
, ""
- , "## " ++ pver ++ " -- YYYY-mm-dd"
+ , "## " ++ prettyShow (_pkgVersion pkgDesc) ++ " -- YYYY-mm-dd"
, ""
, "* First version. Released on an unsuspecting world."
]
- pname = maybe "" prettyShow $ flagToMaybe $ packageName flags
- pver = maybe "" prettyShow $ flagToMaybe $ version flags
--- | Creates and writes the initialized .cabal file.
---
--- Returns @False@ if no package name is specified, @True@ otherwise.
-writeCabalFile :: InitFlags -> IO Bool
-writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do
- message flags "Error: no package name provided."
- return False
-writeCabalFile flags@(InitFlags{packageName = Flag p}) = do
- let cabalFileName = prettyShow p ++ ".cabal"
- message flags $ "Generating " ++ cabalFileName ++ "..."
- writeFileSafe flags cabalFileName (generateCabalFile cabalFileName flags)
- return True
-
--- | Write a file \"safely\", backing up any existing version (unless
--- the overwrite flag is set).
-writeFileSafe :: InitFlags -> FilePath -> String -> IO ()
-writeFileSafe flags fileName content = do
- moveExistingFile flags fileName
- writeFile fileName content
-
--- | Create directories, if they were given, and don't already exist.
-createDirectories :: Maybe [String] -> IO ()
-createDirectories mdirs = case mdirs of
- Just dirs -> for_ dirs (createDirectoryIfMissing True)
- Nothing -> return ()
-
--- | Create MyLib.hs file, if its the only module in the liste.
-createLibHs :: InitFlags -> IO ()
-createLibHs flags = when ((exposedModules flags) == Just [myLibModule]) $ do
- let modFilePath = ModuleName.toFilePath myLibModule ++ ".hs"
- case sourceDirs flags of
- Just (srcPath:_) -> writeLibHs flags (srcPath </> modFilePath)
- _ -> writeLibHs flags modFilePath
-
--- | Write a MyLib.hs file if it doesn't already exist.
-writeLibHs :: InitFlags -> FilePath -> IO ()
-writeLibHs flags libPath = do
- dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
- let libFullPath = dir </> libPath
- exists <- doesFileExist libFullPath
- unless exists $ do
- message flags $ "Generating " ++ libPath ++ "..."
- writeFileSafe flags libFullPath myLibHs
-
--- | Default MyLib.hs file. Used when no Lib.hs exists.
-myLibHs :: String
-myLibHs = unlines
- [ "module MyLib (someFunc) where"
- , ""
- , "someFunc :: IO ()"
- , "someFunc = putStrLn \"someFunc\""
- ]
-
--- | Create Main.hs, but only if we are init'ing an executable and
--- the mainIs flag has been provided.
-createMainHs :: InitFlags -> IO ()
-createMainHs flags =
- if hasMainHs flags then
- case applicationDirs flags of
- Just (appPath:_) -> writeMainHs flags (appPath </> mainFile)
- _ -> writeMainHs flags mainFile
- else return ()
- where
- mainFile = case mainIs flags of
- Flag x -> x
- NoFlag -> error "createMainHs: no mainIs"
-
--- | Write a main file if it doesn't already exist.
-writeMainHs :: InitFlags -> FilePath -> IO ()
-writeMainHs flags mainPath = do
- dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
- let mainFullPath = dir </> mainPath
- exists <- doesFileExist mainFullPath
- unless exists $ do
- message flags $ "Generating " ++ mainPath ++ "..."
- writeFileSafe flags mainFullPath (mainHs flags)
-
--- | Returns true if a main file exists.
-hasMainHs :: InitFlags -> Bool
-hasMainHs flags = case mainIs flags of
- Flag _ -> (packageType flags == Flag Executable
- || packageType flags == Flag LibraryAndExecutable)
- _ -> False
-
--- | Default Main.(l)hs file. Used when no Main.(l)hs exists.
---
--- If we are initializing a new 'LibraryAndExecutable' then import 'MyLib'.
-mainHs :: InitFlags -> String
-mainHs flags = (unlines . map prependPrefix) $ case packageType flags of
- Flag LibraryAndExecutable ->
- [ "module Main where"
- , ""
- , "import qualified MyLib (someFunc)"
- , ""
- , "main :: IO ()"
- , "main = do"
- , " putStrLn \"Hello, Haskell!\""
- , " MyLib.someFunc"
- ]
- _ ->
- [ "module Main where"
- , ""
- , "main :: IO ()"
- , "main = putStrLn \"Hello, Haskell!\""
- ]
- where
- prependPrefix :: String -> String
- prependPrefix "" = ""
- prependPrefix line
- | isLiterate = "> " ++ line
- | otherwise = line
- isLiterate = case mainIs flags of
- Flag mainPath -> takeExtension mainPath == ".lhs"
- _ -> False
-
--- | Create a test suite for the package if eligible.
-createTestSuiteIfEligible :: InitFlags -> IO ()
-createTestSuiteIfEligible flags =
- when (eligibleForTestSuite flags) $ do
- createDirectories (testDirs flags)
- createTestHs flags
-
--- | The name of the test file to generate (if --tests is specified).
-testFile :: String
-testFile = "MyLibTest.hs"
-
--- | Create MyLibTest.hs, but only if we are init'ing a library and
--- the initializeTestSuite flag has been set.
---
--- It is up to the caller to verify that the package is eligible
--- for test suite initialization (see eligibleForTestSuite).
-createTestHs :: InitFlags -> IO ()
-createTestHs flags =
- case testDirs flags of
- Just (testPath:_) -> writeTestHs flags (testPath </> testFile)
- _ -> writeMainHs flags testFile
-
--- | Write a test file.
-writeTestHs :: InitFlags -> FilePath -> IO ()
-writeTestHs flags testPath = do
- dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
- let testFullPath = dir </> testPath
- exists <- doesFileExist testFullPath
- unless exists $ do
- message flags $ "Generating " ++ testPath ++ "..."
- writeFileSafe flags testFullPath testHs
-
--- | Default MyLibTest.hs file.
-testHs :: String
-testHs = unlines
- [ "module Main (main) where"
- , ""
- , "main :: IO ()"
- , "main = putStrLn \"Test suite not yet implemented.\""
- ]
-
-
--- | Move an existing file, if there is one, and the overwrite flag is
--- not set.
-moveExistingFile :: InitFlags -> FilePath -> IO ()
-moveExistingFile flags fileName =
- unless (overwrite flags == Flag True) $ do
- e <- doesFileExist fileName
- when e $ do
- newName <- findNewName fileName
- message flags $ "Warning: " ++ fileName ++ " already exists, backing up old version in " ++ newName
- copyFile fileName newName
-
-
--- | Given a file path find a new name for the file that does not
--- already exist.
-findNewName :: FilePath -> IO FilePath
-findNewName oldName = findNewName' 0
+-- -------------------------------------------------------------------- --
+-- Utilities
+
+-- | Possibly generate a message to stdout, taking into account the
+-- --quiet flag.
+message :: Interactive m => WriteOpts -> String -> m ()
+message opts = T.message (_optVerbosity opts)
+
+-- | Write a file \"safely\" if it doesn't exist, backing up any existing version when
+-- the overwrite flag is set.
+writeFileSafe :: WriteOpts -> FilePath -> String -> IO ()
+writeFileSafe opts fileName content = do
+ litExists <- doesFileExist fileName
+ moveExistingFile litExists
+
+ when (doOverwrite || not litExists) $
+ writeFile fileName content
where
- findNewName' :: Integer -> IO FilePath
- findNewName' n = do
+ doOverwrite = _optOverwrite opts
+
+ moveExistingFile exists
+ | exists && doOverwrite = do
+ newName <- findNewName fileName (0 :: Int)
+ message opts $ concat
+ [ "Warning: "
+ , fileName
+ , " already exists. Backing up old version in "
+ , newName
+ ]
+
+ copyFile fileName newName
+ | exists && not doOverwrite = message opts $ concat
+ [ "Warning: "
+ , fileName
+ , " already exists. Skipping..."
+ ]
+ | otherwise = return ()
+
+ findNewName oldName n = do
let newName = oldName <.> ("save" ++ show n)
e <- doesFileExist newName
- if e then findNewName' (n+1) else return newName
-
-
--- | Generate a .cabal file from an InitFlags structure.
-generateCabalFile :: String -> InitFlags -> String
-generateCabalFile fileName c =
- showFields' annCommentLines postProcessFieldLines 4 $ catMaybes
- [ fieldP "cabal-version" (Flag . SpecVersion $ specVer)
- []
- False
-
- , field "name" (packageName c)
- ["Initial package description '" ++ fileName ++ "' generated by",
- "'cabal init'. For further documentation, see:",
- " http://haskell.org/cabal/users-guide/",
- "",
- "The name of the package."]
- True
-
- , field "version" (version c)
- ["The package version.",
- "See the Haskell package versioning policy (PVP) for standards",
- "guiding when and how versions should be incremented.",
- "https://pvp.haskell.org",
- "PVP summary: +-+------- breaking API changes",
- " | | +----- non-breaking API additions",
- " | | | +--- code changes with no API change"]
- True
-
- , fieldS "synopsis" (synopsis c)
- ["A short (one-line) description of the package."]
- True
-
- , fieldS "description" NoFlag
- ["A longer description of the package."]
- True
-
- , fieldS "homepage" (homepage c)
- ["URL for the project homepage or repository."]
- False
-
- , fieldS "bug-reports" NoFlag
- ["A URL where users can report bugs."]
- True
-
- , fieldS "license" licenseStr
- ["The license under which the package is released."]
- True
-
- , case license c of
- NoFlag -> Nothing
- Flag SPDX.NONE -> Nothing
- _ -> fieldS "license-file" (Flag "LICENSE")
- ["The file containing the license text."]
- True
-
- , fieldS "author" (author c)
- ["The package author(s)."]
- True
-
- , fieldS "maintainer" (email c)
- ["An email address to which users can send suggestions, bug reports, and patches."]
- True
-
- , fieldS "copyright" NoFlag
- ["A copyright notice."]
- True
-
- , fieldS "category" (either id prettyShow `fmap` category c)
- []
- True
-
- , fieldS "build-type" (if specVer >= CabalSpecV2_2 then NoFlag else Flag "Simple")
- []
- False
-
- , fieldPAla "extra-source-files" formatExtraSourceFiles (maybeToFlag (extraSrc c))
- ["Extra files to be distributed with the package, such as examples or a README."]
- True
- ]
- ++
- (case packageType c of
- Flag Executable -> [executableStanza]
- Flag Library -> [libraryStanza]
- Flag LibraryAndExecutable -> [libraryStanza, executableStanza]
- _ -> [])
- ++
- if eligibleForTestSuite c then [testSuiteStanza] else []
+ if e then findNewName oldName (n+1) else return newName
- where
- specVer :: CabalSpecVersion
- specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c)
-
- licenseStr | specVer < CabalSpecV2_2 = prettyShow . licenseFromSPDX <$> license c
- | otherwise = prettyShow <$> license c
-
- generateBuildInfo :: BuildType -> InitFlags -> [PrettyField FieldAnnotation]
- generateBuildInfo buildType c' = catMaybes
- [ fieldPAla "other-modules" formatOtherModules (maybeToFlag otherMods)
- [ case buildType of
- LibBuild -> "Modules included in this library but not exported."
- ExecBuild -> "Modules included in this executable, other than Main."]
- True
-
- , fieldPAla "other-extensions" formatOtherExtensions (maybeToFlag (otherExts c))
- ["LANGUAGE extensions used by modules in this package."]
- True
-
- , fieldPAla "build-depends" formatDependencyList (maybeToFlag buildDependencies)
- ["Other library packages from which modules are imported."]
- True
-
- , fieldPAla "hs-source-dirs" formatHsSourceDirs
- (maybeToFlag $ fmap (fmap unsafeMakeSymbolicPath) $ case buildType of
- LibBuild -> sourceDirs c
- ExecBuild -> applicationDirs c)
- ["Directories containing source files."]
- True
-
- , fieldS "build-tools" (listFieldS $ buildTools c)
- ["Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
- False
-
- , field "default-language" (language c)
- ["Base language which the package is written in."]
- True
- ]
- -- Hack: Can't construct a 'Dependency' which is just 'packageName'(?).
- where
- buildDependencies :: Maybe [Dependency]
- buildDependencies = (++ myLibDep) <$> dependencies c'
-
- myLibDep :: [Dependency]
- myLibDep = if exposedModules c' == Just [myLibModule] && buildType == ExecBuild
- then case packageName c' of
- Flag pkgName ->
- [mkDependency pkgName anyVersion mainLibSet]
- _ -> []
- else []
-
- -- Only include 'MyLib' in 'other-modules' of the executable.
- otherModsFromFlag = otherModules c'
- otherMods = if buildType == LibBuild && otherModsFromFlag == Just [myLibModule]
- then Nothing
- else otherModsFromFlag
-
- listFieldS :: Maybe [String] -> Flag String
- listFieldS Nothing = NoFlag
- listFieldS (Just []) = NoFlag
- listFieldS (Just xs) = Flag . intercalate ", " $ xs
-
- -- | Construct a 'PrettyField' from a field that can be automatically
- -- converted to a 'Doc' via 'display'.
- field :: Pretty t
- => FieldName
- -> Flag t
- -> [String]
- -> Bool
- -> Maybe (PrettyField FieldAnnotation)
- field fieldName fieldContentsFlag = fieldS fieldName (prettyShow <$> fieldContentsFlag)
-
- -- | Construct a 'PrettyField' from a 'String' field.
- fieldS :: FieldName -- ^ Name of the field
- -> Flag String -- ^ Field contents
- -> [String] -- ^ Comment to explain the field
- -> Bool -- ^ Should the field be included (commented out) even if blank?
- -> Maybe (PrettyField FieldAnnotation)
- fieldS fieldName fieldContentsFlag = fieldD fieldName (text <$> fieldContentsFlag)
-
- -- | Construct a 'PrettyField' from a Flag which can be 'pretty'-ied.
- fieldP :: Pretty a
- => FieldName
- -> Flag a
- -> [String]
- -> Bool
- -> Maybe (PrettyField FieldAnnotation)
- fieldP fieldName fieldContentsFlag fieldComments includeField =
- fieldPAla fieldName Identity fieldContentsFlag fieldComments includeField
-
- -- | Construct a 'PrettyField' from a flag which can be 'pretty'-ied, wrapped in newtypeWrapper.
- fieldPAla
- :: (Pretty b, Newtype a b)
- => FieldName
- -> (a -> b)
- -> Flag a
- -> [String]
- -> Bool
- -> Maybe (PrettyField FieldAnnotation)
- fieldPAla fieldName newtypeWrapper fieldContentsFlag fieldComments includeField =
- fieldD fieldName (pretty . newtypeWrapper <$> fieldContentsFlag) fieldComments includeField
-
- -- | Construct a 'PrettyField' from a 'Doc' Flag.
- fieldD :: FieldName -- ^ Name of the field
- -> Flag Doc -- ^ Field contents
- -> [String] -- ^ Comment to explain the field
- -> Bool -- ^ Should the field be included (commented out) even if blank?
- -> Maybe (PrettyField FieldAnnotation)
- fieldD fieldName fieldContentsFlag fieldComments includeField =
- case fieldContentsFlag of
- NoFlag ->
- -- If there is no content, optionally produce a commented out field.
- fieldSEmptyContents fieldName fieldComments includeField
-
- Flag fieldContents ->
- if isEmpty fieldContents
- then
- -- If the doc is empty, optionally produce a commented out field.
- fieldSEmptyContents fieldName fieldComments includeField
- else
- -- If the doc is not empty, produce a field.
- Just $ case (noComments c, minimal c) of
- -- If the "--no-comments" flag is set, strip comments.
- (Flag True, _) ->
- fieldSWithContents fieldName fieldContents []
- -- If the "--minimal" flag is set, strip comments.
- (_, Flag True) ->
- fieldSWithContents fieldName fieldContents []
- -- Otherwise, include comments.
- (_, _) ->
- fieldSWithContents fieldName fieldContents fieldComments
-
- -- | Optionally produce a field with no content (depending on flags).
- fieldSEmptyContents :: FieldName
- -> [String]
- -> Bool
- -> Maybe (PrettyField FieldAnnotation)
- fieldSEmptyContents fieldName fieldComments includeField
- | not includeField || (minimal c == Flag True) =
- Nothing
- | otherwise =
- Just (PrettyField (commentedOutWithComments fieldComments) fieldName empty)
-
- -- | Produce a field with content.
- fieldSWithContents :: FieldName
- -> Doc
- -> [String]
- -> PrettyField FieldAnnotation
- fieldSWithContents fieldName fieldContents fieldComments =
- PrettyField (withComments (map ("-- " ++) fieldComments)) fieldName fieldContents
-
- executableStanza :: PrettyField FieldAnnotation
- executableStanza = PrettySection annNoComments (toUTF8BS "executable") [exeName] $ catMaybes
- [ fieldS "main-is" (mainIs c)
- [".hs or .lhs file containing the Main module."]
- True
- ]
- ++
- generateBuildInfo ExecBuild c
- where
- exeName = text (maybe "" prettyShow . flagToMaybe $ packageName c)
-
- libraryStanza :: PrettyField FieldAnnotation
- libraryStanza = PrettySection annNoComments (toUTF8BS "library") [] $ catMaybes
- [ fieldPAla "exposed-modules" formatExposedModules (maybeToFlag (exposedModules c))
- ["Modules exported by the library."]
- True
- ]
- ++
- generateBuildInfo LibBuild c
-
-
- testSuiteStanza :: PrettyField FieldAnnotation
- testSuiteStanza = PrettySection annNoComments (toUTF8BS "test-suite") [testSuiteName] $ catMaybes
- [ field "default-language" (language c)
- ["Base language which the package is written in."]
- True
-
- , fieldS "type" (Flag "exitcode-stdio-1.0")
- ["The interface type and version of the test suite."]
- True
-
- , fieldPAla "hs-source-dirs" formatHsSourceDirs
- (maybeToFlag $ fmap (fmap unsafeMakeSymbolicPath) $ testDirs c) -- TODO
- ["Directories containing source files."]
- True
-
- , fieldS "main-is" (Flag testFile)
- ["The entrypoint to the test suite."]
- True
-
- , fieldPAla "build-depends" formatDependencyList (maybeToFlag (dependencies c))
- ["Test dependencies."]
- True
- ]
- where
- testSuiteName =
- text (maybe "" ((++"-test") . prettyShow) . flagToMaybe $ packageName c)
-
--- | Annotations for cabal file PrettyField.
-data FieldAnnotation = FieldAnnotation
- { annCommentedOut :: Bool
- -- ^ True iif the field and its contents should be commented out.
- , annCommentLines :: [String]
- -- ^ Comment lines to place before the field or section.
- }
-
--- | A field annotation instructing the pretty printer to comment out the field
--- and any contents, with no comments.
-commentedOutWithComments :: [String] -> FieldAnnotation
-commentedOutWithComments = FieldAnnotation True . map ("-- " ++)
-
--- | A field annotation with the specified comment lines.
-withComments :: [String] -> FieldAnnotation
-withComments = FieldAnnotation False
-
--- | A field annotation with no comments.
-annNoComments :: FieldAnnotation
-annNoComments = FieldAnnotation False []
-
-postProcessFieldLines :: FieldAnnotation -> [String] -> [String]
-postProcessFieldLines ann
- | annCommentedOut ann = map ("-- " ++)
- | otherwise = id
+writeDirectoriesSafe :: WriteOpts -> [String] -> IO ()
+writeDirectoriesSafe opts dirs = for_ dirs $ \dir -> do
+ exists <- doesDirectoryExist dir
+ moveExistingDir dir exists
+
+ let action = if doOverwrite
+ then "Overwriting"
+ else "Creating or using already existing"
+
+ message opts $ action ++ " directory ./" ++ dir ++ "..."
+ unless exists $
+ createDirectory dir
+ where
+ doOverwrite = _optOverwrite opts
+
+ moveExistingDir oldDir exists
+ | exists && doOverwrite = do
+ newDir <- findNewDir oldDir (0 :: Int)
+ message opts $ concat
+ [ "Warning: "
+ , oldDir
+ , " already exists. Backing up old version in "
+ , newDir
+ ]
+
+ renameDirectory oldDir newDir
+ | exists && doOverwrite = removeDirectoryRecursive oldDir
+ | otherwise = return ()
+
+ findNewDir oldDir n = do
+ let newDir = oldDir <.> ("save" ++ show n)
+ e <- doesDirectoryExist newDir
+ if e then findNewDir oldDir (n+1) else return newDir
diff --git a/cabal-install/src/Distribution/Client/Init/FlagExtractors.hs b/cabal-install/src/Distribution/Client/Init/FlagExtractors.hs
new file mode 100644
index 0000000000..bf67c323c3
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/FlagExtractors.hs
@@ -0,0 +1,267 @@
+{-# LANGUAGE LambdaCase #-}
+module Distribution.Client.Init.FlagExtractors
+( -- * Flag extractors
+ getPackageDir
+, getSimpleProject
+, getMinimal
+, getCabalVersion
+, getPackageName
+, getVersion
+, getLicense
+, getAuthor
+, getEmail
+, getHomepage
+, getSynopsis
+, getCategory
+, getExtraSrcFiles
+, getPackageType
+, getMainFile
+, getInitializeTestSuite
+, getTestDirs
+, getLanguage
+, getNoComments
+, getAppDirs
+, getSrcDirs
+, getExposedModules
+, getBuildTools
+, getDependencies
+, getOtherExts
+, getOverwrite
+, getOtherModules
+ -- * Shared prompts
+, simpleProjectPrompt
+, initializeTestSuitePrompt
+, packageTypePrompt
+, testMainPrompt
+) where
+
+
+import Prelude ()
+import Distribution.Client.Compat.Prelude hiding (putStr, putStrLn, getLine, last)
+
+import qualified Data.List.NonEmpty as NEL
+
+import Distribution.CabalSpecVersion (CabalSpecVersion(..))
+import Distribution.Version (Version)
+import Distribution.ModuleName (ModuleName)
+import Distribution.Types.Dependency (Dependency(..))
+import Distribution.Types.PackageName (PackageName)
+import qualified Distribution.SPDX as SPDX
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Types
+import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault, flagToMaybe)
+import Distribution.Simple.Flag (flagElim)
+
+import Language.Haskell.Extension (Language(..), Extension(..))
+import Distribution.Client.Init.Prompt
+
+
+
+-- -------------------------------------------------------------------- --
+-- Flag extraction
+
+getPackageDir :: Interactive m => InitFlags -> m FilePath
+getPackageDir = flagElim getCurrentDirectory return . packageDir
+
+-- | Ask if a simple project with sensible defaults should be created.
+getSimpleProject :: Interactive m => InitFlags -> m Bool -> m Bool
+getSimpleProject flags = fromFlagOrPrompt (simpleProject flags)
+
+-- | Extract minimal cabal file flag (implies nocomments)
+getMinimal :: Interactive m => InitFlags -> m Bool
+getMinimal = return . fromFlagOrDefault False . minimal
+
+-- | Get the version of the cabal spec to use.
+--
+-- The spec version can be specified by the InitFlags cabalVersion field. If
+-- none is specified then the user is prompted to pick from a list of
+-- supported versions (see code below).
+getCabalVersion :: Interactive m => InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
+getCabalVersion flags = fromFlagOrPrompt (cabalVersion flags)
+
+-- | Get the package name: use the package directory (supplied, or the current
+-- directory by default) as a guess. It looks at the SourcePackageDb to avoid
+-- using an existing package name.
+getPackageName :: Interactive m => InitFlags -> m PackageName -> m PackageName
+getPackageName flags = fromFlagOrPrompt (packageName flags)
+
+-- | Package version: use 0.1.0.0 as a last resort, but try prompting the user
+-- if possible.
+getVersion :: Interactive m => InitFlags -> m Version -> m Version
+getVersion flags = fromFlagOrPrompt (version flags)
+
+-- | Choose a license for the package.
+-- The license can come from Initflags (license field), if it is not present
+-- then prompt the user from a predefined list of licenses.
+getLicense :: Interactive m => InitFlags -> m SPDX.License -> m SPDX.License
+getLicense flags = fromFlagOrPrompt (license flags)
+
+-- | The author's name. Prompt, or try to guess from an existing
+-- darcs repo.
+getAuthor :: Interactive m => InitFlags -> m String -> m String
+getAuthor flags = fromFlagOrPrompt (author flags)
+
+-- | The author's email. Prompt, or try to guess from an existing
+-- darcs repo.
+getEmail :: Interactive m => InitFlags -> m String -> m String
+getEmail flags = fromFlagOrPrompt (email flags)
+
+-- | Prompt for a homepage URL for the package.
+getHomepage :: Interactive m => InitFlags -> m String -> m String
+getHomepage flags = fromFlagOrPrompt (homepage flags)
+
+-- | Prompt for a project synopsis.
+getSynopsis :: Interactive m => InitFlags -> m String -> m String
+getSynopsis flags = fromFlagOrPrompt (synopsis flags)
+
+-- | Prompt for a package category.
+-- Note that it should be possible to do some smarter guessing here too, i.e.
+-- look at the name of the top level source directory.
+getCategory :: Interactive m => InitFlags -> m String -> m String
+getCategory flags = fromFlagOrPrompt (category flags)
+
+-- | Try to guess extra source files (don't prompt the user).
+getExtraSrcFiles :: Interactive m => InitFlags -> m (NonEmpty String)
+getExtraSrcFiles = pure
+ . flagElim (defaultChangelog NEL.:| []) NEL.fromList
+ . extraSrc
+
+-- | Ask whether the project builds a library or executable.
+getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
+getPackageType flags = fromFlagOrPrompt (packageType flags)
+
+getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
+getMainFile flags act = case mainIs flags of
+ Flag a
+ | isHsFilePath a -> return $ toHsFilePath a
+ | otherwise -> act
+ NoFlag -> act
+
+getInitializeTestSuite :: Interactive m => InitFlags -> m Bool -> m Bool
+getInitializeTestSuite flags = fromFlagOrPrompt (initializeTestSuite flags)
+
+getTestDirs :: Interactive m => InitFlags -> m [String] -> m [String]
+getTestDirs flags = fromFlagOrPrompt (testDirs flags)
+
+-- | Ask for the Haskell base language of the package.
+getLanguage :: Interactive m => InitFlags -> m Language -> m Language
+getLanguage flags = fromFlagOrPrompt (language flags)
+
+-- | Ask whether to generate explanatory comments.
+getNoComments :: Interactive m => InitFlags -> m Bool -> m Bool
+getNoComments flags = fromFlagOrPrompt (noComments flags)
+
+-- | Ask for the application root directory.
+getAppDirs :: Interactive m => InitFlags -> m [String] -> m [String]
+getAppDirs flags = fromFlagOrPrompt (applicationDirs flags)
+
+-- | Ask for the source (library) root directory.
+getSrcDirs :: Interactive m => InitFlags -> m [String] -> m [String]
+getSrcDirs flags = fromFlagOrPrompt (sourceDirs flags)
+
+-- | Retrieve the list of exposed modules
+getExposedModules :: Interactive m => InitFlags -> m (NonEmpty ModuleName)
+getExposedModules = return
+ . fromMaybe (myLibModule NEL.:| [])
+ . join
+ . flagToMaybe
+ . fmap NEL.nonEmpty
+ . exposedModules
+
+-- | Retrieve the list of other modules
+getOtherModules :: Interactive m => InitFlags -> m [ModuleName]
+getOtherModules = return . fromFlagOrDefault [] . otherModules
+
+-- | Retrieve the list of build tools
+getBuildTools :: Interactive m => InitFlags -> m [String]
+getBuildTools = return . fromFlagOrDefault [] . buildTools
+
+-- | Retrieve the list of dependencies
+getDependencies
+ :: Interactive m
+ => InitFlags
+ -> m [Dependency]
+ -> m [Dependency]
+getDependencies flags = fromFlagOrPrompt (dependencies flags)
+
+
+-- | Retrieve the list of extensions
+getOtherExts :: Interactive m => InitFlags -> m [Extension]
+getOtherExts = return . fromFlagOrDefault [] . otherExts
+
+-- | Tell whether to overwrite files on write
+--
+getOverwrite :: Interactive m => InitFlags -> m Bool
+getOverwrite = return . fromFlagOrDefault False . overwrite
+
+-- -------------------------------------------------------------------- --
+-- Shared prompts
+
+simpleProjectPrompt :: Interactive m => InitFlags -> m Bool
+simpleProjectPrompt flags = getSimpleProject flags $
+ promptYesNo
+ "Should I generate a simple project with sensible defaults"
+ (Just True)
+
+initializeTestSuitePrompt :: Interactive m => InitFlags -> m Bool
+initializeTestSuitePrompt flags = getInitializeTestSuite flags $
+ promptYesNo
+ "Should I generate a test suite for the library"
+ (Just True)
+
+packageTypePrompt :: Interactive m => InitFlags -> m PackageType
+packageTypePrompt flags = getPackageType flags $ do
+ pt <- promptList "What does the package build"
+ packageTypes
+ (Just "Executable")
+ Nothing
+ False
+
+ return $ fromMaybe Executable (parsePackageType pt)
+ where
+ packageTypes =
+ [ "Library"
+ , "Executable"
+ , "Library and Executable"
+ ]
+
+ parsePackageType = \case
+ "Library" -> Just Library
+ "Executable" -> Just Executable
+ "Library and Executable" -> Just LibraryAndExecutable
+ _ -> Nothing
+
+testMainPrompt :: Interactive m => m HsFilePath
+testMainPrompt = do
+ fp <- promptList "What is the main module of the test suite?"
+ [defaultMainIs', "Main.lhs"]
+ (Just defaultMainIs')
+ Nothing
+ True
+
+ let hs = toHsFilePath fp
+
+ case _hsFileType hs of
+ InvalidHsPath -> do
+ putStrLn $ concat
+ [ "Main file "
+ , show hs
+ , " is not a valid haskell file. Source files must end in .hs or .lhs."
+ ]
+ testMainPrompt
+ _ -> return hs
+ where
+ defaultMainIs' = show defaultMainIs
+
+-- -------------------------------------------------------------------- --
+-- utilities
+
+-- | If a flag is defined, return its value or else execute
+-- an interactive action.
+--
+fromFlagOrPrompt
+ :: Interactive m
+ => Flag a
+ -> m a
+ -> m a
+fromFlagOrPrompt flag action = flagElim action return flag
diff --git a/cabal-install/src/Distribution/Client/Init/Format.hs b/cabal-install/src/Distribution/Client/Init/Format.hs
new file mode 100644
index 0000000000..cc5906fb66
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/Format.hs
@@ -0,0 +1,338 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Distribution.Client.Init.Format
+-- Copyright : (c) Brent Yorgey 2009
+-- License : BSD-like
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- Pretty printing and field formatting utilities used for file creation.
+--
+module Distribution.Client.Init.Format
+( -- * cabal file formatters
+ listFieldS
+, field
+, fieldD
+, commentedOutWithComments
+, withComments
+, annNoComments
+, postProcessFieldLines
+ -- * stanza generation
+, mkLibStanza
+, mkExeStanza
+, mkTestStanza
+, mkPkgDescription
+) where
+
+
+import Distribution.Pretty
+import Distribution.Fields
+import Distribution.Client.Init.Types
+import Text.PrettyPrint
+import Distribution.Solver.Compat.Prelude hiding (empty)
+import Distribution.PackageDescription.FieldGrammar
+import Distribution.Simple.Utils
+import Distribution.Utils.Path
+import Distribution.Package (unPackageName)
+import qualified Distribution.SPDX.License as SPDX
+import Distribution.CabalSpecVersion
+
+
+-- | Construct a 'PrettyField' from a field that can be automatically
+-- converted to a 'Doc' via 'display'.
+field
+ :: Pretty b
+ => FieldName
+ -> (a -> b)
+ -> a
+ -> [String]
+ -> Bool
+ -> WriteOpts
+ -> PrettyField FieldAnnotation
+field fieldName modifier fieldContents =
+ fieldD fieldName (pretty $ modifier fieldContents)
+
+-- | Construct a 'PrettyField' from a 'Doc' Flag.
+fieldD
+ :: FieldName -- ^ Name of the field
+ -> Doc -- ^ Field contents
+ -> [String] -- ^ Comment to explain the field
+ -> Bool -- ^ Should the field be included (commented out) even if blank?
+ -> WriteOpts
+ -> PrettyField FieldAnnotation
+fieldD fieldName fieldContents fieldComments includeField opts
+ | fieldContents == empty =
+ -- If there is no content, optionally produce a commented out field.
+ fieldSEmptyContents fieldComments
+ | otherwise =
+ -- If the "--no-comments" flag is set, strip comments.
+ let comments = if hasNoComments
+ then []
+ else fieldComments
+
+ -- If the "--minimal" flag is set, strip comments.
+ in fieldSWithContents comments
+ where
+ isMinimal = _optMinimal opts
+ hasNoComments = _optNoComments opts
+
+ fieldSEmptyContents cs
+ | not includeField || isMinimal = PrettyEmpty
+ | otherwise = PrettyField
+ (commentedOutWithComments cs)
+ fieldName
+ empty
+
+ fieldSWithContents cs =
+ PrettyField (withComments (map ("-- " ++) cs)) fieldName fieldContents
+
+
+-- | A field annotation instructing the pretty printer to comment out the field
+-- and any contents, with no comments.
+commentedOutWithComments :: [String] -> FieldAnnotation
+commentedOutWithComments = FieldAnnotation True . map ("-- " ++)
+
+-- | A field annotation with the specified comment lines.
+withComments :: [String] -> FieldAnnotation
+withComments = FieldAnnotation False
+
+-- | A field annotation with no comments.
+annNoComments :: FieldAnnotation
+annNoComments = FieldAnnotation False []
+
+postProcessFieldLines :: FieldAnnotation -> [String] -> [String]
+postProcessFieldLines ann
+ | annCommentedOut ann = fmap ("-- " ++)
+ | otherwise = id
+
+-- -------------------------------------------------------------------- --
+-- Stanzas
+
+mkLibStanza :: WriteOpts -> LibTarget -> PrettyField FieldAnnotation
+mkLibStanza opts (LibTarget srcDirs lang expMods otherMods exts deps tools) =
+ PrettySection annNoComments (toUTF8BS "library") []
+ [ field "exposed-modules" formatExposedModules (toList expMods)
+ ["Modules exported by the library."]
+ True
+ opts
+
+ , field "other-modules" formatOtherModules otherMods
+ ["Modules included in this library but not exported."]
+ True
+ opts
+
+ , field "other-extensions" formatOtherExtensions exts
+ ["LANGUAGE extensions used by modules in this package."]
+ True
+ opts
+
+ , field "build-depends" formatDependencyList deps
+ ["Other library packages from which modules are imported."]
+ True
+ opts
+
+ , field "hs-source-dirs" formatHsSourceDirs (unsafeMakeSymbolicPath <$> srcDirs)
+ ["Directories containing source files."]
+ True
+ opts
+
+ , field "build-tools" listFieldS tools
+ ["Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
+ False
+ opts
+
+ , field "default-language" id lang
+ ["Base language which the package is written in."]
+ True
+ opts
+ ]
+
+mkExeStanza :: WriteOpts -> ExeTarget -> PrettyField FieldAnnotation
+mkExeStanza opts (ExeTarget exeMain appDirs lang otherMods exts deps tools) =
+ PrettySection annNoComments (toUTF8BS "executable") [exeName]
+ [ field "main-is" unsafeFromHs exeMain
+ [".hs or .lhs file containing the Main module."]
+ True
+ opts
+
+ , field "other-modules" formatOtherModules otherMods
+ [ "Modules included in this executable, other than Main." ]
+ True
+ opts
+
+ , field "other-extensions" formatOtherExtensions exts
+ ["LANGUAGE extensions used by modules in this package."]
+ True
+ opts
+ , field "build-depends" formatDependencyList deps
+ ["Other library packages from which modules are imported."]
+ True
+ opts
+
+ , field "hs-source-dirs" formatHsSourceDirs
+ (unsafeMakeSymbolicPath <$> appDirs)
+ ["Directories containing source files."]
+ True
+ opts
+
+ , field "build-tools" listFieldS tools
+ ["Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
+ False
+ opts
+
+ , field "default-language" id lang
+ ["Base language which the package is written in."]
+ True
+ opts
+ ]
+ where
+ exeName = pretty $ _optPkgName opts
+
+
+mkTestStanza :: WriteOpts -> TestTarget -> PrettyField FieldAnnotation
+mkTestStanza opts (TestTarget testMain dirs lang otherMods exts deps tools) =
+ PrettySection annNoComments (toUTF8BS "test-suite") [suiteName]
+ [ field "default-language" id lang
+ ["Base language which the package is written in."]
+ True
+ opts
+ , field "other-modules" formatOtherModules otherMods
+ [ "Modules included in this executable, other than Main." ]
+ True
+ opts
+
+ , field "other-extensions" formatOtherExtensions exts
+ ["LANGUAGE extensions used by modules in this package."]
+ True
+ opts
+
+ , field "type" text "exitcode-stdio-1.0"
+ ["The interface type and version of the test suite."]
+ True
+ opts
+
+ , field "hs-source-dirs" formatHsSourceDirs
+ (unsafeMakeSymbolicPath <$> dirs)
+ ["Directories containing source files."]
+ True
+ opts
+
+ , field "main-is" unsafeFromHs testMain
+ ["The entrypoint to the test suite."]
+ True
+ opts
+
+ , field "build-depends" formatDependencyList deps
+ ["Test dependencies."]
+ True
+ opts
+
+ , field "build-tools" listFieldS tools
+ ["Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
+ False
+ opts
+ ]
+ where
+ suiteName = text $ unPackageName (_optPkgName opts) ++ "-test"
+
+mkPkgDescription :: WriteOpts -> PkgDescription -> [PrettyField FieldAnnotation]
+mkPkgDescription opts pkgDesc =
+ [ field "cabal-version" text (showCabalSpecVersion cabalSpec) [] False opts
+ , field "name" pretty (_pkgName pkgDesc)
+ ["Initial package description '" ++ prettyShow (_optPkgName opts) ++ "' generated by"
+ , "'cabal init'. For further documentation, see:"
+ , " http://haskell.org/cabal/users-guide/"
+ , ""
+ , "The name of the package."
+ ]
+ True
+ opts
+
+ , field "version" pretty (_pkgVersion pkgDesc)
+ ["The package version.",
+ "See the Haskell package versioning policy (PVP) for standards",
+ "guiding when and how versions should be incremented.",
+ "https://pvp.haskell.org",
+ "PVP summary: +-+------- breaking API changes",
+ " | | +----- non-breaking API additions",
+ " | | | +--- code changes with no API change"]
+ True
+ opts
+
+ , field "synopsis" text (_pkgSynopsis pkgDesc)
+ ["A short (one-line) description of the package."]
+ True
+ opts
+
+ , field "description" text ""
+ ["A longer description of the package."]
+ True
+ opts
+
+ , field "homepage" text (_pkgHomePage pkgDesc)
+ ["URL for the project homepage or repository."]
+ False
+ opts
+
+ , field "bug-reports" text ""
+ ["A URL where users can report bugs."]
+ False
+ opts
+
+ , field "license" pretty (_pkgLicense pkgDesc)
+ ["The license under which the package is released."]
+ True
+ opts
+
+ , case _pkgLicense pkgDesc of
+ SPDX.NONE -> PrettyEmpty
+ _ -> field "license-file" text "LICENSE"
+ ["The file containing the license text."]
+ False
+ opts
+
+ , field "author" text (_pkgAuthor pkgDesc)
+ ["The package author(s)."]
+ True
+ opts
+
+ , field "maintainer" text (_pkgEmail pkgDesc)
+ ["An email address to which users can send suggestions, bug reports, and patches."]
+ True
+ opts
+
+ , field "copyright" text ""
+ ["A copyright notice."]
+ True
+ opts
+
+ , field "category" text (_pkgCategory pkgDesc)
+ []
+ False
+ opts
+ , if cabalSpec < CabalSpecV2_2
+ then PrettyEmpty
+ else field "build-type" text "Simple"
+ []
+ False
+ opts
+
+ , field "extra-source-files" formatExtraSourceFiles (toList $ _pkgExtraSrcFiles pkgDesc)
+ ["Extra files to be distributed with the package, such as examples or a README."]
+ True
+ opts
+ ]
+ where
+ cabalSpec = _pkgCabalVersion pkgDesc
+
+-- -------------------------------------------------------------------- --
+-- Utils
+
+listFieldS :: [String] -> Doc
+listFieldS = text . intercalate ", "
+
+
+unsafeFromHs :: HsFilePath -> Doc
+unsafeFromHs = text . _hsFilePath
diff --git a/cabal-install/src/Distribution/Client/Init/Heuristics.hs b/cabal-install/src/Distribution/Client/Init/Heuristics.hs
deleted file mode 100644
index f561af091f..0000000000
--- a/cabal-install/src/Distribution/Client/Init/Heuristics.hs
+++ /dev/null
@@ -1,396 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Distribution.Client.Init.Heuristics
--- Copyright : (c) Benedikt Huber 2009
--- License : BSD-like
---
--- Maintainer : cabal-devel@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- Heuristics for creating initial cabal files.
---
------------------------------------------------------------------------------
-module Distribution.Client.Init.Heuristics (
- guessPackageName,
- scanForModules, SourceFileEntry(..),
- neededBuildPrograms,
- guessMainFileCandidates,
- guessAuthorNameMail,
- knownCategories,
-) where
-
-import Prelude ()
-import qualified Data.ByteString as BS
-import Distribution.Client.Compat.Prelude
-import Distribution.Utils.Generic (safeHead, safeTail, safeLast)
-
-import Distribution.Simple.Setup (Flag(..), flagToMaybe)
-import Distribution.Simple.Utils (fromUTF8BS)
-import Distribution.ModuleName
- ( ModuleName, toFilePath )
-import qualified Distribution.Package as P
-import qualified Distribution.PackageDescription as PD
- ( category, packageDescription )
-import Distribution.Client.Utils
- ( tryCanonicalizePath )
-import Language.Haskell.Extension ( Extension )
-
-import Distribution.Solver.Types.PackageIndex
- ( allPackagesByName )
-import Distribution.Solver.Types.SourcePackage
- ( srcpkgDescription )
-
-import Distribution.Client.Types ( SourcePackageDb(..) )
-import Data.Char ( isLower )
-import Data.List ( isInfixOf )
-import qualified Data.Set as Set ( fromList, toList )
-import System.Directory ( getCurrentDirectory, getDirectoryContents,
- doesDirectoryExist, doesFileExist, getHomeDirectory, )
-import Distribution.Compat.Environment ( getEnvironment )
-import System.FilePath ( takeExtension, takeBaseName, dropExtension,
- (</>), (<.>), splitDirectories, makeRelative )
-
-import Distribution.Client.Init.Types ( InitFlags(..) )
-import Distribution.Client.Compat.Process ( readProcessWithExitCode )
-
-import qualified Distribution.Utils.ShortText as ShortText
-
--- | Return a list of candidate main files for this executable: top-level
--- modules including the word 'Main' in the file name. The list is sorted in
--- order of preference, shorter file names are preferred. 'Right's are existing
--- candidates and 'Left's are those that do not yet exist.
-guessMainFileCandidates :: InitFlags -> IO [Either FilePath FilePath]
-guessMainFileCandidates flags = do
- dir <-
- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
- files <- getDirectoryContents dir
- let existingCandidates = filter isMain files
- -- We always want to give the user at least one default choice. If either
- -- Main.hs or Main.lhs has already been created, then we don't want to
- -- suggest the other; however, if neither has been created, then we
- -- suggest both.
- newCandidates =
- if any (`elem` existingCandidates) ["Main.hs", "Main.lhs"]
- then []
- else ["Main.hs", "Main.lhs"]
- candidates =
- sortBy (\x y -> comparing (length . either id id) x y
- `mappend` compare x y)
- (map Left newCandidates ++ map Right existingCandidates)
- return candidates
-
- where
- isMain f = (isInfixOf "Main" f || isInfixOf "main" f)
- && (isSuffixOf ".hs" f || isSuffixOf ".lhs" f)
-
--- | Guess the package name based on the given root directory.
-guessPackageName :: FilePath -> IO P.PackageName
-guessPackageName = liftM (P.mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories)
- . tryCanonicalizePath
- where
- -- Treat each span of non-alphanumeric characters as a hyphen. Each
- -- hyphenated component of a package name must contain at least one
- -- alphabetic character. An arbitrary character ('x') will be prepended if
- -- this is not the case for the first component, and subsequent components
- -- will simply be run together. For example, "1+2_foo-3" will become
- -- "x12-foo3".
- repair = repair' ('x' :) id
- repair' invalid valid x = case dropWhile (not . isAlphaNum) x of
- "" -> repairComponent ""
- x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
- in c ++ repairRest r
- where
- repairComponent c | all isDigit c = invalid c
- | otherwise = valid c
- repairRest = repair' id ('-' :)
-
--- |Data type of source files found in the working directory
-data SourceFileEntry = SourceFileEntry
- { relativeSourcePath :: FilePath
- , moduleName :: ModuleName
- , fileExtension :: String
- , imports :: [ModuleName]
- , extensions :: [Extension]
- } deriving Show
-
-sfToFileName :: FilePath -> SourceFileEntry -> FilePath
-sfToFileName projectRoot (SourceFileEntry relPath m ext _ _)
- = projectRoot </> relPath </> toFilePath m <.> ext
-
--- |Search for source files in the given directory
--- and return pairs of guessed Haskell source path and
--- module names.
-scanForModules :: FilePath -> IO [SourceFileEntry]
-scanForModules rootDir = scanForModulesIn rootDir rootDir
-
-scanForModulesIn :: FilePath -> FilePath -> IO [SourceFileEntry]
-scanForModulesIn projectRoot srcRoot = scan srcRoot []
- where
- scan dir hierarchy = do
- entries <- getDirectoryContents (projectRoot </> dir)
- (files, dirs) <- liftM partitionEithers (traverse (tagIsDir dir) entries)
- let modules = catMaybes [ guessModuleName hierarchy file
- | file <- files
- , maybe False isUpper (safeHead file) ]
- modules' <- traverse (findImportsAndExts projectRoot) modules
- recMods <- traverse (scanRecursive dir hierarchy) dirs
- return $ concat (modules' : recMods)
- tagIsDir parent entry = do
- isDir <- doesDirectoryExist (parent </> entry)
- return $ (if isDir then Right else Left) entry
- guessModuleName hierarchy entry
- | takeBaseName entry == "Setup" = Nothing
- | ext `elem` sourceExtensions =
- SourceFileEntry <$> pure relRoot <*> modName <*> pure ext <*> pure [] <*> pure []
- | otherwise = Nothing
- where
- relRoot = makeRelative projectRoot srcRoot
- unqualModName = dropExtension entry
- modName = simpleParsec
- $ intercalate "." . reverse $ (unqualModName : hierarchy)
- ext = case takeExtension entry of '.':e -> e; e -> e
- scanRecursive parent hierarchy entry
- | maybe False isUpper (safeHead entry) = scan (parent </> entry) (entry : hierarchy)
- | maybe False isLower (safeHead entry) && not (ignoreDir entry) =
- scanForModulesIn projectRoot $ foldl (</>) srcRoot (reverse (entry : hierarchy))
- | otherwise = return []
- ignoreDir ('.':_) = True
- ignoreDir dir = dir `elem` ["dist", "_darcs"]
-
--- | Read the contents of the handle and parse for Language pragmas
--- and other module names that might be part of this project.
-findImportsAndExts :: FilePath -> SourceFileEntry -> IO SourceFileEntry
-findImportsAndExts projectRoot sf = do
- s <- fromUTF8BS <$> BS.readFile (sfToFileName projectRoot sf)
-
- let modules = mapMaybe
- ( getModName
- . drop 1
- . filter (not . null)
- . dropWhile (/= "import")
- . words
- )
- . filter (not . ("--" `isPrefixOf`)) -- poor man's comment filtering
- . lines
- $ s
-
- -- TODO: We should probably make a better attempt at parsing
- -- comments above. Unfortunately we can't use a full-fledged
- -- Haskell parser since cabal's dependencies must be kept at a
- -- minimum.
-
- -- A poor man's LANGUAGE pragma parser.
- exts = mapMaybe simpleParsec
- . concatMap getPragmas
- . filter isLANGUAGEPragma
- . map fst
- . drop 1
- . takeWhile (not . null . snd)
- . iterate (takeBraces . snd)
- $ ("",s)
-
- takeBraces = break (== '}') . dropWhile (/= '{')
-
- isLANGUAGEPragma = ("{-# LANGUAGE " `isPrefixOf`)
-
- getPragmas = map trim . splitCommas . takeWhile (/= '#') . drop 13
-
- splitCommas "" = []
- splitCommas xs = x : splitCommas (drop 1 y)
- where (x,y) = break (==',') xs
-
- return sf { imports = modules
- , extensions = exts
- }
-
- where getModName :: [String] -> Maybe ModuleName
- getModName [] = Nothing
- getModName ("qualified":ws) = getModName ws
- getModName (ms:_) = simpleParsec ms
-
-
-
--- Unfortunately we cannot use the version exported by Distribution.Simple.Program
-knownSuffixHandlers :: [(String,String)]
-knownSuffixHandlers =
- [ ("gc", "greencard")
- , ("chs", "chs")
- , ("hsc", "hsc2hs")
- , ("x", "alex")
- , ("y", "happy")
- , ("ly", "happy")
- , ("cpphs", "cpp")
- ]
-
-sourceExtensions :: [String]
-sourceExtensions = "hs" : "lhs" : map fst knownSuffixHandlers
-
-neededBuildPrograms :: [SourceFileEntry] -> [String]
-neededBuildPrograms entries =
- [ handler
- | ext <- nubSet (map fileExtension entries)
- , handler <- maybeToList (lookup ext knownSuffixHandlers)
- ]
-
--- | Guess author and email using darcs and git configuration options. Use
--- the following in decreasing order of preference:
---
--- 1. vcs env vars ($DARCS_EMAIL, $GIT_AUTHOR_*)
--- 2. Local repo configs
--- 3. Global vcs configs
--- 4. The generic $EMAIL
---
--- Name and email are processed separately, so the guess might end up being
--- a name from DARCS_EMAIL and an email from git config.
---
--- Darcs has preference, for tradition's sake.
-guessAuthorNameMail :: IO (Flag String, Flag String)
-guessAuthorNameMail = fmap authorGuessPure authorGuessIO
-
--- Ordered in increasing preference, since Flag-as-monoid is identical to
--- Last.
-authorGuessPure :: AuthorGuessIO -> AuthorGuess
-authorGuessPure (AuthorGuessIO { authorGuessEnv = env
- , authorGuessLocalDarcs = darcsLocalF
- , authorGuessGlobalDarcs = darcsGlobalF
- , authorGuessLocalGit = gitLocal
- , authorGuessGlobalGit = gitGlobal })
- = mconcat
- [ emailEnv env
- , gitGlobal
- , darcsCfg darcsGlobalF
- , gitLocal
- , darcsCfg darcsLocalF
- , gitEnv env
- , darcsEnv env
- ]
-
-authorGuessIO :: IO AuthorGuessIO
-authorGuessIO = AuthorGuessIO
- <$> getEnvironment
- <*> (maybeReadFile $ "_darcs" </> "prefs" </> "author")
- <*> (maybeReadFile =<< liftM (</> (".darcs" </> "author")) getHomeDirectory)
- <*> gitCfg Local
- <*> gitCfg Global
-
--- Types and functions used for guessing the author are now defined:
-
-type AuthorGuess = (Flag String, Flag String)
-type Enviro = [(String, String)]
-data GitLoc = Local | Global
-data AuthorGuessIO = AuthorGuessIO {
- authorGuessEnv :: Enviro, -- ^ Environment lookup table
- authorGuessLocalDarcs :: (Maybe String), -- ^ Contents of local darcs author info
- authorGuessGlobalDarcs :: (Maybe String), -- ^ Contents of global darcs author info
- authorGuessLocalGit :: AuthorGuess, -- ^ Git config --local
- authorGuessGlobalGit :: AuthorGuess -- ^ Git config --global
- }
-
-darcsEnv :: Enviro -> AuthorGuess
-darcsEnv = maybe mempty nameAndMail . lookup "DARCS_EMAIL"
-
-gitEnv :: Enviro -> AuthorGuess
-gitEnv env = (name, mail)
- where
- name = maybeFlag "GIT_AUTHOR_NAME" env
- mail = maybeFlag "GIT_AUTHOR_EMAIL" env
-
-darcsCfg :: Maybe String -> AuthorGuess
-darcsCfg = maybe mempty nameAndMail
-
-emailEnv :: Enviro -> AuthorGuess
-emailEnv env = (mempty, mail)
- where
- mail = maybeFlag "EMAIL" env
-
-gitCfg :: GitLoc -> IO AuthorGuess
-gitCfg which = do
- name <- gitVar which "user.name"
- mail <- gitVar which "user.email"
- return (name, mail)
-
-gitVar :: GitLoc -> String -> IO (Flag String)
-gitVar which = fmap happyOutput . gitConfigQuery which
-
-happyOutput :: (ExitCode, a, t) -> Flag a
-happyOutput v = case v of
- (ExitSuccess, s, _) -> Flag s
- _ -> mempty
-
-gitConfigQuery :: GitLoc -> String -> IO (ExitCode, String, String)
-gitConfigQuery which key =
- fmap trim' $ readProcessWithExitCode "git" ["config", w, key] ""
- where
- w = case which of
- Local -> "--local"
- Global -> "--global"
- trim' (a, b, c) = (a, trim b, c)
-
-maybeFlag :: String -> Enviro -> Flag String
-maybeFlag k = maybe mempty Flag . lookup k
-
--- | Read the first non-comment, non-trivial line of a file, if it exists
-maybeReadFile :: String -> IO (Maybe String)
-maybeReadFile f = do
- exists <- doesFileExist f
- if exists
- then fmap getFirstLine $ readFile f
- else return Nothing
- where
- getFirstLine content =
- let nontrivialLines = dropWhile (\l -> (null l) || ("#" `isPrefixOf` l)) . lines $ content
- in case nontrivialLines of
- [] -> Nothing
- (l:_) -> Just l
-
--- |Get list of categories used in Hackage. NOTE: Very slow, needs to be cached
-knownCategories :: SourcePackageDb -> [String]
-knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet
- [ cat | pkg <- maybeToList . safeHead =<< (allPackagesByName sourcePkgIndex)
- , let catList = (PD.category . PD.packageDescription . srcpkgDescription) pkg
- , cat <- splitString ',' $ ShortText.fromShortText catList
- ]
-
--- Parse name and email, from darcs pref files or environment variable
-nameAndMail :: String -> (Flag String, Flag String)
-nameAndMail str
- | all isSpace nameOrEmail = mempty
- | null erest = (mempty, Flag $ trim nameOrEmail)
- | otherwise = (Flag $ trim nameOrEmail, Flag mail)
- where
- (nameOrEmail,erest) = break (== '<') str
- (mail,_) = break (== '>') (safeTail erest)
-
-trim :: String -> String
-trim = removeLeadingSpace . reverse . removeLeadingSpace . reverse
- where
- removeLeadingSpace = dropWhile isSpace
-
--- split string at given character, and remove whitespace
-splitString :: Char -> String -> [String]
-splitString sep str = go str where
- go s = if null s' then [] else tok : go rest where
- s' = dropWhile (\c -> c == sep || isSpace c) s
- (tok,rest) = break (==sep) s'
-
-nubSet :: (Ord a) => [a] -> [a]
-nubSet = Set.toList . Set.fromList
-
-{-
-test db testProjectRoot = do
- putStrLn "Guessed package name"
- (guessPackageName >=> print) testProjectRoot
- putStrLn "Guessed name and email"
- guessAuthorNameMail >>= print
-
- mods <- scanForModules testProjectRoot
-
- putStrLn "Guessed modules"
- mapM_ print mods
- putStrLn "Needed build programs"
- print (neededBuildPrograms mods)
-
- putStrLn "List of known categories"
- print $ knownCategories db
--}
diff --git a/cabal-install/src/Distribution/Client/Init/Interactive/Command.hs b/cabal-install/src/Distribution/Client/Init/Interactive/Command.hs
new file mode 100644
index 0000000000..2aef676763
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/Interactive/Command.hs
@@ -0,0 +1,459 @@
+{-# LANGUAGE LambdaCase #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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.Dependency (Dependency(..))
+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.Simple.Setup (Flag(..))
+import Distribution.Simple.PackageIndex (InstalledPackageIndex)
+import Distribution.Client.Types (SourcePackageDb(..))
+import Distribution.Solver.Types.PackageIndex (elemByPackageName)
+
+import Language.Haskell.Extension (Language(..))
+
+
+
+-- | Main driver for interactive prompt code.
+--
+createProject
+ :: Interactive m
+ => Verbosity
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> InitFlags
+ -> m ProjectSettings
+createProject v pkgIx srcDb 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 <- packageTypePrompt initFlags
+ isMinimal <- getMinimal initFlags
+ doOverwrite <- getOverwrite initFlags
+ pkgDir <- getPackageDir initFlags
+ pkgDesc <- genPkgDescription initFlags srcDb
+
+ let pkgName = _pkgName pkgDesc
+ mkOpts cs = WriteOpts
+ doOverwrite isMinimal cs
+ v pkgDir pkgType pkgName
+
+ case pkgType of
+ Library -> do
+ libTarget <- genLibTarget initFlags pkgIx
+ testTarget <- addLibDepToTest pkgName <$>
+ genTestTarget initFlags pkgIx
+
+ comments <- noCommentsPrompt initFlags
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc
+ (Just libTarget) Nothing testTarget
+
+ Executable -> do
+ exeTarget <- genExeTarget initFlags pkgIx
+ comments <- noCommentsPrompt initFlags
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc Nothing
+ (Just exeTarget) Nothing
+
+ LibraryAndExecutable -> do
+ libTarget <- genLibTarget initFlags pkgIx
+
+ exeTarget <- addLibDepToExe pkgName <$>
+ genExeTarget initFlags pkgIx
+
+ testTarget <- addLibDepToTest pkgName <$>
+ genTestTarget initFlags pkgIx
+
+ comments <- noCommentsPrompt initFlags
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc (Just libTarget)
+ (Just exeTarget) testTarget
+ where
+ -- Add package name as dependency of test suite
+ --
+ addLibDepToTest _ Nothing = Nothing
+ addLibDepToTest n (Just t) = Just $ t
+ { _testDependencies = _testDependencies t ++ [mkPackageNameDep n]
+ }
+
+ -- Add package name as dependency of executable
+ --
+ addLibDepToExe n exe = exe
+ { _exeDependencies = _exeDependencies exe ++ [mkPackageNameDep n]
+ }
+
+-- -------------------------------------------------------------------- --
+-- 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 flags srcDb = PkgDescription
+ <$> cabalVersionPrompt flags
+ <*> packageNamePrompt srcDb flags
+ <*> versionPrompt flags
+ <*> licensePrompt flags
+ <*> authorPrompt flags
+ <*> emailPrompt flags
+ <*> homepagePrompt flags
+ <*> synopsisPrompt flags
+ <*> categoryPrompt flags
+ <*> getExtraSrcFiles 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 flags pkgs = LibTarget
+ <$> srcDirsPrompt flags
+ <*> languagePrompt flags "library"
+ <*> getExposedModules flags
+ <*> getOtherModules flags
+ <*> getOtherExts flags
+ <*> dependenciesPrompt pkgs flags
+ <*> getBuildTools 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 flags pkgs = ExeTarget
+ <$> mainFilePrompt flags
+ <*> appDirsPrompt flags
+ <*> languagePrompt flags "executable"
+ <*> getOtherModules flags
+ <*> getOtherExts flags
+ <*> dependenciesPrompt pkgs flags
+ <*> getBuildTools 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 flags pkgs = initializeTestSuitePrompt flags >>= go
+ where
+ go initialized
+ | not initialized = return Nothing
+ | otherwise = fmap Just $ TestTarget
+ <$> testMainPrompt
+ <*> testDirsPrompt flags
+ <*> languagePrompt flags "test suite"
+ <*> getOtherModules flags
+ <*> getOtherExts flags
+ <*> dependenciesPrompt pkgs flags
+ <*> getBuildTools flags
+
+
+-- -------------------------------------------------------------------- --
+-- Prompts
+
+cabalVersionPrompt :: Interactive m => InitFlags -> m CabalSpecVersion
+cabalVersionPrompt flags = getCabalVersion flags $ do
+ v <- promptList "Please choose version of the Cabal specification to use"
+ ppVersions
+ (Just ppDefault)
+ (Just takeVersion)
+ False
+ -- take just the version numbers for convenience
+ return $ parseCabalVersion (takeVersion v)
+ where
+ -- only used when presenting the default in prompt
+ takeVersion = takeWhile (/= ' ')
+
+ ppDefault = displayCabalVersion defaultCabalVersion
+ ppVersions = displayCabalVersion <$> defaultCabalVersions
+
+ parseCabalVersion :: String -> CabalSpecVersion
+ parseCabalVersion "1.10" = CabalSpecV1_10
+ parseCabalVersion "2.0" = CabalSpecV2_0
+ parseCabalVersion "2.2" = CabalSpecV2_2
+ parseCabalVersion "2.4" = CabalSpecV2_4
+ parseCabalVersion "3.0" = CabalSpecV3_0
+ parseCabalVersion "3.4" = CabalSpecV3_4
+ parseCabalVersion _ = defaultCabalVersion -- 2.4
+
+ displayCabalVersion :: CabalSpecVersion -> String
+ displayCabalVersion v = case v of
+ CabalSpecV1_10 -> "1.10 (legacy)"
+ CabalSpecV2_0 -> "2.0 (+ support for Backpack, internal sub-libs, '^>=' operator)"
+ CabalSpecV2_2 -> "2.2 (+ support for 'common', 'elif', redundant commas, SPDX)"
+ CabalSpecV2_4 -> "2.4 (+ support for '**' globbing)"
+ CabalSpecV3_0 -> "3.0 (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"
+ CabalSpecV3_4 -> "3.4 (+ support for 'pkg:sublib' syntax, active repo configuration, rich index-state syntax)"
+ _ -> showCabalSpecVersion v
+
+packageNamePrompt :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName
+packageNamePrompt srcDb flags = getPackageName flags $ do
+ defName <- case packageDir flags of
+ Flag b -> return $ filePathToPkgName b
+ NoFlag -> currentDirPkgName
+
+ go $ Just defName
+ where
+ go defName = prompt "Package name" defName >>= \n ->
+ if isPkgRegistered n
+ then do
+ don'tUseName <- promptYesNo (promptOtherNameMsg n) (Just True)
+ if don'tUseName
+ then do
+ putStrLn (inUseMsg n)
+ go defName
+ else return n
+ else return n
+
+ isPkgRegistered = elemByPackageName (packageIndex srcDb)
+
+ inUseMsg pn = "The name "
+ ++ unPackageName pn
+ ++ " is already in use by another package on Hackage."
+
+ promptOtherNameMsg pn = inUseMsg pn ++ " Do you want to choose a different name"
+
+versionPrompt :: Interactive m => InitFlags -> m Version
+versionPrompt flags = getVersion flags go
+ where
+ go = do
+ vv <- promptStr "Package version" (Just $ prettyShow defaultVersion)
+ case simpleParsec vv of
+ Nothing -> do
+ putStrLn
+ $ "Version must be a valid PVP format (e.g. 0.1.0.0): "
+ ++ vv
+ go
+ Just v -> return v
+
+licensePrompt :: Interactive m => InitFlags -> m SPDX.License
+licensePrompt flags = getLicense flags $ do
+ l <- promptList "Please choose a license"
+ licenses
+ Nothing
+ Nothing
+ True
+
+ case simpleParsec l of
+ Nothing -> do
+ putStrLn "The license must be a valid SPDX expression."
+ licensePrompt flags
+ Just l' -> return l'
+ where
+ licenses = SPDX.licenseId <$> defaultLicenseIds
+
+authorPrompt :: Interactive m => InitFlags -> m String
+authorPrompt flags = getAuthor flags $
+ promptStr "Author name" Nothing
+
+emailPrompt :: Interactive m => InitFlags -> m String
+emailPrompt flags = getEmail flags $
+ promptStr "Maintainer email" Nothing
+
+homepagePrompt :: Interactive m => InitFlags -> m String
+homepagePrompt flags = getHomepage flags $
+ promptStr "Project homepage URL" Nothing
+
+synopsisPrompt :: Interactive m => InitFlags -> m String
+synopsisPrompt flags = getSynopsis flags $
+ promptStr "Project synopsis" Nothing
+
+categoryPrompt :: Interactive m => InitFlags -> m String
+categoryPrompt flags = getCategory flags $ promptList
+ "Project category" defaultCategories
+ (Just "") (Just matchNone) True
+ where
+ matchNone s
+ | null s = "(none)"
+ | otherwise = s
+
+mainFilePrompt :: Interactive m => InitFlags -> m HsFilePath
+mainFilePrompt flags = getMainFile flags go
+ where
+ defaultMainIs' = show defaultMainIs
+ go = do
+ fp <- promptList "What is the main module of the executable"
+ [defaultMainIs', "Main.lhs"]
+ (Just defaultMainIs')
+ Nothing
+ True
+
+ let hs = toHsFilePath fp
+
+ case _hsFileType hs of
+ InvalidHsPath -> do
+ putStrLn $ concat
+ [ "Main file "
+ , show hs
+ , " is not a valid haskell file. Source files must end in .hs or .lhs."
+ ]
+ go
+
+ _ -> return hs
+
+testDirsPrompt :: Interactive m => InitFlags -> m [String]
+testDirsPrompt flags = getTestDirs flags $ do
+ dir <- promptStr "Test directory" (Just defaultTestDir)
+ return [dir]
+
+languagePrompt :: Interactive m => InitFlags -> String -> m Language
+languagePrompt flags pkgType = getLanguage flags $ do
+ lang <- promptList ("Choose a language for your " ++ pkgType)
+ ["Haskell2010", "Haskell98"]
+ (Just "Haskell2010")
+ Nothing
+ True
+
+ case lang of
+ "Haskell2010" -> return Haskell2010
+ "Haskell98" -> return Haskell98
+ l | all isAlphaNum l -> return $ UnknownLanguage l
+ _ -> do
+ putStrLn
+ $ "\nThe language must be alphanumeric. "
+ ++ "Please enter a different language."
+
+ languagePrompt flags pkgType
+
+noCommentsPrompt :: Interactive m => InitFlags -> m Bool
+noCommentsPrompt flags = getNoComments flags $ do
+ doComments <- promptYesNo
+ "Add informative comments to each field in the cabal file. (y/n)"
+ (Just True)
+
+ --
+ -- 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 flags = getAppDirs flags $ do
+ dir <- promptList promptMsg
+ [defaultApplicationDir, "exe", "src-exe"]
+ (Just defaultApplicationDir)
+ Nothing
+ True
+
+ return [dir]
+ where
+ promptMsg = case mainIs flags of
+ Flag p -> "Application (" ++ p ++ ") directory"
+ NoFlag -> "Application directory"
+
+-- | Ask for the source (library) root directory.
+srcDirsPrompt :: Interactive m => InitFlags -> m [String]
+srcDirsPrompt flags = getSrcDirs flags $ do
+ dir <- promptList "Library source directory"
+ [defaultSourceDir, "lib", "src-lib"]
+ (Just defaultSourceDir)
+ Nothing
+ True
+
+ return [dir]
+
+dependenciesPrompt
+ :: Interactive m
+ => InstalledPackageIndex
+ -> InitFlags
+ -> m [Dependency]
+dependenciesPrompt pkgIx flags = getDependencies flags $
+ retrieveDependencies flags [fromString "Prelude"] pkgIx
diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
new file mode 100644
index 0000000000..939f0e134b
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
@@ -0,0 +1,437 @@
+{-# LANGUAGE LambdaCase #-}
+module Distribution.Client.Init.NonInteractive.Command
+( genPkgDescription
+, genLibTarget
+, genExeTarget
+, genTestTarget
+, createProject
+, packageTypeHeuristics
+, authorHeuristics
+, emailHeuristics
+, cabalVersionHeuristics
+, packageNameHeuristics
+, versionHeuristics
+, mainFileHeuristics
+, testDirsHeuristics
+, initializeTestSuiteHeuristics
+, exposedModulesHeuristics
+, libOtherModulesHeuristics
+, exeOtherModulesHeuristics
+, testOtherModulesHeuristics
+, buildToolsHeuristics
+, dependenciesHeuristics
+, otherExtsHeuristics
+, licenseHeuristics
+, homepageHeuristics
+, synopsisHeuristics
+, categoryHeuristics
+, extraSourceFilesHeuristics
+, appDirsHeuristics
+, srcDirsHeuristics
+, languageHeuristics
+, noCommentsHeuristics
+, minimalHeuristics
+, overwriteHeuristics
+) where
+import Distribution.Client.Init.Types
+
+import Prelude ()
+import Distribution.Client.Compat.Prelude hiding (putStr, putStrLn, getLine, last, head)
+
+import Data.List (last, head)
+import qualified Data.List.NonEmpty as NEL
+
+import Distribution.CabalSpecVersion (CabalSpecVersion(..))
+import Distribution.Version (Version)
+import Distribution.ModuleName (ModuleName, components)
+import Distribution.Types.Dependency (Dependency(..))
+import Distribution.Types.PackageName (PackageName, unPackageName)
+import qualified Distribution.SPDX as SPDX
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.NonInteractive.Heuristics
+import Distribution.Client.Init.Utils
+import Distribution.Client.Init.FlagExtractors
+import Distribution.Simple.Setup (Flag(..))
+import Distribution.Simple.PackageIndex (InstalledPackageIndex)
+import Distribution.Client.Types (SourcePackageDb(..))
+import Distribution.Solver.Types.PackageIndex (elemByPackageName)
+import Distribution.Utils.Generic (safeHead)
+
+import Language.Haskell.Extension (Language(..), Extension(..))
+
+import System.FilePath (splitDirectories, (</>))
+
+
+-- | Main driver for interactive prompt code.
+--
+createProject
+ :: Interactive m
+ => Verbosity
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> InitFlags
+ -> m ProjectSettings
+createProject v pkgIx srcDb 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. Determine whether we generate simple targets or prompt the
+ -- user for inputs when not supplied as a flag. In general,
+ -- flag inputs are preferred, and "simple" here means
+ -- reasonable defaults defined in @Defaults.hs@.
+ --
+ -- 3. 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.
+ --
+ -- 4. 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 <- packageTypeHeuristics initFlags
+ isMinimal <- getMinimal initFlags
+ doOverwrite <- getOverwrite initFlags
+ pkgDir <- packageDirHeuristics initFlags
+ pkgDesc <- genPkgDescription initFlags srcDb
+ comments <- noCommentsHeuristics initFlags
+
+ let pkgName = _pkgName pkgDesc
+ mkOpts cs = WriteOpts
+ doOverwrite isMinimal cs
+ v pkgDir pkgType pkgName
+
+ case pkgType of
+ Library -> do
+ libTarget <- genLibTarget initFlags pkgIx
+ testTarget <- genTestTarget initFlags pkgIx
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc
+ (Just libTarget) Nothing testTarget
+
+ Executable -> do
+ exeTarget <- genExeTarget initFlags pkgIx
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc Nothing
+ (Just exeTarget) Nothing
+
+ LibraryAndExecutable -> do
+ libTarget <- genLibTarget initFlags pkgIx
+ exeTarget <- genExeTarget initFlags pkgIx
+ testTarget <- genTestTarget initFlags pkgIx
+
+ return $ ProjectSettings
+ (mkOpts comments) pkgDesc (Just libTarget)
+ (Just exeTarget) testTarget
+
+genPkgDescription
+ :: Interactive m
+ => InitFlags
+ -> SourcePackageDb
+ -> m PkgDescription
+genPkgDescription flags srcDb = PkgDescription
+ <$> cabalVersionHeuristics flags
+ <*> packageNameHeuristics srcDb flags
+ <*> versionHeuristics flags
+ <*> licenseHeuristics flags
+ <*> authorHeuristics flags
+ <*> emailHeuristics flags
+ <*> homepageHeuristics flags
+ <*> synopsisHeuristics flags
+ <*> categoryHeuristics flags
+ <*> extraSourceFilesHeuristics flags
+
+genLibTarget
+ :: Interactive m
+ => InitFlags
+ -> InstalledPackageIndex
+ -> m LibTarget
+genLibTarget flags pkgs = do
+ srcDirs <- srcDirsHeuristics flags
+ let srcDir = fromMaybe defaultSourceDir $ safeHead srcDirs
+ LibTarget srcDirs
+ <$> languageHeuristics flags
+ <*> exposedModulesHeuristics flags
+ <*> libOtherModulesHeuristics flags
+ <*> otherExtsHeuristics flags srcDir
+ <*> dependenciesHeuristics flags srcDir pkgs
+ <*> buildToolsHeuristics flags srcDir
+
+genExeTarget
+ :: Interactive m
+ => InitFlags
+ -> InstalledPackageIndex
+ -> m ExeTarget
+genExeTarget flags pkgs = do
+ appDirs <- appDirsHeuristics flags
+ let appDir = fromMaybe defaultApplicationDir $ safeHead appDirs
+ ExeTarget
+ <$> mainFileHeuristics flags
+ <*> pure appDirs
+ <*> languageHeuristics flags
+ <*> exeOtherModulesHeuristics flags
+ <*> otherExtsHeuristics flags appDir
+ <*> dependenciesHeuristics flags appDir pkgs
+ <*> buildToolsHeuristics flags appDir
+
+genTestTarget
+ :: Interactive m
+ => InitFlags
+ -> InstalledPackageIndex
+ -> m (Maybe TestTarget)
+genTestTarget flags pkgs = do
+ initialized <- initializeTestSuiteHeuristics flags
+ testDirs' <- testDirsHeuristics flags
+ let testDir = fromMaybe defaultTestDir $ safeHead testDirs'
+ if not initialized
+ then return Nothing
+ else fmap Just $ TestTarget
+ <$> testMainHeuristics flags
+ <*> pure testDirs'
+ <*> languageHeuristics flags
+ <*> testOtherModulesHeuristics flags
+ <*> otherExtsHeuristics flags testDir
+ <*> dependenciesHeuristics flags testDir pkgs
+ <*> buildToolsHeuristics flags testDir
+
+-- -------------------------------------------------------------------- --
+-- Get flags from init config
+
+minimalHeuristics :: Interactive m => InitFlags -> m Bool
+minimalHeuristics = getMinimal
+
+overwriteHeuristics :: Interactive m => InitFlags -> m Bool
+overwriteHeuristics = getOverwrite
+
+packageDirHeuristics :: Interactive m => InitFlags -> m FilePath
+packageDirHeuristics = getPackageDir
+
+-- | Get the version of the cabal spec to use.
+-- The spec version can be specified by the InitFlags cabalVersion field. If
+-- none is specified then the default version is used.
+cabalVersionHeuristics :: Interactive m => InitFlags -> m CabalSpecVersion
+cabalVersionHeuristics flags = getCabalVersion flags guessCabalSpecVersion
+
+-- | Get the package name: use the package directory (supplied, or the current
+-- directory by default) as a guess. It looks at the SourcePackageDb to avoid
+-- using an existing package name.
+packageNameHeuristics :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName
+packageNameHeuristics sourcePkgDb flags = getPackageName flags $ do
+ defName <- guessPackageName =<< case packageDir flags of
+ Flag a -> return a
+ NoFlag -> last . splitDirectories <$> getCurrentDirectory
+
+ when (isPkgRegistered defName)
+ $ putStrLn (inUseMsg defName)
+
+ return defName
+
+ where
+ isPkgRegistered = elemByPackageName (packageIndex sourcePkgDb)
+
+ inUseMsg pn = "The name "
+ ++ unPackageName pn
+ ++ " is already in use by another package on Hackage."
+
+-- | Package version: use 0.1.0.0 as a last resort
+versionHeuristics :: Interactive m => InitFlags -> m Version
+versionHeuristics flags = getVersion flags $ return defaultVersion
+
+-- | Choose a license for the package.
+-- The license can come from Initflags (license field), if it is not present
+-- then prompt the user from a predefined list of licenses.
+licenseHeuristics :: Interactive m => InitFlags -> m SPDX.License
+licenseHeuristics flags = getLicense flags $ guessLicense flags
+
+-- | The author's name. Prompt, or try to guess from an existing
+-- darcs repo.
+authorHeuristics :: Interactive m => InitFlags -> m String
+authorHeuristics flags = getAuthor flags guessAuthorEmail
+
+-- | The author's email. Prompt, or try to guess from an existing
+-- darcs repo.
+emailHeuristics :: Interactive m => InitFlags -> m String
+emailHeuristics flags = getEmail flags guessAuthorName
+
+-- | Prompt for a homepage URL for the package.
+homepageHeuristics :: Interactive m => InitFlags -> m String
+homepageHeuristics flags = getHomepage flags $ return ""
+
+-- | Prompt for a project synopsis.
+synopsisHeuristics :: Interactive m => InitFlags -> m String
+synopsisHeuristics flags = getSynopsis flags $ return ""
+
+-- | Prompt for a package category.
+-- Note that it should be possible to do some smarter guessing here too, i.e.
+-- look at the name of the top level source directory.
+categoryHeuristics :: Interactive m => InitFlags -> m String
+categoryHeuristics flags = getCategory flags $ return "(none)"
+
+-- | Try to guess extra source files.
+extraSourceFilesHeuristics :: Interactive m => InitFlags -> m (NonEmpty FilePath)
+extraSourceFilesHeuristics flags = case extraSrc flags of
+ Flag x | not (null x) -> return $ NEL.fromList x
+ _ -> guessExtraSourceFiles flags
+
+-- | Try to guess if the project builds a library, an executable, or both.
+packageTypeHeuristics :: Interactive m => InitFlags -> m PackageType
+packageTypeHeuristics flags = getPackageType flags $ guessPackageType flags
+
+-- | Try to guess the main file, if nothing is found, fallback
+-- to a default value.
+mainFileHeuristics :: Interactive m => InitFlags -> m HsFilePath
+mainFileHeuristics flags = do
+ appDir <- head <$> appDirsHeuristics flags
+ getMainFile flags . guessMainFile $ appDir
+
+testMainHeuristics :: Interactive m => InitFlags -> m HsFilePath
+testMainHeuristics flags = do
+ testDir <- head <$> testDirsHeuristics flags
+ guessMainFile testDir
+
+initializeTestSuiteHeuristics :: Interactive m => InitFlags -> m Bool
+initializeTestSuiteHeuristics flags = getInitializeTestSuite flags $ return False
+
+testDirsHeuristics :: Interactive m => InitFlags -> m [String]
+testDirsHeuristics flags = getTestDirs flags $ return [defaultTestDir]
+
+-- | Ask for the Haskell base language of the package.
+languageHeuristics :: Interactive m => InitFlags -> m Language
+languageHeuristics flags = getLanguage flags guessLanguage
+
+-- | Ask whether to generate explanatory comments.
+noCommentsHeuristics :: Interactive m => InitFlags -> m Bool
+noCommentsHeuristics flags = getNoComments flags $ return False
+
+-- | Ask for the application root directory.
+appDirsHeuristics :: Interactive m => InitFlags -> m [String]
+appDirsHeuristics flags = getAppDirs flags $ guessApplicationDirectories flags
+
+-- | Ask for the source (library) root directory.
+srcDirsHeuristics :: Interactive m => InitFlags -> m [String]
+srcDirsHeuristics flags = getSrcDirs flags $ guessSourceDirectories flags
+
+-- | Retrieve the list of exposed modules
+exposedModulesHeuristics :: Interactive m => InitFlags -> m (NonEmpty ModuleName)
+exposedModulesHeuristics flags = do
+ mods <- case exposedModules flags of
+ Flag x -> return x
+ NoFlag -> do
+ srcDir <- fromMaybe defaultSourceDir . safeHead <$> srcDirsHeuristics flags
+
+ modules <- filter isHaskell <$> listFilesRecursive srcDir
+ modulesNames <- traverse retrieveModuleName modules
+
+ otherModules' <- libOtherModulesHeuristics flags
+ return $ filter (`notElem` otherModules') modulesNames
+
+ return $ if null mods
+ then myLibModule NEL.:| []
+ else NEL.fromList mods
+
+-- | Retrieve the list of other modules for Libraries, filtering them
+-- based on the last component of the module name
+libOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
+libOtherModulesHeuristics flags = case otherModules flags of
+ Flag x -> return x
+ NoFlag -> do
+ let otherCandidates = ["Internal", "Utils"]
+ srcDir = case sourceDirs flags of
+ Flag x -> fromMaybe defaultSourceDir $ safeHead x
+ NoFlag -> defaultSourceDir
+
+ libDir <- (</> srcDir) <$> case packageDir flags of
+ Flag x -> return x
+ NoFlag -> getCurrentDirectory
+
+ exists <- doesDirectoryExist libDir
+ if exists
+ then do
+ otherModules' <- filter isHaskell <$> listFilesRecursive libDir
+ filter ((`elem` otherCandidates) . last . components)
+ <$> traverse retrieveModuleName otherModules'
+ else return []
+
+-- | Retrieve the list of other modules for Executables, it lists everything
+-- that is a Haskell file within the application directory, excluding the main file
+exeOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
+exeOtherModulesHeuristics flags = case otherModules flags of
+ Flag x -> return x
+ NoFlag -> do
+ let appDir = case applicationDirs flags of
+ Flag x -> fromMaybe defaultApplicationDir $ safeHead x
+ NoFlag -> defaultApplicationDir
+
+ exeDir <- (</> appDir) <$> case packageDir flags of
+ Flag x -> return x
+ NoFlag -> getCurrentDirectory
+
+ exists <- doesDirectoryExist exeDir
+ if exists
+ then do
+ otherModules' <- filter (\f -> not (isMain f) && isHaskell f)
+ <$> listFilesRecursive exeDir
+ traverse retrieveModuleName otherModules'
+ else return []
+
+-- | Retrieve the list of other modules for Tests, it lists everything
+-- that is a Haskell file within the tests directory, excluding the main file
+testOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
+testOtherModulesHeuristics flags = case otherModules flags of
+ Flag x -> return x
+ NoFlag -> do
+ let testDir = case testDirs flags of
+ Flag x -> fromMaybe defaultTestDir $ safeHead x
+ NoFlag -> defaultTestDir
+
+ testDir' <- (</> testDir) <$> case packageDir flags of
+ Flag x -> return x
+ NoFlag -> getCurrentDirectory
+
+ exists <- doesDirectoryExist testDir'
+ if exists
+ then do
+ otherModules' <- filter (\f -> not (isMain f) && isHaskell f)
+ <$> listFilesRecursive testDir'
+ traverse retrieveModuleName otherModules'
+ else return []
+
+-- | Retrieve the list of build tools
+buildToolsHeuristics :: Interactive m => InitFlags -> FilePath -> m [String]
+buildToolsHeuristics flags fp = case buildTools flags of
+ Flag x -> return x
+ NoFlag -> retrieveBuildTools fp
+
+-- | Retrieve the list of dependencies
+dependenciesHeuristics :: Interactive m => InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
+dependenciesHeuristics flags fp pkgIx = getDependencies flags $ do
+ sources <- retrieveSourceFiles fp
+
+ let mods = case exposedModules flags of
+ Flag x -> x
+ NoFlag -> map moduleName sources
+
+ retrieveDependencies flags
+ ( nub -- skips duplicates
+ ( fromString "Prelude" -- gets base as dependency
+ : (filter (`notElem` mods) -- skips modules from this own package
+ . concatMap imports $ sources)))
+ pkgIx
+
+-- | Retrieve the list of extensions
+otherExtsHeuristics :: Interactive m => InitFlags -> FilePath -> m [Extension]
+otherExtsHeuristics flags fp = case otherExts flags of
+ Flag x -> return x
+ NoFlag -> do
+ sources <- listFilesRecursive fp
+ extensions' <- traverse retrieveModuleExtensions . filter isHaskell $ sources
+
+ return $ nub . join $ extensions'
diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
new file mode 100644
index 0000000000..93348ada04
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE LambdaCase #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Client.Init.NonInteractive.Heuristics
+-- Copyright : (c) Benedikt Huber 2009
+-- License : BSD-like
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- Heuristics for creating initial cabal files.
+--
+-----------------------------------------------------------------------------
+module Distribution.Client.Init.NonInteractive.Heuristics
+ ( guessPackageName
+ , guessMainFile
+ , guessLicense
+ , guessExtraSourceFiles
+ , guessAuthorName
+ , guessAuthorEmail
+ , guessCabalSpecVersion
+ , guessLanguage
+ , guessPackageType
+ , guessSourceDirectories
+ , guessApplicationDirectories
+ ) where
+
+import Prelude (read)
+import Distribution.Client.Compat.Prelude hiding (readFile, (<|>), many)
+import Distribution.Utils.Generic (safeLast)
+
+import Distribution.Simple.Setup (fromFlagOrDefault)
+
+import Text.Parsec
+import qualified Data.List as L
+import qualified Data.List.NonEmpty as NEL
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Types hiding (break)
+import Distribution.Client.Init.Utils
+import qualified Distribution.SPDX as SPDX
+import System.FilePath
+import Distribution.CabalSpecVersion
+import Language.Haskell.Extension
+import Distribution.Version
+import Distribution.Types.PackageName (PackageName, mkPackageName)
+
+
+
+-- | Guess the main file, returns a default value if none is found.
+guessMainFile :: Interactive m => FilePath -> m HsFilePath
+guessMainFile pkgDir = do
+ files <- filter isMain <$> listFilesRecursive pkgDir
+
+ return $ if null files
+ then defaultMainIs
+ else toHsFilePath $ L.head files
+
+-- | Juggling characters around to guess the desired cabal version based on
+-- the system's cabal version.
+guessCabalSpecVersion :: Interactive m => m CabalSpecVersion
+guessCabalSpecVersion = do
+ (_, verString, _) <- readProcessWithExitCode "cabal" ["--version"] ""
+ case runParser versionParser () "" verString of
+ Right ver@(_:_) -> return $
+ read $ "CabalSpecV" ++ format' ver
+ _ -> return defaultCabalVersion
+
+ where
+ format' [] = []
+ format' ('.':xs) = '_' : takeWhile (/= '.') xs
+ format' (x:xs) = x : format' xs
+
+-- | Guess the language specification based on the GHC version
+guessLanguage :: Interactive m => m Language
+guessLanguage = do
+ (_, verString, _) <- readProcessWithExitCode "ghc" ["--version"] ""
+ case simpleParsec <$> runParser versionParser () "" verString of
+ Right (Just ver) -> return $
+ if ver < mkVersion [7,0,1]
+ then Haskell98
+ else Haskell2010
+ _ -> return defaultLanguage
+
+-- | Guess the package name based on the given root directory.
+guessPackageName :: Interactive m => FilePath -> m PackageName
+guessPackageName = fmap (mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories)
+ . tryCanonicalizePath
+ where
+ -- Treat each span of non-alphanumeric characters as a hyphen. Each
+ -- hyphenated component of a package name must contain at least one
+ -- alphabetic character. An arbitrary character ('x') will be prepended if
+ -- this is not the case for the first component, and subsequent components
+ -- will simply be run together. For example, "1+2_foo-3" will become
+ -- "x12-foo3".
+ repair = repair' ('x' :) id
+ repair' invalid valid x = case dropWhile (not . isAlphaNum) x of
+ "" -> repairComponent ""
+ x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
+ in c ++ repairRest r
+ where
+ repairComponent c | all isDigit c = invalid c
+ | otherwise = valid c
+ repairRest = repair' id ('-' :)
+
+-- | Try to guess the license from an already existing @LICENSE@ file in
+-- the package directory, comparing the file contents with the ones
+-- listed in @Licenses.hs@, for now it only returns a default value.
+guessLicense :: Interactive m => InitFlags -> m SPDX.License
+guessLicense _ = return SPDX.NONE
+
+guessExtraSourceFiles :: Interactive m => InitFlags -> m (NonEmpty FilePath)
+guessExtraSourceFiles flags = do
+ pkgDir <- fromFlagOrDefault getCurrentDirectory $ fmap return $ packageDir flags
+ files <- getDirectoryContents pkgDir
+
+ let extSrcCandidates = ["CHANGES", "CHANGELOG", "README"]
+ extraSrc' = [y | x <- extSrcCandidates, y <- files, x == map toUpper (takeBaseName y)]
+
+ return $ if null extraSrc'
+ then defaultChangelog NEL.:| []
+ else NEL.fromList extraSrc'
+
+-- | Try to guess the package type from the files in the package directory,
+-- looking for unique characteristics from each type, defaults to Executable.
+guessPackageType :: Interactive m => InitFlags -> m PackageType
+guessPackageType flags = do
+ let lastDir dirs = L.last . splitDirectories $ dirs
+ srcCandidates = [defaultSourceDir, "src", "source"]
+ testCandidates = [defaultTestDir, "test", "tests"]
+
+ pkgDir <- fromFlagOrDefault getCurrentDirectory $ fmap return $ packageDir flags
+ files <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
+
+ let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
+ hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]
+
+ return $ case (hasLib, hasExe) of
+ (True, True) -> LibraryAndExecutable
+ (True, False) -> Library
+ _ -> Executable
+
+-- | Try to guess the application directories from the package directory,
+-- using a default value as fallback.
+guessApplicationDirectories :: Interactive m => InitFlags -> m [FilePath]
+guessApplicationDirectories flags = do
+ pkgDirs <- listDirectory =<< fromFlagOrDefault getCurrentDirectory
+ (fmap return $ packageDir flags)
+
+ let candidates = [defaultApplicationDir, "app", "src-exe"] in
+ return $ case [y | x <- candidates, y <- pkgDirs, x == y] of
+ [] -> [defaultApplicationDir]
+ x -> nub x
+
+-- | Try to guess the source directories, using a default value as fallback.
+guessSourceDirectories :: Interactive m => InitFlags -> m [FilePath]
+guessSourceDirectories flags = do
+ pkgDir <- fromFlagOrDefault getCurrentDirectory $ fmap return $ packageDir flags
+
+ doesDirectoryExist (pkgDir </> "src") >>= return . \case
+ False -> [defaultSourceDir]
+ True -> ["src"]
+
+-- | Guess author and email using git configuration options.
+guessAuthorName :: Interactive m => m String
+guessAuthorName = guessGitInfo "user.name"
+
+guessAuthorEmail :: Interactive m => m String
+guessAuthorEmail = guessGitInfo "user.email"
+
+guessGitInfo :: Interactive m => String -> m String
+guessGitInfo target = do
+ info <- readProcessWithExitCode "git" ["config", "--local", target] ""
+ if null $ snd' info
+ then trim . snd' <$> readProcessWithExitCode "git" ["config", "--global", target] ""
+ else return . trim $ snd' info
+
+ where
+ snd' (_, x, _) = x
diff --git a/cabal-install/src/Distribution/Client/Init/Prompt.hs b/cabal-install/src/Distribution/Client/Init/Prompt.hs
index 0033278270..ebc995f2ef 100644
--- a/cabal-install/src/Distribution/Client/Init/Prompt.hs
+++ b/cabal-install/src/Distribution/Client/Init/Prompt.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Init.Prompt
@@ -12,134 +14,153 @@
--
-----------------------------------------------------------------------------
-module Distribution.Client.Init.Prompt (
+module Distribution.Client.Init.Prompt
+( prompt
+, promptYesNo
+, promptStr
+, promptList
+) where
- -- * Commands
- prompt
- , promptYesNo
- , promptStr
- , promptList
- , promptListOptional
- , maybePrompt
- ) where
-
-import Prelude ()
-import Distribution.Client.Compat.Prelude hiding (empty)
+import Prelude hiding (break, putStrLn, getLine, putStr)
+import Distribution.Client.Compat.Prelude hiding (break, empty, getLine, putStr, putStrLn)
import Distribution.Client.Init.Types
- ( InitFlags(..) )
-import Distribution.Simple.Setup
- ( Flag(..) )
-
--- | Run a prompt or not based on the interactive flag of the
--- InitFlags structure.
-maybePrompt :: InitFlags -> IO t -> IO (Maybe t)
-maybePrompt flags p =
- case interactive flags of
- Flag True -> Just `fmap` p
- _ -> return Nothing
-- | Create a prompt with optional default value that returns a
--- String.
-promptStr :: String -> Maybe String -> IO String
-promptStr = promptDefault' Just id
+-- String.
+promptStr :: Interactive m => String -> Maybe String -> m String
+promptStr = promptDefault Right id
-- | Create a yes/no prompt with optional default value.
-promptYesNo :: String -- ^ prompt message
- -> Maybe Bool -- ^ optional default value
- -> IO Bool
+promptYesNo
+ :: Interactive m
+ => String
+ -- ^ prompt message
+ -> Maybe Bool
+ -- ^ optional default value
+ -> m Bool
promptYesNo =
- promptDefault' recogniseYesNo showYesNo
+ promptDefault recogniseYesNo showYesNo
where
- recogniseYesNo s | s == "y" || s == "Y" = Just True
- | s == "n" || s == "N" = Just False
- | otherwise = Nothing
+ recogniseYesNo s
+ | (toLower <$> s) == "y" = Right True
+ | (toLower <$> s) == "n" || s == "N" = Right False
+ | otherwise = Left $ "Cannot parse input: " ++ s
+
showYesNo True = "y"
showYesNo False = "n"
-- | Create a prompt with optional default value that returns a value
-- of some Text instance.
-prompt :: (Parsec t, Pretty t) => String -> Maybe t -> IO t
-prompt = promptDefault' simpleParsec prettyShow
-
--- | Create a prompt with an optional default value.
-promptDefault' :: (String -> Maybe t) -- ^ parser
- -> (t -> String) -- ^ pretty-printer
- -> String -- ^ prompt message
- -> Maybe t -- ^ optional default value
- -> IO t
-promptDefault' parser ppr pr def = do
- putStr $ mkDefPrompt pr (ppr `fmap` def)
- inp <- getLine
- case (inp, def) of
- ("", Just d) -> return d
- _ -> case parser inp of
- Just t -> return t
- Nothing -> do putStrLn $ "Couldn't parse " ++ inp ++ ", please try again!"
- promptDefault' parser ppr pr def
+prompt :: (Interactive m, Parsec t, Pretty t) => String -> Maybe t -> m t
+prompt = promptDefault eitherParsec prettyShow
-- | Create a prompt from a prompt string and a String representation
-- of an optional default value.
mkDefPrompt :: String -> Maybe String -> String
-mkDefPrompt pr def = pr ++ "?" ++ defStr def
- where defStr Nothing = " "
- defStr (Just s) = " [default: " ++ s ++ "] "
-
--- | Create a prompt from a list of items, where no selected items is
--- valid and will be represented as a return value of 'Nothing'.
-promptListOptional :: (Pretty t, Eq t)
- => String -- ^ prompt
- -> [t] -- ^ choices
- -> IO (Maybe (Either String t))
-promptListOptional pr choices = promptListOptional' pr choices prettyShow
-
-promptListOptional' :: Eq t
- => String -- ^ prompt
- -> [t] -- ^ choices
- -> (t -> String) -- ^ show an item
- -> IO (Maybe (Either String t))
-promptListOptional' pr choices displayItem =
- fmap rearrange
- $ promptList pr (Nothing : map Just choices) (Just Nothing)
- (maybe "(none)" displayItem) True
+mkDefPrompt msg def = msg ++ "?" ++ format def
where
- rearrange = either (Just . Left) (fmap Right)
-
--- | Create a prompt from a list of items.
-promptList :: Eq t
- => String -- ^ prompt
- -> [t] -- ^ choices
- -> Maybe t -- ^ optional default value
- -> (t -> String) -- ^ show an item
- -> Bool -- ^ whether to allow an 'other' option
- -> IO (Either String t)
-promptList pr choices def displayItem other = do
- putStrLn $ pr ++ ":"
- let options1 = map (\c -> (Just c == def, displayItem c)) choices
- options2 = zip ([1..]::[Int])
- (options1 ++ [(False, "Other (specify)") | other])
- traverse_ (putStrLn . \(n,(i,s)) -> showOption n i ++ s) options2
- promptList' displayItem (length options2) choices def other
- where showOption n i | n < 10 = " " ++ star i ++ " " ++ rest
- | otherwise = " " ++ star i ++ rest
- where rest = show n ++ ") "
- star True = "*"
- star False = " "
-
-promptList' :: (t -> String) -> Int -> [t] -> Maybe t -> Bool -> IO (Either String t)
-promptList' displayItem numChoices choices def other = do
- putStr $ mkDefPrompt "Your choice" (displayItem `fmap` def)
- inp <- getLine
- case (inp, def) of
- ("", Just d) -> return $ Right d
- _ -> case readMaybe inp of
- Nothing -> invalidChoice inp
- Just n -> getChoice n
- where invalidChoice inp = do putStrLn $ inp ++ " is not a valid choice."
- promptList' displayItem numChoices choices def other
- getChoice n | n < 1 || n > numChoices = invalidChoice (show n)
- | n < numChoices ||
- (n == numChoices && not other)
- = return . Right $ choices !! (n-1)
- | otherwise = Left `fmap` promptStr "Please specify" Nothing
+ format Nothing = " "
+ format (Just s) = " [default: " ++ s ++ "] "
+
+-- | Create a prompt from a list of strings
+promptList
+ :: Interactive m
+ => String
+ -- ^ prompt
+ -> [String]
+ -- ^ choices
+ -> Maybe String
+ -- ^ optional default value
+ -> Maybe (String -> String)
+ -- ^ modify the default value to present in-prompt
+ -> Bool
+ -- ^ whether to allow an 'other' option
+ -> m String
+promptList msg choices def modDef hasOther = do
+ putStrLn $ msg ++ ":"
+
+ -- Output nicely formatted list of options
+ for_ prettyChoices $ \(i,c) -> do
+ let star = if Just c == def
+ then "*"
+ else " "
+
+ let output = concat $ if i < 10
+ then [" ", star, " ", show i, ") ", c]
+ else [" ", star, show i, ") ", c]
+
+ putStrLn output
+
+ go
+ where
+ prettyChoices =
+ let cs = if hasOther
+ then choices ++ ["Other (specify)"]
+ else choices
+ in zip [1::Int .. numChoices + 1] cs
+
+ numChoices = length choices
+
+ invalidChoice input = do
+ let msg' = if null input
+ then "Empty input is not a valid choice."
+ else concat
+ [ input
+ , " is not a valid choice. Please choose a number from 1 to "
+ , show (numChoices +1)
+ , "."
+ ]
+
+ putStrLn msg'
+ breakOrContinue ("promptList: " ++ input) go
+
+ go = do
+ putStr
+ $ mkDefPrompt "Your choice"
+ $ maybe def (<$> def) modDef
+
+ input <- getLine
+ case def of
+ Just d | null input -> return d
+ _ -> case readMaybe input of
+ Nothing -> invalidChoice input
+ Just n
+ | n > 0, n <= numChoices -> return $ choices !! (n-1)
+ | n == numChoices + 1, hasOther ->
+ promptStr "Please specify" Nothing
+ | otherwise -> invalidChoice (show n)
+
+-- | Create a prompt with an optional default value.
+promptDefault
+ :: Interactive m
+ => (String -> Either String t)
+ -- ^ parser
+ -> (t -> String)
+ -- ^ pretty-printer
+ -> String
+ -- ^ prompt message
+ -> Maybe t
+ -- ^ optional default value
+ -> m t
+promptDefault parse pprint msg def = do
+ putStr $ mkDefPrompt msg (pprint <$> def)
+ input <- getLine
+ case def of
+ Just d | null input -> return d
+ _ -> case parse input of
+ Right t -> return t
+ Left err -> do
+ putStrLn $ "Couldn't parse " ++ input ++ ", please try again!"
+ breakOrContinue
+ ("promptDefault: " ++ err ++ " on input: " ++ input)
+ (promptDefault parse pprint msg def)
+
+-- | Prompt utility for breaking out of an interactive loop
+-- in the pure case
+--
+breakOrContinue :: Interactive m => String -> m a -> m a
+breakOrContinue msg act = break >>= \case
+ True -> throwPrompt $ BreakException msg
+ False -> act
diff --git a/cabal-install/src/Distribution/Client/Init/Simple.hs b/cabal-install/src/Distribution/Client/Init/Simple.hs
new file mode 100644
index 0000000000..d93134e56e
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/Init/Simple.hs
@@ -0,0 +1,138 @@
+module Distribution.Client.Init.Simple
+( -- * Project creation
+ createProject
+ -- * Gen targets
+, genSimplePkgDesc
+, genSimpleLibTarget
+, genSimpleExeTarget
+, genSimpleTestTarget
+) where
+
+
+import Distribution.Client.Init.Types
+import Distribution.Verbosity
+import Distribution.Simple.PackageIndex
+import Distribution.Client.Types.SourcePackageDb (SourcePackageDb(..))
+import qualified Data.List.NonEmpty as NEL
+import Distribution.Client.Init.Utils (currentDirPkgName, mkPackageNameDep)
+import Distribution.Client.Init.Defaults
+import Distribution.Simple.Flag (fromFlagOrDefault, flagElim)
+import Distribution.Client.Init.FlagExtractors
+
+
+createProject
+ :: Interactive m
+ => Verbosity
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> InitFlags
+ -> m ProjectSettings
+createProject v _pkgIx _srcDb initFlags = do
+ pkgType <- packageTypePrompt initFlags
+ isMinimal <- getMinimal initFlags
+ doOverwrite <- getOverwrite initFlags
+ pkgDir <- getPackageDir initFlags
+ pkgDesc <- genSimplePkgDesc initFlags
+
+ let pkgName = _pkgName pkgDesc
+ mkOpts cs = WriteOpts
+ doOverwrite isMinimal cs
+ v pkgDir pkgType pkgName
+
+ case pkgType of
+ Library -> do
+ libTarget <- genSimpleLibTarget initFlags
+ testTarget <- addLibDepToTest pkgName <$> genSimpleTestTarget initFlags
+ return $ ProjectSettings
+ (mkOpts False) pkgDesc
+ (Just libTarget) Nothing testTarget
+
+ Executable -> do
+ exeTarget <- genSimpleExeTarget initFlags
+ return $ ProjectSettings
+ (mkOpts False) pkgDesc
+ Nothing (Just exeTarget) Nothing
+
+ LibraryAndExecutable -> do
+ libTarget <- genSimpleLibTarget initFlags
+ testTarget <- addLibDepToTest pkgName <$> genSimpleTestTarget initFlags
+ exeTarget <- addLibDepToExe pkgName <$> genSimpleExeTarget initFlags
+ return $ ProjectSettings
+ (mkOpts False) pkgDesc
+ (Just libTarget) (Just exeTarget) testTarget
+ where
+ -- Add package name as dependency of test suite
+ --
+ addLibDepToTest _ Nothing = Nothing
+ addLibDepToTest n (Just t) = Just $ t
+ { _testDependencies = _testDependencies t ++ [mkPackageNameDep n]
+ }
+
+ -- Add package name as dependency of executable
+ --
+ addLibDepToExe n exe = exe
+ { _exeDependencies = _exeDependencies exe ++ [mkPackageNameDep n]
+ }
+
+genSimplePkgDesc :: Interactive m => InitFlags -> m PkgDescription
+genSimplePkgDesc flags = mkPkgDesc <$> currentDirPkgName
+ where
+ defaultExtraSrc = defaultChangelog NEL.:| []
+
+ extractExtraSrc [] = defaultExtraSrc
+ extractExtraSrc as = NEL.fromList as
+
+ mkPkgDesc pkgName = PkgDescription
+ (fromFlagOrDefault defaultCabalVersion (cabalVersion flags))
+ pkgName
+ (fromFlagOrDefault defaultVersion (version flags))
+ (fromFlagOrDefault defaultLicense (license flags))
+ (fromFlagOrDefault "" (author flags))
+ (fromFlagOrDefault "" (email flags))
+ (fromFlagOrDefault "" (homepage flags))
+ (fromFlagOrDefault "" (synopsis flags))
+ (fromFlagOrDefault "" (category flags))
+ (flagElim defaultExtraSrc extractExtraSrc (extraSrc flags))
+
+genSimpleLibTarget :: Interactive m => InitFlags -> m LibTarget
+genSimpleLibTarget flags = return $ LibTarget
+ { _libSourceDirs = fromFlagOrDefault [defaultSourceDir] $ sourceDirs flags
+ , _libLanguage = fromFlagOrDefault defaultLanguage $ language flags
+ , _libExposedModules = flagElim (myLibModule NEL.:| []) extractMods $
+ exposedModules flags
+ , _libOtherModules = fromFlagOrDefault [] $ otherModules flags
+ , _libOtherExts = fromFlagOrDefault [] $ otherExts flags
+ , _libDependencies = fromFlagOrDefault [] $ dependencies flags
+ , _libBuildTools= fromFlagOrDefault [] $ buildTools flags
+ }
+
+ where
+ extractMods [] = myLibModule NEL.:| []
+ extractMods as = NEL.fromList as
+
+genSimpleExeTarget :: Interactive m => InitFlags -> m ExeTarget
+genSimpleExeTarget flags = return $ ExeTarget
+ { _exeMainIs = flagElim defaultMainIs toHsFilePath $ mainIs flags
+ , _exeApplicationDirs = fromFlagOrDefault [defaultApplicationDir] $
+ applicationDirs flags
+ , _exeLanguage = fromFlagOrDefault defaultLanguage $ language flags
+ , _exeOtherModules = fromFlagOrDefault [] $ otherModules flags
+ , _exeOtherExts = fromFlagOrDefault [] $ otherExts flags
+ , _exeDependencies = fromFlagOrDefault [] $ dependencies flags
+ , _exeBuildTools = fromFlagOrDefault [] $ buildTools flags
+ }
+
+genSimpleTestTarget :: Interactive m => InitFlags -> m (Maybe TestTarget)
+genSimpleTestTarget flags = go <$> initializeTestSuitePrompt flags
+ where
+ go initialized
+ | not initialized = Nothing
+ | otherwise = Just $ TestTarget
+ { _testMainIs = flagElim defaultMainIs toHsFilePath $ mainIs flags
+ , _testDirs = fromFlagOrDefault [defaultTestDir] $ testDirs flags
+ , _testLanguage = fromFlagOrDefault defaultLanguage $ language flags
+ , _testOtherModules = fromFlagOrDefault [] $ otherModules flags
+ , _testOtherExts = fromFlagOrDefault [] $ otherExts flags
+ , _testDependencies = fromFlagOrDefault [] $ dependencies flags
+ , _testBuildTools = fromFlagOrDefault [] $ buildTools flags
+ }
diff --git a/cabal-install/src/Distribution/Client/Init/Types.hs b/cabal-install/src/Distribution/Client/Init/Types.hs
index e705b7fb35..c80a0f8068 100644
--- a/cabal-install/src/Distribution/Client/Init/Types.hs
+++ b/cabal-install/src/Distribution/Client/Init/Types.hs
@@ -1,6 +1,7 @@
+{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
-
------------------------------------------------------------------------------
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Distribution.Client.Init.Types
-- Copyright : (c) Brent Yorgey, Benedikt Huber 2009
@@ -12,89 +13,107 @@
--
-- Some types used by the 'cabal init' command.
--
------------------------------------------------------------------------------
-module Distribution.Client.Init.Types where
+module Distribution.Client.Init.Types
+( -- * Data
+ InitFlags(..)
+ -- ** Targets and descriptions
+, PkgDescription(..)
+, LibTarget(..)
+, ExeTarget(..)
+, TestTarget(..)
+ -- ** package types
+, PackageType(..)
+ -- ** Main file
+, HsFilePath(..)
+, HsFileType(..)
+, fromHsFilePath
+, toHsFilePath
+, toLiterateHs
+, toStandardHs
+, mkLiterate
+, isHsFilePath
+ -- * Typeclasses
+, Interactive(..)
+, BreakException(..)
+, PurePrompt(..)
+, evalPrompt
+ -- * Aliases
+, IsLiterate
+, IsSimple
+ -- * File creator opts
+, WriteOpts(..)
+, ProjectSettings(..)
+ -- * Formatters
+, FieldAnnotation(..)
+) where
+
-import Distribution.Client.Compat.Prelude
-import Prelude ()
+import qualified Distribution.Client.Compat.Prelude as P
+import Distribution.Client.Compat.Prelude as P hiding (getLine, putStr, putStrLn)
+import Prelude (read)
-import Distribution.Simple.Setup (Flag(..), toFlag )
+import Control.Monad.Catch
+import Data.List.NonEmpty (fromList)
+
+import Distribution.Simple.Setup (Flag(..))
import Distribution.Types.Dependency as P
+import Distribution.Verbosity (silent)
import Distribution.Version
-import Distribution.Verbosity
import qualified Distribution.Package as P
import Distribution.SPDX.License (License)
import Distribution.ModuleName
import Distribution.CabalSpecVersion
+import Distribution.Client.Utils as P
import Language.Haskell.Extension ( Language(..), Extension )
-import qualified Text.PrettyPrint as Disp
-import qualified Distribution.Compat.CharParsing as P
-import qualified Data.Map as Map
+import qualified System.Directory as P
+import qualified System.Process as P
+import qualified Distribution.Compat.Environment as P
+import System.FilePath
--- | InitFlags is really just a simple type to represent certain
--- portions of a .cabal file. Rather than have a flag for EVERY
--- possible field, we just have one for each field that the user is
--- likely to want and/or that we are likely to be able to
--- intelligently guess.
-data InitFlags =
- InitFlags { interactive :: Flag Bool
- , quiet :: Flag Bool
- , packageDir :: Flag FilePath
- , noComments :: Flag Bool
- , minimal :: Flag Bool
- , simpleProject :: Flag Bool
-
- , packageName :: Flag P.PackageName
- , version :: Flag Version
- , cabalVersion :: Flag CabalSpecVersion
- , license :: Flag License
- , author :: Flag String
- , email :: Flag String
- , homepage :: Flag String
-
- , synopsis :: Flag String
- , category :: Flag (Either String Category)
- , extraSrc :: Maybe [String]
-
- , packageType :: Flag PackageType
- , mainIs :: Flag FilePath
- , language :: Flag Language
-
- , exposedModules :: Maybe [ModuleName]
- , otherModules :: Maybe [ModuleName]
- , otherExts :: Maybe [Extension]
-
- , dependencies :: Maybe [P.Dependency]
- , applicationDirs :: Maybe [String]
- , sourceDirs :: Maybe [String]
- , buildTools :: Maybe [String]
-
- , initializeTestSuite :: Flag Bool
- , testDirs :: Maybe [String]
-
- , initHcPath :: Flag FilePath
-
- , initVerbosity :: Flag Verbosity
- , overwrite :: Flag Bool
- }
- deriving (Eq, Show, Generic)
-
- -- the Monoid instance for Flag has later values override earlier
- -- ones, which is why we want Maybe [foo] for collecting foo values,
- -- not Flag [foo].
-
-data BuildType = LibBuild | ExecBuild
- deriving Eq
-
--- The type of package to initialize.
-data PackageType = Library | Executable | LibraryAndExecutable
- deriving (Show, Read, Eq)
-displayPackageType :: PackageType -> String
-displayPackageType LibraryAndExecutable = "Library and Executable"
-displayPackageType pkgtype = show pkgtype
+-- -------------------------------------------------------------------- --
+-- Flags
+
+-- | InitFlags is a subset of flags available in the
+-- @.cabal@ file that represent options that are relevant to the
+-- init command process.
+--
+data InitFlags =
+ InitFlags
+ { interactive :: Flag Bool
+ , quiet :: Flag Bool
+ , packageDir :: Flag FilePath
+ , noComments :: Flag Bool
+ , minimal :: Flag Bool
+ , simpleProject :: Flag Bool
+ , packageName :: Flag P.PackageName
+ , version :: Flag Version
+ , cabalVersion :: Flag CabalSpecVersion
+ , license :: Flag License
+ , author :: Flag String
+ , email :: Flag String
+ , homepage :: Flag String
+ , synopsis :: Flag String
+ , category :: Flag String
+ , extraSrc :: Flag [String]
+ , packageType :: Flag PackageType
+ , mainIs :: Flag FilePath
+ , language :: Flag Language
+ , exposedModules :: Flag [ModuleName]
+ , otherModules :: Flag [ModuleName]
+ , otherExts :: Flag [Extension]
+ , dependencies :: Flag [P.Dependency]
+ , applicationDirs :: Flag [String]
+ , sourceDirs :: Flag [String]
+ , buildTools :: Flag [String]
+ , initializeTestSuite :: Flag Bool
+ , testDirs :: Flag [String]
+ , initHcPath :: Flag FilePath
+ , initVerbosity :: Flag Verbosity
+ , overwrite :: Flag Bool
+ } deriving (Eq, Show, Generic)
instance Monoid InitFlags where
mempty = gmempty
@@ -103,40 +122,310 @@ instance Monoid InitFlags where
instance Semigroup InitFlags where
(<>) = gmappend
-defaultInitFlags :: InitFlags
-defaultInitFlags = mempty
- { initVerbosity = toFlag normal
- }
-
--- | Some common package categories (non-exhaustive list).
-data Category
- = Codec
- | Concurrency
- | Control
- | Data
- | Database
- | Development
- | Distribution
- | Game
- | Graphics
- | Language
- | Math
- | Network
- | Sound
- | System
- | Testing
- | Text
- | Web
- deriving (Read, Show, Eq, Ord, Bounded, Enum)
-
-instance Pretty Category where
- pretty = Disp.text . show
-
-instance Parsec Category where
- parsec = do
- name <- P.munch1 isAlpha
- case Map.lookup name names of
- Just cat -> pure cat
- _ -> P.unexpected $ "Category: " ++ name
+-- -------------------------------------------------------------------- --
+-- Targets
+
+-- | 'PkgDescription' represents the relevant options set by the
+-- user when building a package description during the init command
+-- process.
+--
+data PkgDescription = PkgDescription
+ { _pkgCabalVersion :: CabalSpecVersion
+ , _pkgName :: P.PackageName
+ , _pkgVersion :: Version
+ , _pkgLicense :: License
+ , _pkgAuthor :: String
+ , _pkgEmail :: String
+ , _pkgHomePage :: String
+ , _pkgSynopsis :: String
+ , _pkgCategory :: String
+ , _pkgExtraSrcFiles :: NonEmpty String
+ } deriving (Show, Eq)
+
+-- | 'LibTarget' represents the relevant options set by the
+-- user when building a library package during the init command
+-- process.
+--
+data LibTarget = LibTarget
+ { _libSourceDirs :: [String]
+ , _libLanguage :: Language
+ , _libExposedModules :: NonEmpty ModuleName
+ , _libOtherModules :: [ModuleName]
+ , _libOtherExts :: [Extension]
+ , _libDependencies :: [P.Dependency]
+ , _libBuildTools :: [String]
+ } deriving (Show, Eq)
+
+-- | 'ExeTarget' represents the relevant options set by the
+-- user when building an executable package.
+--
+data ExeTarget = ExeTarget
+ { _exeMainIs :: HsFilePath
+ , _exeApplicationDirs :: [String]
+ , _exeLanguage :: Language
+ , _exeOtherModules :: [ModuleName]
+ , _exeOtherExts :: [Extension]
+ , _exeDependencies :: [P.Dependency]
+ , _exeBuildTools :: [String]
+ } deriving (Show, Eq)
+
+-- | 'TestTarget' represents the relevant options set by the
+-- user when building a library package.
+--
+data TestTarget = TestTarget
+ { _testMainIs :: HsFilePath
+ , _testDirs :: [String]
+ , _testLanguage :: Language
+ , _testOtherModules :: [ModuleName]
+ , _testOtherExts :: [Extension]
+ , _testDependencies :: [P.Dependency]
+ , _testBuildTools :: [String]
+ } deriving (Show, Eq)
+
+-- -------------------------------------------------------------------- --
+-- File creator options
+
+data WriteOpts = WriteOpts
+ { _optOverwrite :: Bool
+ , _optMinimal :: Bool
+ , _optNoComments :: Bool
+ , _optVerbosity :: Verbosity
+ , _optPkgDir :: FilePath
+ , _optPkgType :: PackageType
+ , _optPkgName :: P.PackageName
+ } deriving (Eq, Show)
+
+data ProjectSettings = ProjectSettings
+ { _pkgOpts :: WriteOpts
+ , _pkgDesc :: PkgDescription
+ , _pkgLibTarget :: Maybe LibTarget
+ , _pkgExeTarget :: Maybe ExeTarget
+ , _pkgTestTarget :: Maybe TestTarget
+ } deriving (Eq, Show)
+
+-- -------------------------------------------------------------------- --
+-- Other types
+
+-- | Enum to denote whether the user wants to build a library target,
+-- executable target, or library and executable targets.
+--
+data PackageType = Library | Executable | LibraryAndExecutable
+ deriving (Eq, Show, Generic)
+
+data HsFileType
+ = Literate
+ | Standard
+ | InvalidHsPath
+ deriving (Eq, Show)
+
+data HsFilePath = HsFilePath
+ { _hsFilePath :: FilePath
+ , _hsFileType :: HsFileType
+ } deriving Eq
+
+instance Show HsFilePath where
+ show (HsFilePath fp ty) = case ty of
+ Literate -> fp
+ Standard -> fp
+ InvalidHsPath -> "Invalid haskell source file: " ++ fp
+
+fromHsFilePath :: HsFilePath -> Maybe FilePath
+fromHsFilePath (HsFilePath fp ty) = case ty of
+ Literate -> Just fp
+ Standard -> Just fp
+ InvalidHsPath -> Nothing
+
+isHsFilePath :: FilePath -> Bool
+isHsFilePath fp = case _hsFileType $ toHsFilePath fp of
+ InvalidHsPath -> False
+ _ -> True
+
+toHsFilePath :: FilePath -> HsFilePath
+toHsFilePath fp
+ | takeExtension fp == ".lhs" = HsFilePath fp Literate
+ | takeExtension fp == ".hs" = HsFilePath fp Standard
+ | otherwise = HsFilePath fp InvalidHsPath
+
+toLiterateHs :: HsFilePath -> HsFilePath
+toLiterateHs (HsFilePath fp Standard) = HsFilePath
+ (dropExtension fp ++ ".lhs")
+ Literate
+toLiterateHs a = a
+
+toStandardHs :: HsFilePath -> HsFilePath
+toStandardHs (HsFilePath fp Literate) = HsFilePath
+ (dropExtension fp ++ ".hs")
+ Standard
+toStandardHs a = a
+
+mkLiterate :: HsFilePath -> [String] -> [String]
+mkLiterate (HsFilePath _ Literate) hs =
+ (\line -> if null line then line else "> " ++ line) <$> hs
+mkLiterate _ hs = hs
+
+-- -------------------------------------------------------------------- --
+-- Interactive prompt monad
+
+newtype PurePrompt a = PurePrompt
+ { _runPrompt
+ :: NonEmpty String
+ -> Either BreakException (a, NonEmpty String)
+ } deriving (Functor)
+
+evalPrompt :: PurePrompt a -> NonEmpty String -> a
+evalPrompt act s = case _runPrompt act s of
+ Left e -> error $ show e
+ Right (a,_) -> a
+
+instance Applicative PurePrompt where
+ pure a = PurePrompt $ \s -> Right (a, s)
+ PurePrompt ff <*> PurePrompt aa = PurePrompt $ \s -> case ff s of
+ Left e -> Left e
+ Right (f, s') -> case aa s' of
+ Left e -> Left e
+ Right (a, s'') -> Right (f a, s'')
+
+instance Monad PurePrompt where
+ return = pure
+ PurePrompt a >>= k = PurePrompt $ \s -> case a s of
+ Left e -> Left e
+ Right (a', s') -> _runPrompt (k a') s'
+
+class Monad m => Interactive m where
+ -- input functions
+ getLine :: m String
+ readFile :: FilePath -> m String
+ getCurrentDirectory :: m FilePath
+ getHomeDirectory :: m FilePath
+ getDirectoryContents :: FilePath -> m [FilePath]
+ listDirectory :: FilePath -> m [FilePath]
+ doesDirectoryExist :: FilePath -> m Bool
+ doesFileExist :: FilePath -> m Bool
+ tryCanonicalizePath :: FilePath -> m FilePath
+ readProcessWithExitCode :: FilePath -> [String] -> String -> m (ExitCode, String, String)
+ getEnvironment :: m [(String, String)]
+ listFilesInside :: (FilePath -> m Bool) -> FilePath -> m [FilePath]
+ listFilesRecursive :: FilePath -> m [FilePath]
+
+ -- output functions
+ putStr :: String -> m ()
+ putStrLn :: String -> m ()
+ createDirectory :: FilePath -> m ()
+ writeFile :: FilePath -> String -> m ()
+ copyFile :: FilePath -> FilePath -> m ()
+ renameDirectory :: FilePath -> FilePath -> m ()
+ message :: Verbosity -> String -> m ()
+
+ -- misc functions
+ break :: m Bool
+ throwPrompt :: BreakException -> m a
+
+instance Interactive IO where
+ getLine = P.getLine
+ readFile = P.readFile
+ getCurrentDirectory = P.getCurrentDirectory
+ getHomeDirectory = P.getHomeDirectory
+ getDirectoryContents = P.getDirectoryContents
+ listDirectory = P.listDirectory
+ doesDirectoryExist = P.doesDirectoryExist
+ doesFileExist = P.doesFileExist
+ tryCanonicalizePath = P.tryCanonicalizePath
+ readProcessWithExitCode = P.readProcessWithExitCode
+ getEnvironment = P.getEnvironment
+ listFilesInside = P.listFilesInside
+ listFilesRecursive = P.listFilesRecursive
+
+ putStr = P.putStr
+ putStrLn = P.putStrLn
+ createDirectory = P.createDirectory
+ writeFile = P.writeFile
+ copyFile = P.copyFile
+ renameDirectory = P.renameDirectory
+ message q = unless (q == silent) . putStrLn
+
+ break = return False
+ throwPrompt = throwM
+
+instance Interactive PurePrompt where
+ getLine = pop
+ readFile !_ = pop
+ getCurrentDirectory = popAbsolute
+ getHomeDirectory = popAbsolute
+ -- expects stack input of form "[\"foo\", \"bar\", \"baz\"]"
+ getDirectoryContents !_ = popList
+ listDirectory !_ = popList
+ doesDirectoryExist !_ = popBool
+ doesFileExist !_ = popBool
+ tryCanonicalizePath !_ = popAbsolute
+ readProcessWithExitCode !_ !_ !_ = do
+ input <- pop
+ return (ExitSuccess, input, "")
+ getEnvironment = fmap (map read) popList
+ listFilesInside pred' !_ = do
+ input <- map splitDirectories <$> popList
+ map joinPath <$> filterM (fmap and . traverse pred') input
+ listFilesRecursive !_ = popList
+
+ putStr !_ = return ()
+ putStrLn !_ = return ()
+ createDirectory !_ = return ()
+ writeFile !_ !_ = return ()
+ copyFile !_ !_ = return ()
+ renameDirectory !_ !_ = return ()
+ message !_ !_ = return ()
+
+ break = return True
+ throwPrompt (BreakException e) = PurePrompt $ \s -> Left $ BreakException
+ ("Error: " ++ e ++ "\nStacktrace: " ++ show s)
+
+pop :: PurePrompt String
+pop = PurePrompt $ \ (p:|ps) -> Right (p,fromList ps)
+
+popAbsolute :: PurePrompt String
+popAbsolute = do
+ input <- pop
+ return $ "/home/test/" ++ input
+
+popBool :: PurePrompt Bool
+popBool = pop >>= \case
+ "True" -> pure True
+ "False" -> pure False
+ s -> throwPrompt $ BreakException $ "popBool: " ++ s
+
+popList :: PurePrompt [String]
+popList = pop >>= \a -> case safeRead a of
+ Nothing -> throwPrompt $ BreakException ("popList: " ++ show a)
+ Just as -> return as
where
- names = Map.fromList [ (show cat, cat) | cat <- [ minBound .. maxBound ] ]
+ safeRead s
+ | [(x, "")] <- reads s = Just x
+ | otherwise = Nothing
+
+-- | A pure exception thrown exclusively by the pure prompter
+-- to cancel infinite loops in the prompting process.
+--
+-- For example, in order to break on parse errors, or user-driven
+-- continuations that do not make sense to test.
+--
+newtype BreakException = BreakException String deriving (Eq, Show)
+
+instance Exception BreakException
+
+-- | Convenience alias for the literate haskell flag
+--
+type IsLiterate = Bool
+
+-- | Convenience alias for generating simple projects
+--
+type IsSimple = Bool
+
+-- -------------------------------------------------------------------- --
+-- Field annotation for pretty formatters
+
+-- | Annotations for cabal file PrettyField.
+data FieldAnnotation = FieldAnnotation
+ { annCommentedOut :: Bool
+ -- ^ True iif the field and its contents should be commented out.
+ , annCommentLines :: [String]
+ -- ^ Comment lines to place before the field or section.
+ }
diff --git a/cabal-install/src/Distribution/Client/Init/Utils.hs b/cabal-install/src/Distribution/Client/Init/Utils.hs
index a3cfe06fe4..0ac8f2f8cf 100644
--- a/cabal-install/src/Distribution/Client/Init/Utils.hs
+++ b/cabal-install/src/Distribution/Client/Init/Utils.hs
@@ -1,38 +1,265 @@
------------------------------------------------------------------------------
--- |
--- Module : Distribution.Client.Init.Utils
--- Copyright : (c) Brent Yorgey 2009
--- License : BSD-like
---
--- Maintainer : cabal-devel@haskell.org
--- Stability : provisional
--- Portability : portable
+{-# LANGUAGE RecordWildCards #-}
+
+module Distribution.Client.Init.Utils
+( SourceFileEntry(..)
+, retrieveSourceFiles
+, retrieveModuleName
+, retrieveModuleImports
+, retrieveModuleExtensions
+, retrieveBuildTools
+, retrieveDependencies
+, isMain
+, isHaskell
+, isSourceFile
+, versionParser
+, trim
+, currentDirPkgName
+, filePathToPkgName
+, mkPackageNameDep
+) where
+
+
+import qualified Prelude
+import Distribution.Client.Compat.Prelude hiding (empty, readFile, Parsec, many)
+import Distribution.Utils.Generic (isInfixOf)
+
+import Control.Monad (forM)
+
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map as M
+import Language.Haskell.Extension (Extension(..))
+import System.FilePath
+
+import Distribution.CabalSpecVersion (CabalSpecVersion(..))
+import Distribution.ModuleName (ModuleName)
+import Distribution.InstalledPackageInfo (InstalledPackageInfo, exposed)
+import qualified Distribution.Package as P
+import qualified Distribution.Types.PackageName as PN
+import Distribution.Simple.PackageIndex (InstalledPackageIndex, moduleNameIndex)
+import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault)
+import Distribution.Verbosity
+import Distribution.Version
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Types
+import Text.Parsec
+import Distribution.Types.PackageName
+import Distribution.Types.Dependency (Dependency, mkDependency)
+import qualified Distribution.Compat.NonEmptySet as NES
+import Distribution.Types.LibraryName
+
+
+-- |Data type of source files found in the working directory
+data SourceFileEntry = SourceFileEntry
+ { relativeSourcePath :: FilePath
+ , moduleName :: ModuleName
+ , fileExtension :: String
+ , imports :: [ModuleName]
+ , extensions :: [Extension]
+ } deriving Show
+
+-- Unfortunately we cannot use the version exported by Distribution.Simple.Program
+knownSuffixHandlers :: String -> String
+knownSuffixHandlers ".gc" = "greencard"
+knownSuffixHandlers ".chs" = "chs"
+knownSuffixHandlers ".hsc" = "hsc2hs"
+knownSuffixHandlers ".x" = "alex"
+knownSuffixHandlers ".y" = "happy"
+knownSuffixHandlers ".ly" = "happy"
+knownSuffixHandlers ".cpphs" = "cpp"
+knownSuffixHandlers _ = ""
+
+
+-- | Check if a given file has main file characteristics
+isMain :: String -> Bool
+isMain f = (isInfixOf "Main" f || isInfixOf "main" f)
+ && isSuffixOf ".hs" f || isSuffixOf ".lhs" f
+
+-- | Check if a given file has a Haskell extension
+isHaskell :: String -> Bool
+isHaskell f = isSuffixOf ".hs" f || isSuffixOf ".lhs" f
+
+isBuildTool :: String -> Bool
+isBuildTool f = not . null . knownSuffixHandlers $ takeExtension f
+
+retrieveBuildTools :: Interactive m => FilePath -> m [String]
+retrieveBuildTools fp = do
+ files <- map takeExtension <$> listFilesRecursive fp
+
+ return [knownSuffixHandlers f | f <- files, isBuildTool f]
+
+retrieveSourceFiles :: Interactive m => FilePath -> m [SourceFileEntry]
+retrieveSourceFiles fp = do
+ files <- filter isHaskell <$> listFilesRecursive fp
+
+ forM files $ \f -> do
+ let fileExtension = takeExtension f
+ relativeSourcePath <- makeRelative f <$> getCurrentDirectory
+ moduleName <- retrieveModuleName f
+ imports <- retrieveModuleImports f
+ extensions <- retrieveModuleExtensions f
+
+ return $ SourceFileEntry {..}
+
+-- | Given a module, retrieve its name
+retrieveModuleName :: Interactive m => FilePath -> m ModuleName
+retrieveModuleName m = do
+ fromString . trim . grabModuleName <$> readFile m
+
+ where
+ stop c = (c /= '\\') && (c /= ' ')
+
+ grabModuleName [] = []
+ grabModuleName ('m':'o':'d':'u':'l':'e':' ':xs) = takeWhile' stop xs
+ grabModuleName (_:xs) = grabModuleName xs
+
+-- | Given a module, retrieve all of its imports
+retrieveModuleImports :: Interactive m => FilePath -> m [ModuleName]
+retrieveModuleImports m = do
+ map (fromString . trim) . grabModuleImports <$> readFile m
+
+ where
+ stop c = (c /= '\\') && (c /= ' ') && (c /= '(')
+
+ grabModuleImports [] = []
+ grabModuleImports ('i':'m':'p':'o':'r':'t':' ':xs) = case trim xs of -- in case someone uses a weird formatting
+ ('q':'u':'a':'l':'i':'f':'i':'e':'d':' ':ys) -> takeWhile' stop ys : grabModuleImports (dropWhile' stop ys)
+ _ -> takeWhile' stop xs : grabModuleImports (dropWhile' stop xs)
+ grabModuleImports (_:xs) = grabModuleImports xs
+
+-- | Given a module, retrieve all of its language pragmas
+retrieveModuleExtensions :: Interactive m => FilePath -> m [Extension]
+retrieveModuleExtensions m = do
+ catMaybes <$> map (simpleParsec . trim) . grabModuleExtensions <$> readFile m
+
+ where
+ stop c = (c /= '\\') && (c /= ' ') && (c /= ',')
+
+ grabModuleExtensions [] = []
+ grabModuleExtensions ('L':'A':'N':'G':'U':'A':'G':'E':' ':xs) = takeWhile' stop xs : grabModuleExtensions (dropWhile' stop xs)
+ grabModuleExtensions (',':xs) = takeWhile' stop xs : grabModuleExtensions (dropWhile' stop xs)
+ grabModuleExtensions (_:xs) = grabModuleExtensions xs
+
+takeWhile' :: (Char -> Bool) -> String -> String
+takeWhile' p = takeWhile p . trim
+
+dropWhile' :: (Char -> Bool) -> String -> String
+dropWhile' p = dropWhile p . trim
+
+trim :: String -> String
+trim = removeLeadingSpace . reverse . removeLeadingSpace . reverse
+ where
+ removeLeadingSpace = dropWhile isSpace
+
+-- | Check whether a potential source file is located in one of the
+-- source directories.
+isSourceFile :: Maybe [FilePath] -> SourceFileEntry -> Bool
+isSourceFile Nothing sf = isSourceFile (Just ["."]) sf
+isSourceFile (Just srcDirs) sf = any (equalFilePath (relativeSourcePath sf)) srcDirs
+
+retrieveDependencies :: Interactive m => InitFlags -> [ModuleName] -> InstalledPackageIndex -> m [P.Dependency]
+retrieveDependencies flags mods' pkgIx = do
+ let mods = mods'
+
+ modMap :: M.Map ModuleName [InstalledPackageInfo]
+ modMap = M.map (filter exposed) $ moduleNameIndex pkgIx
+
+ modDeps :: [(ModuleName, Maybe [InstalledPackageInfo])]
+ modDeps = map (\mn -> (mn, M.lookup mn modMap)) mods
+ -- modDeps = map (id &&& flip M.lookup modMap) mods
+
+ message (fromFlagOrDefault silent $ initVerbosity flags) "\nGuessing dependencies..."
+ nub . catMaybes <$> traverse (chooseDep flags) modDeps
+
+-- Given a module and a list of installed packages providing it,
+-- choose a dependency (i.e. package + version range) to use for that
+-- module.
+chooseDep
+ :: Interactive m
+ => InitFlags
+ -> (ModuleName, Maybe [InstalledPackageInfo])
+ -> m (Maybe P.Dependency)
+chooseDep flags (m, mipi) = case mipi of
+ -- We found some packages: group them by name.
+ Just ps@(_:_) ->
+ case NE.groupBy (\x y -> P.pkgName x == P.pkgName y) $ map P.packageId ps of
+ -- if there's only one group, i.e. multiple versions of a single package,
+ -- we make it into a dependency, choosing the latest-ish version.
+
+ -- Given a list of available versions of the same package, pick a dependency.
+ [grp] -> fmap Just $ case grp of
+
+ -- If only one version, easy. We change e.g. 0.4.2 into 0.4.*
+ (pid:|[]) ->
+ return $ P.Dependency
+ (P.pkgName pid)
+ (pvpize desugar . P.pkgVersion $ pid)
+ P.mainLibSet --TODO sublibraries
+
+ -- Otherwise, choose the latest version and issue a warning.
+ pids -> do
+ message v ("\nWarning: multiple versions of " ++ prettyShow (P.pkgName . NE.head $ pids) ++ " provide " ++ prettyShow m ++ ", choosing the latest.")
+ return $ P.Dependency
+ (P.pkgName . NE.head $ pids)
+ (pvpize desugar . maximum . fmap P.pkgVersion $ pids)
+ P.mainLibSet --TODO take into account sublibraries
+
+ -- if multiple packages are found, we refuse to choose between
+ -- different packages and make the user do it
+ grps -> do
+ message v ("\nWarning: multiple packages found providing " ++ prettyShow m ++ ": " ++ intercalate ", " (fmap (prettyShow . P.pkgName . NE.head) grps))
+ message v "You will need to pick one and manually add it to the build-depends field."
+ return Nothing
+
+ _ -> do
+ message v ("\nWarning: no package found providing " ++ prettyShow m ++ ".")
+ return Nothing
+
+ where
+ v = fromFlagOrDefault normal (initVerbosity flags)
+
+ -- desugar if cabal version lower than 2.0
+ desugar = case cabalVersion flags of
+ Flag x -> x < CabalSpecV2_0
+ NoFlag -> defaultCabalVersion < CabalSpecV2_0
+
+-- | Given a version, return an API-compatible (according to PVP) version range.
--
--- Shared utilities used by multiple cabal init modules.
+-- If the boolean argument denotes whether to use a desugared
+-- representation (if 'True') or the new-style @^>=@-form (if
+-- 'False').
--
------------------------------------------------------------------------------
+-- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the
+-- same as @0.4.*@).
+pvpize :: Bool -> Version -> VersionRange
+pvpize False v = majorBoundVersion v
+pvpize True v = orLaterVersion v'
+ `intersectVersionRanges`
+ earlierVersion (incVersion 1 v')
+ where
+ v' = alterVersion (take 2) v
-module Distribution.Client.Init.Utils (
- eligibleForTestSuite
- , message
- ) where
+ -- Increment the nth version component (counting from 0).
+ incVersion :: Int -> Version -> Version
+ incVersion n = alterVersion (incVersion' n)
+ where
+ incVersion' 0 [] = [1]
+ incVersion' 0 (v'':_) = [v'' + 1]
+ incVersion' m [] = replicate m 0 ++ [1]
+ incVersion' m (v'':vs) = v'' : incVersion' (m-1) vs
-import Distribution.Solver.Compat.Prelude
-import Prelude ()
+versionParser :: Parsec String () String
+versionParser = do
+ skipMany (noneOf "1234567890")
+ many $ choice
+ [ oneOf "1234567890"
+ , oneOf "."
+ ]
-import Distribution.Simple.Setup
- ( Flag(..) )
-import Distribution.Client.Init.Types
- ( InitFlags(..), PackageType(..) )
-
--- | Returns true if this package is eligible for test suite initialization.
-eligibleForTestSuite :: InitFlags -> Bool
-eligibleForTestSuite flags =
- Flag True == initializeTestSuite flags
- && Flag Executable /= packageType flags
-
--- | Possibly generate a message to stdout, taking into account the
--- --quiet flag.
-message :: InitFlags -> String -> IO ()
-message (InitFlags{quiet = Flag True}) _ = return ()
-message _ s = putStrLn s
+filePathToPkgName :: FilePath -> P.PackageName
+filePathToPkgName = PN.mkPackageName . Prelude.last . splitDirectories
+
+currentDirPkgName :: Interactive m => m P.PackageName
+currentDirPkgName = filePathToPkgName <$> getCurrentDirectory
+
+mkPackageNameDep :: PackageName -> Dependency
+mkPackageNameDep pkg = mkDependency pkg anyVersion (NES.singleton LMainLibName)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 445bf48e42..b7cd679388 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -84,7 +84,7 @@ import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.Dependency
import Distribution.Client.Dependency.Types
import qualified Distribution.Client.IndexUtils as IndexUtils
-import Distribution.Client.Init (incVersion)
+import Distribution.Client.Utils (incVersion)
import Distribution.Client.Targets (userToPackageConstraint)
import Distribution.Client.DistDirLayout
import Distribution.Client.SetupWrapper
@@ -1758,7 +1758,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
-- package needs to be rebuilt. (It needs to be done here,
-- because the ElaboratedConfiguredPackage is where we test
-- whether or not there have been changes.)
- TestStanzas -> listToMaybe [ v | v <- maybeToList tests, _ <- PD.testSuites elabPkgDescription ]
+ TestStanzas -> listToMaybe [ v | v <- maybeToList tests, _ <- PD.testSuites elabPkgDescription ]
BenchStanzas -> listToMaybe [ v | v <- maybeToList benchmarks, _ <- PD.benchmarks elabPkgDescription ]
where
tests, benchmarks :: Maybe Bool
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index 59a04be473..32c875c09a 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -71,7 +71,7 @@ import Distribution.Client.IndexUtils.ActiveRepos
import Distribution.Client.IndexUtils.IndexState
( TotalIndexState, headTotalIndexState )
import qualified Distribution.Client.Init.Types as IT
- ( InitFlags(..), PackageType(..), defaultInitFlags )
+import qualified Distribution.Client.Init.Defaults as IT
import Distribution.Client.Targets
( UserConstraint, readUserConstraint )
import Distribution.Utils.NubList
@@ -2215,14 +2215,13 @@ initOptions _ =
, option ['c'] ["category"]
"Project category."
IT.category (\v flags -> flags { IT.category = v })
- (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s))
- (flagToList . fmap (either id show)))
+ (reqArgFlag "CATEGORY")
, option ['x'] ["extra-source-file"]
"Extra source file to be distributed with tarball."
IT.extraSrc (\v flags -> flags { IT.extraSrc = v })
- (reqArg' "FILE" (Just . (:[]))
- (fromMaybe []))
+ (reqArg' "FILE" (Flag . (:[]))
+ (fromFlagOrDefault []))
, option [] ["lib", "is-library"]
"Build a library."
@@ -2250,8 +2249,8 @@ initOptions _ =
, option [] ["test-dir"]
"Directory containing tests."
IT.testDirs (\v flags -> flags { IT.testDirs = v })
- (reqArg' "DIR" (Just . (:[]))
- (fromMaybe []))
+ (reqArg' "DIR" (Flag . (:[]))
+ (fromFlagOrDefault []))
, option [] ["simple"]
"Create a simple project with sensible defaults."
@@ -2278,41 +2277,41 @@ initOptions _ =
IT.exposedModules
(\v flags -> flags { IT.exposedModules = v })
(reqArg "MODULE" (parsecToReadE ("Cannot parse module name: "++)
- ((Just . (:[])) `fmap` parsec))
- (maybe [] (fmap prettyShow)))
+ (Flag . (:[]) <$> parsec))
+ (flagElim [] (fmap prettyShow)))
, option [] ["extension"]
"Use a LANGUAGE extension (in the other-extensions field)."
IT.otherExts
(\v flags -> flags { IT.otherExts = v })
(reqArg "EXTENSION" (parsecToReadE ("Cannot parse extension: "++)
- ((Just . (:[])) `fmap` parsec))
- (maybe [] (fmap prettyShow)))
+ (Flag . (:[]) <$> parsec))
+ (flagElim [] (fmap prettyShow)))
, option ['d'] ["dependency"]
"Package dependency."
IT.dependencies (\v flags -> flags { IT.dependencies = v })
(reqArg "PACKAGE" (parsecToReadE ("Cannot parse dependency: "++)
- ((Just . (:[])) `fmap` parsec))
- (maybe [] (fmap prettyShow)))
+ (Flag . (:[]) <$> parsec))
+ (flagElim [] (fmap prettyShow)))
, option [] ["application-dir"]
"Directory containing package application executable."
IT.applicationDirs (\v flags -> flags { IT.applicationDirs = v})
- (reqArg' "DIR" (Just . (:[]))
- (fromMaybe []))
+ (reqArg' "DIR" (Flag . (:[]))
+ (fromFlagOrDefault []))
, option [] ["source-dir", "sourcedir"]
"Directory containing package library source."
IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v })
- (reqArg' "DIR" (Just . (:[]))
- (fromMaybe []))
+ (reqArg' "DIR" (Flag. (:[]))
+ (fromFlagOrDefault []))
, option [] ["build-tool"]
"Required external build tool."
IT.buildTools (\v flags -> flags { IT.buildTools = v })
- (reqArg' "TOOL" (Just . (:[]))
- (fromMaybe []))
+ (reqArg' "TOOL" (Flag . (:[]))
+ (fromFlagOrDefault []))
-- NB: this is a bit of a transitional hack and will likely be
-- removed again if `cabal init` is migrated to the v2-* command
diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs
index c52eee302e..9803a55d46 100644
--- a/cabal-install/src/Distribution/Client/Utils.hs
+++ b/cabal-install/src/Distribution/Client/Utils.hs
@@ -1,27 +1,33 @@
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
-module Distribution.Client.Utils ( MergeResult(..)
- , mergeBy, duplicates, duplicatesBy
- , readMaybe
- , inDir, withEnv, withEnvOverrides
- , logDirChange, withExtraPathEnv
- , determineNumJobs, numberOfProcessors
- , removeExistingFile
- , withTempFileName
- , makeAbsoluteToCwd
- , makeRelativeToCwd, makeRelativeToDir
- , makeRelativeCanonical
- , filePathToByteString
- , byteStringToFilePath, tryCanonicalizePath
- , canonicalizePathNoThrow
- , moreRecentFile, existsAndIsMoreRecentThan
- , tryFindAddSourcePackageDesc
- , tryFindPackageDesc
- , relaxEncodingErrors
- , ProgressPhase (..)
- , progressMessage
- , cabalInstallVersion)
- where
+module Distribution.Client.Utils
+ ( MergeResult(..)
+ , mergeBy, duplicates, duplicatesBy
+ , readMaybe
+ , inDir, withEnv, withEnvOverrides
+ , logDirChange, withExtraPathEnv
+ , determineNumJobs, numberOfProcessors
+ , removeExistingFile
+ , withTempFileName
+ , makeAbsoluteToCwd
+ , makeRelativeToCwd, makeRelativeToDir
+ , makeRelativeCanonical
+ , filePathToByteString
+ , byteStringToFilePath, tryCanonicalizePath
+ , canonicalizePathNoThrow
+ , moreRecentFile, existsAndIsMoreRecentThan
+ , tryFindAddSourcePackageDesc
+ , tryFindPackageDesc
+ , relaxEncodingErrors
+ , ProgressPhase (..)
+ , progressMessage
+ , cabalInstallVersion
+ , pvpize
+ , incVersion
+ , getCurrentYear
+ , listFilesRecursive
+ , listFilesInside
+ ) where
import Prelude ()
import Distribution.Client.Compat.Prelude
@@ -44,7 +50,7 @@ import qualified Control.Exception as Exception
( finally, bracket )
import System.Directory
( canonicalizePath, doesFileExist, getCurrentDirectory
- , removeFile, setCurrentDirectory )
+ , removeFile, setCurrentDirectory, getDirectoryContents, doesDirectoryExist )
import System.IO
( Handle, hClose, openTempFile
, hGetEncoding, hSetEncoding
@@ -55,14 +61,16 @@ import GHC.IO.Encoding
( recover, TextEncoding(TextEncoding) )
import GHC.IO.Encoding.Failure
( recoverEncode, CodingFailureMode(TransliterateCodingFailure) )
-
+import Data.Time.Clock.POSIX (getCurrentTime)
+import Data.Time.LocalTime (getCurrentTimeZone, localDay)
+import Data.Time (utcToLocalTime)
+import Data.Time.Calendar (toGregorian)
#if defined(mingw32_HOST_OS) || MIN_VERSION_directory(1,2,3)
import qualified System.Directory as Dir
import qualified System.IO.Error as IOError
#endif
-
-- | Generic merging utility. For sorted input lists this is a full outer join.
--
mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
@@ -359,5 +367,86 @@ progressMessage verbosity phase subject = do
ProgressInstalling -> "Installing "
ProgressCompleted -> "Completed "
+-- TODO: write a test around this. Don't abuse Paths_cabal_install.
+--
cabalInstallVersion :: Version
cabalInstallVersion = mkVersion [3,5]
+
+-- | Given a version, return an API-compatible (according to PVP) version range.
+--
+-- If the boolean argument denotes whether to use a desugared
+-- representation (if 'True') or the new-style @^>=@-form (if
+-- 'False').
+--
+-- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the
+-- same as @0.4.*@).
+pvpize :: Bool -> Version -> VersionRange
+pvpize False v = majorBoundVersion v
+pvpize True v = orLaterVersion v'
+ `intersectVersionRanges`
+ earlierVersion (incVersion 1 v')
+ where v' = alterVersion (take 2) v
+
+-- | Increment the nth version component (counting from 0).
+incVersion :: Int -> Version -> Version
+incVersion n = alterVersion (incVersion' n)
+ where
+ incVersion' 0 [] = [1]
+ incVersion' 0 (v:_) = [v+1]
+ incVersion' m [] = replicate m 0 ++ [1]
+ incVersion' m (v:vs) = v : incVersion' (m-1) vs
+
+-- | Returns the current calendar year.
+getCurrentYear :: IO Integer
+getCurrentYear = do
+ u <- getCurrentTime
+ z <- getCurrentTimeZone
+ let l = utcToLocalTime z u
+ (y, _, _) = toGregorian $ localDay l
+ return y
+
+-- | From System.Directory.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
+listFilesInside test dir = ifM (notM $ test $ dropTrailingPathSeparator dir) (pure []) $ do
+ (dirs,files) <- partitionM doesDirectoryExist =<< listContents dir
+ rest <- concatMapM (listFilesInside test) dirs
+ pure $ files ++ rest
+
+-- | From System.Directory.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+listFilesRecursive :: FilePath -> IO [FilePath]
+listFilesRecursive = listFilesInside (const $ pure True)
+
+-- | From System.Directory.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+listContents :: FilePath -> IO [FilePath]
+listContents dir = do
+ xs <- getDirectoryContents dir
+ pure $ sort [dir </> x | x <- xs, not $ all (== '.') x]
+
+-- | From Control.Monad.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+ifM :: Monad m => m Bool -> m a -> m a -> m a
+ifM b t f = do b' <- b; if b' then t else f
+
+-- | From Control.Monad.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
+{-# INLINE concatMapM #-}
+concatMapM op = foldr f (pure [])
+ where f x xs = do x' <- op x; if null x' then xs else do xs' <- xs; pure $ x' ++ xs'
+
+-- | From Control.Monad.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
+partitionM _ [] = pure ([], [])
+partitionM f (x:xs) = do
+ res <- f x
+ (as,bs) <- partitionM f xs
+ pure ([x | res]++as, [x | not res]++bs)
+
+-- | From Control.Monad.Extra
+-- https://hackage.haskell.org/package/extra-1.7.9
+notM :: Functor m => m Bool -> m Bool
+notM = fmap not
diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs
index 5783d9fce5..1c08f86add 100644
--- a/cabal-install/tests/UnitTests.hs
+++ b/cabal-install/tests/UnitTests.hs
@@ -24,7 +24,8 @@ import qualified UnitTests.Distribution.Client.Get
main :: IO ()
-main =
+main = do
+ initTests <- UnitTests.Distribution.Client.Init.tests
defaultMain $ testGroup "Unit Tests"
[ testGroup "UnitTests.Distribution.Solver.Modular.Builder"
UnitTests.Distribution.Solver.Modular.Builder.tests
@@ -40,7 +41,7 @@ main =
, testGroup "Distribution.Client.GZipUtils"
UnitTests.Distribution.Client.GZipUtils.tests
, testGroup "Distribution.Client.Init"
- UnitTests.Distribution.Client.Init.tests
+ initTests
, testGroup "Distribution.Client.Store"
UnitTests.Distribution.Client.Store.tests
, testGroup "Distribution.Client.Tar"
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init.hs
index 9a2f042482..30e08474c4 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Init.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init.hs
@@ -1,220 +1,49 @@
module UnitTests.Distribution.Client.Init
- ( tests
- ) where
-
-import Distribution.Client.Init.FileCreators
- ( generateCabalFile )
+( tests
+) where
import Test.Tasty
-import Test.Tasty.HUnit
-import Test.Tasty.Golden (goldenVsString)
-
-import System.FilePath
- ( (</>) )
-import qualified Data.ByteString.Lazy as BS
-import qualified Data.ByteString.Lazy.Char8 as BS8
-
-import Distribution.Client.Init.Command
- ( getLibOrExec, getAppDir, getSrcDir )
-import Distribution.Client.Init.Types
- ( InitFlags(..), PackageType(..), defaultInitFlags )
-import Distribution.Simple.Setup
- ( Flag(..) )
-
-import Distribution.CabalSpecVersion
- ( CabalSpecVersion(CabalSpecV2_4) )
-import Distribution.Types.Dependency
- ( Dependency, mkDependency, mainLibSet )
-import Distribution.Types.PackageName
- ( mkPackageName )
-import Distribution.Types.VersionRange
- ( majorBoundVersion )
-import Distribution.Types.Version
- ( mkVersion )
-import qualified Distribution.ModuleName as ModuleName
- ( fromString )
-import qualified Distribution.SPDX as SPDX
-import Language.Haskell.Extension ( Language(..) )
-
-tests :: [TestTree]
-tests = [ testGroup "cabal init goldens"
- [ checkCabalFileGolden exeFlags "exe-only-golden.cabal"
- , checkCabalFileGolden libAndExeFlags "lib-and-exe-golden.cabal"
- , checkCabalFileGolden libExeAndTestFlags "lib-exe-and-test-golden.cabal"
- , checkCabalFileGolden libExeAndTestWithCommentsFlags "lib-exe-and-test-with-comments-golden.cabal"
- ]
- , testGroup "Check init flag outputs against init script builds"
- [ checkInitFlags "Check library-only build flags" libFlags Library
- , checkInitFlags "Check lib+exe build flags" libAndExeFlags LibraryAndExecutable
- , checkInitFlags "Check exe-only build flags" exeFlags Executable
- ]
- ]
-
-checkCabalFileGolden :: InitFlags -> FilePath -> TestTree
-checkCabalFileGolden flags goldenFileName =
- goldenVsString goldenFileName goldenFilePath generatedCabalFile
- where
- goldenFilePath :: FilePath
- goldenFilePath = "tests" </> "fixtures" </> "init" </> goldenFileName
-
- generatedCabalFile :: IO BS.ByteString
- generatedCabalFile = pure . BS8.pack $ generateCabalFile goldenFileName flags
-
-checkInitFlags :: String -> InitFlags -> PackageType -> TestTree
-checkInitFlags label flags pkgType = testCase label $ do
- flags' <- getLibOrExec rawFlags
- >>= getAppDir
- >>= getSrcDir
-
- flags @=? flags'
- where
- rawFlags
- | pkgType == Executable = baseFlags
- { packageType = Flag pkgType
- , exposedModules = Nothing
- }
- | otherwise = baseFlags { packageType = Flag pkgType }
-
-
--- ==================================================
--- Base flags to set common InitFlags values.
-
-baseFlags :: InitFlags
-baseFlags = defaultInitFlags {
- -- Values common to all (or most) test flags.
- packageName = Flag (mkPackageName "foo")
- , noComments = Flag False
- , minimal = Flag True
- , version = Flag (mkVersion [3,2,1])
- , synopsis = Flag "The foo package"
- , homepage = Flag "https://github.com/foo/foo"
- , license = Flag SPDX.NONE
- , author = Flag "me"
- , email = Flag "me@me.me"
- , category = Flag (Left "SomeCat")
- , cabalVersion = Flag CabalSpecV2_4
- , extraSrc = Just ["CHANGELOG.md"]
- , interactive = Flag False
- , otherModules = Nothing
- , otherExts = Nothing
- , language = Flag Haskell2010
- , buildTools = Nothing
- , dependencies = Just testDependencies
- , quiet = Flag True
- , packageDir = NoFlag
- , simpleProject = Flag False
- , initHcPath = NoFlag
- , overwrite = NoFlag
- -- Commonly overridden values in test InitFlags.
- -- It is fine to provide the same value in an overridden InitFlags
- -- to make it clear what that particular test case is differentiating
- -- from others.
- , packageType = Flag Executable
- , mainIs = Flag "Main.hs"
- , applicationDirs = Just ["app"]
- , sourceDirs = Nothing
- , exposedModules = Just [ModuleName.fromString "MyLib"]
- , initializeTestSuite = Flag False
- , testDirs = Nothing
- }
+import qualified UnitTests.Distribution.Client.Init.Interactive as Interactive
+import qualified UnitTests.Distribution.Client.Init.NonInteractive as NonInteractive
+import qualified UnitTests.Distribution.Client.Init.Golden as Golden
+import qualified UnitTests.Distribution.Client.Init.Simple as Simple
+import UnitTests.Distribution.Client.Init.Utils
--- ==================================================
--- Simple library flags
-
-libFlags :: InitFlags
-libFlags = baseFlags
- { packageType = Flag Library
- , mainIs = NoFlag
- , sourceDirs = Just ["src"]
- , applicationDirs = Just []
- }
-
--- ==================================================
--- Simple exe.
-
-exeFlags :: InitFlags
-exeFlags = baseFlags {
- -- Create an executable only, with main living in app/Main.hs.
- packageType = Flag Executable
- , mainIs = Flag "Main.hs"
- , sourceDirs = Just []
- , applicationDirs = Just ["app"]
- , exposedModules = Nothing
- }
-
-
--- ==================================================
--- Simple lib and exe (as created by `cabal init --libandexe`).
---
--- Specifically, having 'exposedModules = Just ["MyLib"]' is a special
--- case which results in the executable depending on the library from
--- the same package, i.e. 'build-depends = foo' with no version
--- constraints.
-
-libAndExeFlags :: InitFlags
-libAndExeFlags = baseFlags {
- -- Create a library and executable
- packageType = Flag LibraryAndExecutable
-
- -- Main living in app/Main.hs.
- , mainIs = Flag "Main.hs"
- , applicationDirs = Just ["app"]
-
- -- Library sources live in src/ and expose the module MyLib.
- , sourceDirs = Just ["src"]
- }
-
-
--- ==================================================
--- Lib, exe, and test suite
-
-libExeAndTestFlags :: InitFlags
-libExeAndTestFlags = baseFlags {
- -- Create a library and executable
- packageType = Flag LibraryAndExecutable
-
- -- Main living in app/Main.hs.
- , mainIs = Flag "Main.hs"
- , applicationDirs = Just ["app"]
+import Distribution.Client.Config
+import Distribution.Client.IndexUtils
+import Distribution.Client.Init.Types
+import Distribution.Client.Sandbox
+import Distribution.Client.Setup
+import Distribution.Verbosity
- -- Library sources live in src/ and expose the modules A and B.
- , sourceDirs = Just ["src"]
- , exposedModules = Just (map ModuleName.fromString ["A", "B"])
- -- Create a test suite living in tests/
- , initializeTestSuite = Flag True
- , testDirs = Just ["tests"]
- }
+tests :: IO [TestTree]
+tests = do
+ confFlags <- loadConfigOrSandboxConfig v defaultGlobalFlags
--- ==================================================
--- Lib, exe, and test suite with comments.
+ let confFlags' = savedConfigureFlags confFlags `mappend` compFlags
+ initFlags' = savedInitFlags confFlags `mappend` emptyFlags
+ globalFlags' = savedGlobalFlags confFlags `mappend` defaultGlobalFlags
-libExeAndTestWithCommentsFlags :: InitFlags
-libExeAndTestWithCommentsFlags = libExeAndTestFlags {
- minimal = Flag False
- , noComments = Flag False
- , quiet = Flag False
- }
+ (comp, _, progdb) <- configCompilerAux' confFlags'
+ withRepoContext v globalFlags' $ \repoCtx -> do
+ let pkgDb = configPackageDB' confFlags'
+ pkgIx <- getInstalledPackages v comp pkgDb progdb
+ srcDb <- getSourcePackages v repoCtx
--- ==================================================
--- Test dependency.
+ return
+ [ Interactive.tests v initFlags' comp pkgIx srcDb
+ , NonInteractive.tests v initFlags' comp pkgIx srcDb
+ , Golden.tests v initFlags' comp pkgIx srcDb
+ , Simple.tests v initFlags' comp pkgIx srcDb
+ ]
+ where
+ v :: Verbosity
+ v = normal
-testDependencies :: [Dependency]
-testDependencies =
- [ mkDependency
- (mkPackageName "base")
- (majorBoundVersion (mkVersion [4,13,0,0]))
- mainLibSet
- , mkDependency
- (mkPackageName "containers")
- (majorBoundVersion (mkVersion [5,7,0,0]))
- mainLibSet
- , mkDependency
- (mkPackageName "unordered-containers")
- (majorBoundVersion (mkVersion [2,7,0,0]))
- mainLibSet
- ]
+ compFlags :: ConfigFlags
+ compFlags = mempty { configHcPath = initHcPath emptyFlags }
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs
new file mode 100644
index 0000000000..34052296ef
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs
@@ -0,0 +1,367 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+module UnitTests.Distribution.Client.Init.Golden
+( tests
+) where
+
+
+import Test.Tasty
+import Test.Tasty.Golden
+import Test.Tasty.HUnit
+
+import qualified Data.ByteString.Lazy.Char8 as BS8
+import Data.List.NonEmpty (fromList)
+import Data.List.NonEmpty as NEL (NonEmpty)
+#if __GLASGOW_HASKELL__ < 804
+import Data.Semigroup ((<>))
+#endif
+
+import Distribution.Client.Init.Types
+import Distribution.Simple.PackageIndex hiding (fromList)
+import Distribution.Verbosity
+import Distribution.Simple.Compiler
+import Distribution.Client.Types.SourcePackageDb
+import Distribution.Client.Init.Interactive.Command
+import Distribution.Client.Init.Format
+import Distribution.Fields.Pretty
+import Distribution.Types.PackageName (PackageName)
+import Distribution.Client.Init.FlagExtractors
+import Distribution.Simple.Flag
+import Distribution.CabalSpecVersion
+
+import System.FilePath
+
+import UnitTests.Distribution.Client.Init.Utils
+
+-- -------------------------------------------------------------------- --
+-- golden test suite
+
+-- | Golden executable tests.
+--
+-- We test target generation against a golden file in @tests/fixtures/init/@ for
+-- executables, libraries, and test targets with the following:
+--
+-- * Empty flags, non-simple target gen, no special options
+-- * Empty flags, simple target gen, no special options
+-- * Empty flags, non-simple target gen, with generated comments (no minimal setting)
+-- * Empty flags, non-simple target gen, with minimal setting (no generated comments)
+-- * Empty flags, non-simple target gen, minimal and generated comments set.
+--
+-- Additionally, we test whole @.cabal@ file generation for every combination
+-- of library, lib + tests, exe, exe + tests, exe + lib, exe + lib + tests
+-- and so on against the same options.
+--
+tests
+ :: Verbosity
+ -> InitFlags
+ -> Compiler
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+tests v initFlags _comp pkgIx srcDb = testGroup "golden"
+ [ goldenLibTests v pkgIx pkgDir pkgName
+ , goldenExeTests v pkgIx pkgDir pkgName
+ , goldenTestTests v pkgIx pkgDir pkgName
+ , goldenPkgDescTests v srcDb pkgDir pkgName
+ , goldenCabalTests v pkgIx srcDb
+ ]
+ where
+ pkgDir = evalPrompt (getPackageDir initFlags)
+ $ fromList ["."]
+ pkgName = evalPrompt (packageNamePrompt srcDb initFlags)
+ $ fromList ["test-package", "y"]
+
+-- goldenCabalTests
+-- :: Verbosity
+-- -> InstalledPackageIndex
+-- -> FilePath
+-- -> PackageName
+-- -> SourcePackageDb
+-- -> TestTree
+-- goldenCabalTests v pkgIx pkgDir pkgName srcDb = testGroup ".cabal golden tests"
+-- [ goldenVsString "Create lib .cabal project" (goldenCabal "lib-cabal.golden") $
+-- runGoldenCabal emptyFlags { packageType = Flag Library }
+-- , goldenVsString "Create lib+test .cabal project" (goldenCabal "lib-test-cabal.golden") $
+-- runGoldenCabal emptyFlags
+-- { packageType = Flag Library
+-- , initializeTestSuite = Flag True
+-- }
+-- , goldenVsString "Create lib .cabal project" (goldenCabal "exe-cabal.golden") $
+-- runGoldenCabal emptyFlags { packageType = Flag Executable }
+-- ]
+-- where
+-- runGoldenCabal flags =
+-- case _runPrompt (createProject v pkgIx srcDb flags) of
+-- Right (t, _) -> return . BS8.pack $ showFields'
+-- annCommentLines postProcessFieldLines
+-- 4 [mkCabalStanza opts t]
+-- Left e -> assertFailure $ show e
+
+goldenPkgDescTests
+ :: Verbosity
+ -> SourcePackageDb
+ -> FilePath
+ -> PackageName
+ -> TestTree
+goldenPkgDescTests v srcDb pkgDir pkgName = testGroup "package description golden tests"
+ [ goldenVsString "Empty flags, non-simple, no comments"
+ (goldenPkgDesc "pkg.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runPkgDesc opts emptyFlags pkgArgs
+
+ , goldenVsString "Empty flags, non-simple, with comments"
+ (goldenPkgDesc "pkg-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runPkgDesc opts emptyFlags pkgArgs
+
+ , goldenVsString "Dummy flags, with comments"
+ (goldenPkgDesc "pkg-with-flags.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runPkgDesc opts dummyFlags pkgArgs
+
+ , goldenVsString "Dummy flags, old cabal version, with comments"
+ (goldenPkgDesc "pkg-old-cabal-with-flags.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runPkgDesc opts (dummyFlags {cabalVersion = Flag CabalSpecV2_0}) pkgArgs
+ ]
+ where
+ runPkgDesc opts flags args = do
+ case _runPrompt (genPkgDescription flags srcDb) args of
+ Left e -> assertFailure $ show e
+ Right (pkg, _) -> mkStanza $ mkPkgDescription opts pkg
+
+goldenExeTests
+ :: Verbosity
+ -> InstalledPackageIndex
+ -> FilePath
+ -> PackageName
+ -> TestTree
+goldenExeTests v pkgIx pkgDir pkgName = testGroup "exe golden tests"
+ [ goldenVsString "Empty flags, not simple, no options"
+ (goldenExe "exe.golden") $
+ let opts = WriteOpts False False True v pkgDir Executable pkgName
+ in runGoldenExe opts exeArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with comments + no minimal"
+ (goldenExe "exe-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Executable pkgName
+ in runGoldenExe opts exeArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + no comments"
+ (goldenExe "exe-minimal-no-comments.golden") $
+ let opts = WriteOpts False True True v pkgDir Executable pkgName
+ in runGoldenExe opts exeArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + comments"
+ (goldenExe "exe-simple-with-comments.golden") $
+ let opts = WriteOpts False True False v pkgDir Executable pkgName
+ in runGoldenExe opts exeArgs emptyFlags
+
+ , goldenVsString "Build tools flag, not simple, with comments + no minimal"
+ (goldenExe "exe-build-tools-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Executable pkgName
+ in runGoldenExe opts exeArgs (emptyFlags {buildTools = Flag ["happy"]})
+ ]
+ where
+ runGoldenExe opts args flags =
+ case _runPrompt (genExeTarget flags pkgIx) args of
+ Right (t, _) -> mkStanza [mkExeStanza opts $ t {_exeDependencies = mangleBaseDep t _exeDependencies}]
+ Left e -> assertFailure $ show e
+
+goldenLibTests
+ :: Verbosity
+ -> InstalledPackageIndex
+ -> FilePath
+ -> PackageName
+ -> TestTree
+goldenLibTests v pkgIx pkgDir pkgName = testGroup "lib golden tests"
+ [ goldenVsString "Empty flags, not simple, no options"
+ (goldenLib "lib.golden") $
+ let opts = WriteOpts False False True v pkgDir Library pkgName
+ in runGoldenLib opts libArgs emptyFlags
+
+ , goldenVsString "Empty flags, simple, no options" (goldenLib "lib-simple.golden") $
+ let opts = WriteOpts False False True v pkgDir Library pkgName
+ in runGoldenLib opts libArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with comments + no minimal"
+ (goldenLib "lib-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runGoldenLib opts libArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + no comments"
+ (goldenLib "lib-minimal-no-comments.golden") $
+ let opts = WriteOpts False True True v pkgDir Library pkgName
+ in runGoldenLib opts libArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + comments"
+ (goldenLib "lib-simple-with-comments.golden") $
+ let opts = WriteOpts False True False v pkgDir Library pkgName
+ in runGoldenLib opts libArgs emptyFlags
+
+ , goldenVsString "Build tools flag, not simple, with comments + no minimal"
+ (goldenLib "lib-build-tools-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runGoldenLib opts libArgs (emptyFlags {buildTools = Flag ["happy"]})
+ ]
+ where
+ runGoldenLib opts args flags =
+ case _runPrompt (genLibTarget flags pkgIx) args of
+ Right (t, _) -> mkStanza [mkLibStanza opts $ t {_libDependencies = mangleBaseDep t _libDependencies}]
+ Left e -> assertFailure $ show e
+
+goldenTestTests
+ :: Verbosity
+ -> InstalledPackageIndex
+ -> FilePath
+ -> PackageName
+ -> TestTree
+goldenTestTests v pkgIx pkgDir pkgName = testGroup "test golden tests"
+ [ goldenVsString "Empty flags, not simple, no options"
+ (goldenTest "test.golden") $
+ let opts = WriteOpts False False True v pkgDir Library pkgName
+ in runGoldenTest opts testArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with comments + no minimal"
+ (goldenTest "test-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runGoldenTest opts testArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + no comments"
+ (goldenTest "test-minimal-no-comments.golden") $
+ let opts = WriteOpts False True True v pkgDir Library pkgName
+ in runGoldenTest opts testArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + comments"
+ (goldenTest "test-simple-with-comments.golden") $
+ let opts = WriteOpts False True False v pkgDir Library pkgName
+ in runGoldenTest opts testArgs emptyFlags
+
+ , goldenVsString "Empty flags, not simple, with minimal + comments"
+ (goldenTest "test-simple-with-comments.golden") $
+ let opts = WriteOpts False True False v pkgDir Library pkgName
+ in runGoldenTest opts testArgs emptyFlags
+
+ , goldenVsString "Build tools flag, not simple, with comments + no minimal"
+ (goldenTest "test-build-tools-with-comments.golden") $
+ let opts = WriteOpts False False False v pkgDir Library pkgName
+ in runGoldenTest opts testArgs (emptyFlags {buildTools = Flag ["happy"]})
+ ]
+ where
+ runGoldenTest opts args flags =
+ case _runPrompt (genTestTarget flags pkgIx) args of
+ Left e -> assertFailure $ show e
+ Right (Nothing, _) -> assertFailure
+ "goldenTestTests: Tests not enabled."
+ Right (Just t, _) -> mkStanza [mkTestStanza opts $ t {_testDependencies = mangleBaseDep t _testDependencies}]
+
+-- | Full cabal file golden tests
+goldenCabalTests
+ :: Verbosity
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
+ [ goldenVsString "Library and executable, empty flags, not simple, with comments + no minimal"
+ (goldenCabal "cabal-lib-and-exe-with-comments.golden") $
+ runGoldenTest (fullProjArgs "Y") emptyFlags
+
+ , goldenVsString "Library and executable, empty flags, not simple, no comments + no minimal"
+ (goldenCabal "cabal-lib-and-exe-no-comments.golden") $
+ runGoldenTest (fullProjArgs "N") emptyFlags
+
+ , goldenVsString "Library, empty flags, not simple, with comments + no minimal"
+ (goldenCabal "cabal-lib-with-comments.golden") $
+ runGoldenTest (libProjArgs "Y") emptyFlags
+
+ , goldenVsString "Library, empty flags, not simple, no comments + no minimal"
+ (goldenCabal "cabal-lib-no-comments.golden") $
+ runGoldenTest (libProjArgs "N") emptyFlags
+ ]
+ where
+ runGoldenTest args flags =
+ case _runPrompt (createProject v pkgIx srcDb flags) args of
+ Left e -> assertFailure $ show e
+
+ (Right (ProjectSettings opts pkgDesc (Just libTarget) (Just exeTarget) (Just testTarget), _)) -> do
+ let pkgFields = mkPkgDescription opts pkgDesc
+ libStanza = mkLibStanza opts $ libTarget {_libDependencies = mangleBaseDep libTarget _libDependencies}
+ exeStanza = mkExeStanza opts $ exeTarget {_exeDependencies = mangleBaseDep exeTarget _exeDependencies}
+ testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
+
+ mkStanza $ pkgFields ++ [libStanza, exeStanza, testStanza]
+
+ (Right (ProjectSettings opts pkgDesc (Just libTarget) Nothing (Just testTarget), _)) -> do
+ let pkgFields = mkPkgDescription opts pkgDesc
+ libStanza = mkLibStanza opts $ libTarget {_libDependencies = mangleBaseDep libTarget _libDependencies}
+ testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
+
+ mkStanza $ pkgFields ++ [libStanza, testStanza]
+
+ (Right (ProjectSettings _ _ l e t, _)) -> assertFailure $
+ show l ++ "\n" ++ show e ++ "\n" ++ show t
+
+
+-- -------------------------------------------------------------------- --
+-- utils
+
+mkStanza :: [PrettyField FieldAnnotation] -> IO BS8.ByteString
+mkStanza fields = return . BS8.pack $ showFields'
+ annCommentLines postProcessFieldLines
+ 4 fields
+
+golden :: FilePath
+golden = "tests" </> "fixtures" </> "init" </> "golden"
+
+goldenExe :: FilePath -> FilePath
+goldenExe file = golden </> "exe" </> file
+
+goldenTest :: FilePath -> FilePath
+goldenTest file = golden </> "test" </> file
+
+goldenLib :: FilePath -> FilePath
+goldenLib file = golden </> "lib" </> file
+
+goldenCabal :: FilePath -> FilePath
+goldenCabal file = golden </> "cabal" </> file
+
+goldenPkgDesc :: FilePath -> FilePath
+goldenPkgDesc file = golden </> "pkg-desc" </> file
+
+libArgs :: NonEmpty String
+libArgs = fromList ["1", "2"]
+
+exeArgs :: NonEmpty String
+exeArgs = fromList ["1", "2", "1"]
+
+testArgs :: NonEmpty String
+testArgs = fromList ["y", "1", "test", "1"]
+
+pkgArgs :: NonEmpty String
+pkgArgs = fromList
+ [ "4"
+ , "foo-package"
+ , "y"
+ , "0.1.0.0"
+ , "2"
+ , "foo-kmett"
+ , "foo-kmett@kmett.kmett"
+ , "home"
+ , "synopsis"
+ , "4"
+ ]
+
+libProjArgs :: String -> NonEmpty String
+libProjArgs comments = fromList ["1", "foo-package"]
+ <> pkgArgs
+ <> libArgs
+ <> testArgs
+ <> fromList [comments]
+
+fullProjArgs :: String -> NonEmpty String
+fullProjArgs comments = fromList ["3", "foo-package"]
+ <> pkgArgs
+ <> libArgs
+ <> exeArgs
+ <> testArgs
+ <> fromList [comments]
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs
new file mode 100644
index 0000000000..4b85e741f0
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs
@@ -0,0 +1,832 @@
+module UnitTests.Distribution.Client.Init.Interactive
+( tests
+) where
+
+
+import Prelude as P
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Interactive.Command
+import Distribution.Client.Init.Types
+
+import qualified Distribution.SPDX as SPDX
+
+import Data.List.NonEmpty hiding (zip)
+import Distribution.Client.Types
+import Distribution.Simple.Compiler
+import Distribution.Simple.PackageIndex hiding (fromList)
+import Distribution.Types.PackageName
+import Distribution.Types.Version
+import Distribution.Verbosity
+
+import Language.Haskell.Extension
+
+import UnitTests.Distribution.Client.Init.Utils
+import Distribution.Client.Init.FlagExtractors
+import Distribution.Simple.Setup
+import Distribution.CabalSpecVersion
+
+
+-- -------------------------------------------------------------------- --
+-- Init Test main
+
+tests
+ :: Verbosity
+ -> InitFlags
+ -> Compiler
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+tests _v initFlags _comp pkgIx srcDb =
+ testGroup "Distribution.Client.Init.Interactive.Command.hs"
+ [ createProjectTest pkgIx srcDb
+ , fileCreatorTests pkgIx srcDb pkgName
+ , interactiveTests srcDb
+ ]
+ where
+ pkgName = evalPrompt (packageNamePrompt srcDb initFlags) $
+ fromList ["test-package", "y"]
+
+ -- pkgNm = evalPrompt (getPackageName srcDb initFlags) $ fromList ["test-package", "y"]
+
+createProjectTest
+ :: InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+createProjectTest pkgIx srcDb = testGroup "createProject tests"
+ [ testGroup "with flags"
+ [ testCase "Check the non-interactive workflow" $ do
+ let dummyFlags' = dummyFlags
+ { packageType = Flag LibraryAndExecutable
+ , minimal = Flag False
+ , overwrite = Flag False
+ , packageDir = Flag "/home/test/test-package"
+ , extraSrc = Flag ["CHANGELOG.md"]
+ , exposedModules = Flag []
+ , otherModules = Flag []
+ , otherExts = Flag []
+ , buildTools = Flag []
+ , mainIs = Flag "quxApp/Main.hs"
+ , dependencies = Flag []
+ }
+
+ case (_runPrompt $ createProject silent pkgIx srcDb dummyFlags') (fromList ["3", "quxTest/Main.hs"]) of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= True
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "QuxPackage"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_2
+ _pkgName desc @?= mkPackageName "QuxPackage"
+ _pkgVersion desc @?= mkVersion [4,2,6]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "We are Qux, and this is our package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _libSourceDirs lib @?= ["quxSrc"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule :| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?= []
+ _libBuildTools lib @?= []
+
+ _exeMainIs exe @?= HsFilePath "quxApp/Main.hs" Standard
+ _exeApplicationDirs exe @?= ["quxApp"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= []
+
+ _testMainIs test @?= HsFilePath "quxTest/Main.hs" Standard
+ _testDirs test @?= ["quxTest"]
+ _testLanguage test @?= Haskell98
+ _testOtherModules test @?= []
+ _testOtherExts test @?= []
+ _testDependencies test @?! []
+ _testBuildTools test @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+ ]
+
+ , testGroup "with tests"
+ [ testCase "Check the interactive library and executable workflow" $ do
+ let inputs = fromList
+ -- package type
+ [ "3"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "4"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- version
+ , "3.1.2.3"
+ -- license
+ , "3"
+ -- author
+ , "Foobar"
+ -- email
+ , "foobar@qux.com"
+ -- homepage
+ , "qux.com"
+ -- synopsis
+ , "Qux's package"
+ -- category
+ , "3"
+ -- library target
+ -- source dir
+ , "1"
+ -- language
+ , "2"
+ -- executable target
+ -- main file
+ , "1"
+ -- application dir
+ , "2"
+ -- language
+ , "2"
+ -- test target
+ -- main file
+ , "1"
+ -- test dir
+ , "test"
+ -- language
+ , "1"
+ -- comments
+ , "y"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [3,1,2,3]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "Qux's package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule :| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= []
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["exe"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= []
+
+ _testMainIs test @?= HsFilePath "Main.hs" Standard
+ _testDirs test @?= ["test"]
+ _testLanguage test @?= Haskell2010
+ _testOtherModules test @?= []
+ _testOtherExts test @?= []
+ _testDependencies test @?! []
+ _testBuildTools test @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the interactive library workflow" $ do
+ let inputs = fromList
+ -- package type
+ [ "1"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "4"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- version
+ , "3.1.2.3"
+ -- license
+ , "3"
+ -- author
+ , "Foobar"
+ -- email
+ , "foobar@qux.com"
+ -- homepage
+ , "qux.com"
+ -- synopsis
+ , "Qux's package"
+ -- category
+ , "3"
+ -- library target
+ -- source dir
+ , "1"
+ -- language
+ , "2"
+ -- test target
+ -- main file
+ , "1"
+ -- test dir
+ , "test"
+ -- language
+ , "1"
+ -- comments
+ , "y"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+ Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Library
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [3,1,2,3]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "Qux's package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule :| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= []
+
+ _testMainIs test @?= HsFilePath "Main.hs" Standard
+ _testDirs test @?= ["test"]
+ _testLanguage test @?= Haskell2010
+ _testOtherModules test @?= []
+ _testOtherExts test @?= []
+ _testDependencies test @?! []
+ _testBuildTools test @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?= Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+ ]
+ , testGroup "without tests"
+ [ testCase "Check the interactive library and executable workflow" $ do
+ let inputs = fromList
+ -- package type
+ [ "3"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "4"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- version
+ , "3.1.2.3"
+ -- license
+ , "3"
+ -- author
+ , "Foobar"
+ -- email
+ , "foobar@qux.com"
+ -- homepage
+ , "qux.com"
+ -- synopsis
+ , "Qux's package"
+ -- category
+ , "3"
+ -- library target
+ -- source dir
+ , "1"
+ -- language
+ , "2"
+ -- executable target
+ -- main file
+ , "1"
+ -- application dir
+ , "2"
+ -- language
+ , "2"
+ -- test suite
+ , "n"
+ -- comments
+ , "y"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [3,1,2,3]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "Qux's package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule :| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= []
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["exe"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the interactive library workflow" $ do
+ let inputs = fromList
+ -- package type
+ [ "1"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "4"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- version
+ , "3.1.2.3"
+ -- license
+ , "3"
+ -- author
+ , "Foobar"
+ -- email
+ , "foobar@qux.com"
+ -- homepage
+ , "qux.com"
+ -- synopsis
+ , "Qux's package"
+ -- category
+ , "3"
+ -- library target
+ -- source dir
+ , "1"
+ -- language
+ , "2"
+ -- test suite
+ , "n"
+ -- comments
+ , "y"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc (Just lib) Nothing Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Library
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [3,1,2,3]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "Qux's package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule :| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?= Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the interactive executable workflow" $ do
+ let inputs = fromList
+ -- package type
+ [ "2"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "4"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- version
+ , "3.1.2.3"
+ -- license
+ , "3"
+ -- author
+ , "Foobar"
+ -- email
+ , "foobar@qux.com"
+ -- homepage
+ , "qux.com"
+ -- synopsis
+ , "Qux's package"
+ -- category
+ , "3"
+ -- executable target
+ -- main file
+ , "1"
+ -- application dir
+ , "2"
+ -- language
+ , "2"
+ -- comments
+ , "y"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc Nothing (Just exe) Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Executable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [3,1,2,3]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "Qux's package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" :| []
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["exe"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?= Nothing
+ exe @?! Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+ ]
+ ]
+
+fileCreatorTests :: InstalledPackageIndex -> SourcePackageDb -> PackageName -> TestTree
+fileCreatorTests pkgIx srcDb _pkgName = testGroup "generators"
+ [ testGroup "genPkgDescription"
+ [ testCase "Check common package flags workflow" $ do
+ let inputs = fromList
+ [ "1" -- pick the first cabal version in the list
+ , "my-test-package" -- package name
+ , "y" -- "yes to prompt internal to package name"
+ , "0.2.0.1" -- package version
+ , "2" -- pick the second license in the list
+ , "Foobar" -- author name
+ , "foobar@qux.com" -- maintainer email
+ , "qux.com" -- package homepage
+ , "Qux's package" -- package synopsis
+ , "3" -- pick the third category in the list
+ ]
+ runGenTest inputs $ genPkgDescription emptyFlags srcDb
+ ]
+ , testGroup "genLibTarget"
+ [ testCase "Check library package flags workflow" $ do
+ let inputs = fromList
+ [ "1" -- pick the first source directory in the list
+ , "2" -- pick the second language in the list
+ ]
+
+ runGenTest inputs $ genLibTarget emptyFlags pkgIx
+ ]
+ , testGroup "genExeTarget"
+ [ testCase "Check executable package flags workflow" $ do
+ let inputs = fromList
+ [ "1" -- pick the first main file option in the list
+ , "2" -- pick the second application directory in the list
+ , "1" -- pick the first language in the list
+ ]
+
+ runGenTest inputs $ genExeTarget emptyFlags pkgIx
+ ]
+ , testGroup "genTestTarget"
+ [ testCase "Check test package flags workflow" $ do
+ let inputs = fromList
+ [ "1" -- pick the first main file option in the list
+ , "test" -- package test dir
+ , "1" -- pick the first language in the list
+ ]
+
+ runGenTest inputs $ genTestTarget
+ (emptyFlags {initializeTestSuite = Flag True}) pkgIx
+ ]
+ ]
+ where
+ runGenTest inputs go = case _runPrompt go inputs of
+ Left e -> assertFailure $ show e
+ Right{} -> return ()
+
+interactiveTests :: SourcePackageDb -> TestTree
+interactiveTests srcDb = testGroup "Check top level getter functions"
+ [ testGroup "Simple prompt tests"
+ [ testGroup "Check packageNamePrompt output"
+ [ testSimplePrompt "New package name 1"
+ (packageNamePrompt srcDb) (mkPackageName "test-package")
+ [ "test-package"
+ , "test-package"
+ ]
+ , testSimplePrompt "New package name 2"
+ (packageNamePrompt srcDb) (mkPackageName "test-package")
+ [ "test-package"
+ , ""
+ ]
+ , testSimplePrompt "Existing package name 1"
+ (packageNamePrompt srcDb) (mkPackageName "test-package")
+ [ "test-package"
+ , "cabal-install"
+ , "y"
+ , "test-package"
+ ]
+ , testSimplePrompt "Existing package name 2"
+ (packageNamePrompt srcDb) (mkPackageName "cabal-install")
+ [ "test-package"
+ , "cabal-install"
+ , "n"
+ ]
+ ]
+ , testGroup "Check mainFilePrompt output"
+ [ testSimplePrompt "New valid main file"
+ mainFilePrompt defaultMainIs
+ [ "1"
+ ]
+ , testSimplePrompt "New valid other main file"
+ mainFilePrompt (HsFilePath "Main.hs" Standard)
+ [ "3"
+ , "Main.hs"
+ ]
+ , testSimplePrompt "Invalid other main file"
+ mainFilePrompt (HsFilePath "Main.lhs" Literate)
+ [ "3"
+ , "Yoink.jl"
+ , "2"
+ ]
+ ]
+ , testGroup "Check versionPrompt output"
+ [ testSimplePrompt "Proper PVP"
+ versionPrompt (mkVersion [0,3,1,0])
+ [ "0.3.1.0"
+ ]
+ , testSimplePrompt "No PVP"
+ versionPrompt (mkVersion [0,3,1,0])
+ [ "yee-haw"
+ , "0.3.1.0"
+ ]
+ ]
+ , testGroup "Check synopsisPrompt output"
+ [ testSimplePrompt "1" synopsisPrompt
+ "We are Qux, and this is our package" ["We are Qux, and this is our package"]
+ , testSimplePrompt "2" synopsisPrompt
+ "Resistance is futile, you will be assimilated" ["Resistance is futile, you will be assimilated"]
+ ]
+ , testSimplePrompt "Check authorPrompt output" authorPrompt
+ "Foobar" ["Foobar"]
+ , testSimplePrompt "Check emailPrompt output" emailPrompt
+ "foobar@qux.com" ["foobar@qux.com"]
+ , testSimplePrompt "Check homepagePrompt output" homepagePrompt
+ "qux.com" ["qux.com"]
+ , testSimplePrompt "Check testDirsPrompt output" testDirsPrompt
+ ["quxTest"] ["quxTest"]
+ -- this tests 4) other, and can be used to model more inputs in case of failure
+ , testSimplePrompt "Check srcDirsPrompt output" srcDirsPrompt
+ ["app"] ["4", "app"]
+ ]
+ , testGroup "Numbered prompt tests"
+ [ testGroup "Check categoryPrompt output"
+ [ testNumberedPrompt "Category indices" categoryPrompt
+ defaultCategories
+ , testSimplePrompt "Other category"
+ categoryPrompt "Unlisted"
+ [ show $ P.length defaultCategories + 1
+ , "Unlisted"
+ ]
+ , testSimplePrompt "No category"
+ categoryPrompt ""
+ [ ""
+ ]
+ ]
+ , testGroup "Check licensePrompt output" $ let other = show (1 + P.length defaultLicenseIds) in
+ [ testNumberedPrompt "License indices" licensePrompt $
+ fmap (\l -> SPDX.License $ SPDX.ELicense (SPDX.ELicenseId l) Nothing) defaultLicenseIds
+ , testSimplePrompt "Other license 1"
+ licensePrompt (mkLicense SPDX.CC_BY_NC_ND_4_0)
+ [ other
+ , "CC-BY-NC-ND-4.0"
+ ]
+ , testSimplePrompt "Other license 2"
+ licensePrompt (mkLicense SPDX.D_FSL_1_0)
+ [ other
+ , "D-FSL-1.0"
+ ]
+ , testSimplePrompt "Other license 3"
+ licensePrompt (mkLicense SPDX.NPOSL_3_0)
+ [ other
+ , "NPOSL-3.0"
+ ]
+ , testSimplePrompt "Invalid license"
+ licensePrompt SPDX.NONE
+ [ other
+ , "yay"
+ , other
+ , "NONE"
+ ]
+ , testPromptBreak "Invalid index"
+ licensePrompt
+ [ "42"
+ ]
+ ]
+ , testGroup "Check languagePrompt output"
+ [ testNumberedPrompt "Language indices" (`languagePrompt` "test")
+ [Haskell2010, Haskell98]
+ , testSimplePrompt "Other language"
+ (`languagePrompt` "test") (UnknownLanguage "Haskell2022")
+ [ "3"
+ , "Haskell2022"
+ ]
+ , testSimplePrompt "Invalid language"
+ (`languagePrompt` "test") Haskell2010
+ [ "3"
+ , "Lang_TS!"
+ , "1"
+ ]
+ ]
+ , testGroup "Check srcDirsPrompt output"
+ [ testNumberedPrompt "Soruce dirs indices" srcDirsPrompt
+ [[defaultSourceDir], ["lib"], ["src-lib"]]
+ , testSimplePrompt "Other source dir"
+ srcDirsPrompt ["src"]
+ [ "4"
+ , "src"
+ ]
+ ]
+ , testGroup "Check appDirsPrompt output"
+ [ testNumberedPrompt "App dirs indices" appDirsPrompt
+ [[defaultApplicationDir], ["exe"], ["src-exe"]]
+ , testSimplePrompt "Other app dir"
+ appDirsPrompt ["app"]
+ [ "4"
+ , "app"
+ ]
+ ]
+ , testNumberedPrompt "Check packageTypePrompt output" packageTypePrompt
+ [Library, Executable, LibraryAndExecutable]
+ , testNumberedPrompt "Check cabalVersionPrompt output" cabalVersionPrompt
+ defaultCabalVersions
+ ]
+ , testGroup "Bool prompt tests"
+ [ testBoolPrompt "Check noCommentsPrompt output - y" noCommentsPrompt False "y"
+ , testBoolPrompt "Check noCommentsPrompt output - Y" noCommentsPrompt False "Y"
+ , testBoolPrompt "Check noCommentsPrompt output - n" noCommentsPrompt True "n"
+ , testBoolPrompt "Check noCommentsPrompt output - N" noCommentsPrompt True "N"
+ ]
+ ]
+
+
+
+-- -------------------------------------------------------------------- --
+-- Prompt test utils
+
+
+testSimplePrompt
+ :: Eq a
+ => Show a
+ => String
+ -> (InitFlags -> PurePrompt a)
+ -> a
+ -> [String]
+ -> TestTree
+testSimplePrompt label f target =
+ testPrompt label f (assertFailure . show) (\(a,_) -> target @=? a)
+
+testPromptBreak
+ :: Eq a
+ => Show a
+ => String
+ -> (InitFlags -> PurePrompt a)
+ -> [String]
+ -> TestTree
+testPromptBreak label f =
+ testPrompt label f go (assertFailure . show)
+ where
+ go BreakException{} =
+ return ()
+
+testPrompt
+ :: Eq a
+ => Show a
+ => String
+ -> (InitFlags -> PurePrompt a)
+ -> (BreakException -> Assertion)
+ -> ((a, NonEmpty String) -> Assertion)
+ -> [String]
+ -> TestTree
+testPrompt label f g h input = testCase label $
+ case (_runPrompt $ f emptyFlags) (fromList input) of
+ Left x -> g x -- :: BreakException
+ Right x -> h x -- :: (a, other inputs)
+
+testNumberedPrompt :: (Eq a, Show a) => String -> (InitFlags -> PurePrompt a) -> [a] -> TestTree
+testNumberedPrompt label act = testGroup label . (++ goBreak) . fmap go . indexed1
+ where
+ indexed1 = zip [1 :: Int ..]
+ mkLabel a n = "testing index "
+ ++ show n
+ ++ ") with: "
+ ++ show a
+
+ go (n, a) =
+ testSimplePrompt (mkLabel a n) act a [show n]
+ goBreak =
+ [ testPromptBreak "testing index -1" act ["-1"]
+ , testPromptBreak "testing index 1000" act ["1000"]
+ ]
+
+testBoolPrompt
+ :: String
+ -> (InitFlags -> PurePrompt Bool)
+ -> Bool
+ -> String
+ -> TestTree
+testBoolPrompt label act target b =
+ testSimplePrompt label act target [b]
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init/NonInteractive.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init/NonInteractive.hs
new file mode 100644
index 0000000000..69e38d3160
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init/NonInteractive.hs
@@ -0,0 +1,1158 @@
+module UnitTests.Distribution.Client.Init.NonInteractive
+ ( tests
+ ) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import UnitTests.Distribution.Client.Init.Utils
+
+import qualified Data.List.NonEmpty as NEL
+import qualified Distribution.SPDX as SPDX
+
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.NonInteractive.Command
+import Distribution.Client.Init.Types
+import Distribution.Client.Types
+import Distribution.Simple
+import Distribution.Simple.PackageIndex
+import Distribution.Verbosity
+import Distribution.CabalSpecVersion
+import Distribution.ModuleName (fromString)
+import Distribution.Simple.Flag
+
+tests
+ :: Verbosity
+ -> InitFlags
+ -> Compiler
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+tests _v _initFlags _comp pkgIx srcDb =
+ testGroup "cabal init non-interactive"
+ [ testGroup "driver function test"
+ [ driverFunctionTest pkgIx srcDb
+ ]
+ , testGroup "target creator tests"
+ [ fileCreatorTests pkgIx srcDb
+ ]
+ , testGroup "non-interactive tests"
+ [ nonInteractiveTests pkgIx srcDb
+ ]
+ ]
+
+driverFunctionTest
+ :: InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+driverFunctionTest pkgIx srcDb = testGroup "createProject"
+ [ testGroup "with flags"
+ [ testCase "Check the non-interactive workflow 1" $ do
+ let dummyFlags' = dummyFlags
+ { packageType = Flag LibraryAndExecutable
+ , minimal = Flag False
+ , overwrite = Flag False
+ , packageDir = Flag "/home/test/test-package"
+ , extraSrc = Flag ["CHANGELOG.md"]
+ , exposedModules = Flag []
+ , otherModules = Flag []
+ , otherExts = Flag []
+ , buildTools = Flag []
+ , mainIs = Flag "quxApp/Main.hs"
+ , dependencies = Flag []
+ }
+ inputs = NEL.fromList
+ [ "[\"quxTest/Main.hs\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb dummyFlags') inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= True
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "QuxPackage"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_2
+ _pkgName desc @?= mkPackageName "QuxPackage"
+ _pkgVersion desc @?= mkVersion [4,2,6]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "We are Qux, and this is our package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["quxSrc"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule NEL.:| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?= []
+ _libBuildTools lib @?= []
+
+ _exeMainIs exe @?= HsFilePath "quxApp/Main.hs" Standard
+ _exeApplicationDirs exe @?= ["quxApp"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?= []
+ _exeBuildTools exe @?= []
+
+ _testMainIs test @?= HsFilePath "quxTest/Main.hs" Standard
+ _testDirs test @?= ["quxTest"]
+ _testLanguage test @?= Haskell98
+ _testOtherModules test @?= []
+ _testOtherExts test @?= []
+ _testDependencies test @?= []
+ _testBuildTools test @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the non-interactive workflow 2" $ do
+ let dummyFlags' = dummyFlags
+ { packageType = Flag LibraryAndExecutable
+ , minimal = Flag False
+ , overwrite = Flag False
+ , packageDir = Flag "/home/test/test-package"
+ , extraSrc = Flag []
+ , exposedModules = Flag []
+ , otherModules = NoFlag
+ , otherExts = Flag []
+ , buildTools = Flag []
+ , mainIs = Flag "quxApp/Main.hs"
+ , dependencies = Flag []
+ }
+ inputs = NEL.fromList
+ -- extra sources
+ [ "[\"CHANGELOG.md\"]"
+ -- lib other modules
+ , "False"
+ -- exe other modules
+ , "False"
+ -- test main file
+ , "[\"quxTest/Main.hs\"]"
+ -- test other modules
+ , "False"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb dummyFlags') inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= True
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "QuxPackage"
+
+ _pkgCabalVersion desc @?= CabalSpecV2_2
+ _pkgName desc @?= mkPackageName "QuxPackage"
+ _pkgVersion desc @?= mkVersion [4,2,6]
+ _pkgLicense desc @?! SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= "qux.com"
+ _pkgSynopsis desc @?= "We are Qux, and this is our package"
+ _pkgCategory desc @?= "Control"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["quxSrc"]
+ _libLanguage lib @?= Haskell98
+ _libExposedModules lib @?= myLibModule NEL.:| []
+ _libOtherModules lib @?= []
+ _libOtherExts lib @?= []
+ _libDependencies lib @?= []
+ _libBuildTools lib @?= []
+
+ _exeMainIs exe @?= HsFilePath "quxApp/Main.hs" Standard
+ _exeApplicationDirs exe @?= ["quxApp"]
+ _exeLanguage exe @?= Haskell98
+ _exeOtherModules exe @?= []
+ _exeOtherExts exe @?= []
+ _exeDependencies exe @?= []
+ _exeBuildTools exe @?= []
+
+ _testMainIs test @?= HsFilePath "quxTest/Main.hs" Standard
+ _testDirs test @?= ["quxTest"]
+ _testLanguage test @?= Haskell98
+ _testOtherModules test @?= []
+ _testOtherExts test @?= []
+ _testDependencies test @?= []
+ _testBuildTools test @?= []
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+ ]
+ , testGroup "with tests"
+ [ testCase "Check the non-interactive library and executable workflow" $ do
+ let inputs = NEL.fromList
+ -- package type
+ [ "test-package"
+ , "[\".\", \"..\", \"src/\", \"app/Main.hs\"]"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "cabal-install version 3.4.0.0\ncompiled using version 3.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , ""
+ , "Foobar"
+ -- author email
+ , ""
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ -- library target
+ -- source dirs
+ , "src"
+ , "True"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 8.8.4"
+ -- exposed modules
+ , "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ -- other extensions
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"src/Foo.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ -- executable target
+ -- application dirs
+ , "app"
+ , "[]"
+ -- main file
+ , "test-package"
+ , "[\"test-package/app/\"]"
+ , "[]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"app/Main.hs\", \"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"app/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, DataKinds #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ -- test target
+ -- main file
+ , "[\"test-package/test/\"]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"test/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Test.Tasty\nimport Test.Tasty.HUnit"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/bar.y\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV3_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [0,1,0,0]
+ _pkgLicense desc @?= SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= ""
+ _pkgSynopsis desc @?= ""
+ _pkgCategory desc @?= "(none)"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell2010
+ _libExposedModules lib @?= NEL.fromList (map fromString ["Foo", "Bar"])
+ _libOtherModules lib @?= map fromString ["Baz.Internal"]
+ _libOtherExts lib @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= ["happy"]
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["app"]
+ _exeLanguage exe @?= Haskell2010
+ _exeOtherModules exe @?= map fromString ["Foo", "Bar"]
+ _exeOtherExts exe @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= ["happy"]
+
+ _testMainIs test @?= HsFilePath "Main.hs" Standard
+ _testDirs test @?= ["test"]
+ _testLanguage test @?= Haskell2010
+ _testOtherModules test @?= map fromString ["Foo", "Bar"]
+ _testOtherExts test @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _testDependencies test @?! []
+ _testBuildTools test @?= ["happy"]
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the non-interactive library workflow" $ do
+ let inputs = NEL.fromList
+ -- package type
+ [ "test-package"
+ , "[\".\", \"..\", \"src/\", \"test/Main.hs\"]"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "cabal-install version 3.4.0.0\ncompiled using version 3.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , "Foobar"
+ -- author email
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ -- library target
+ -- source dirs
+ , "src"
+ , "True"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 8.8.4"
+ -- exposed modules
+ , "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ -- other extensions
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"src/Foo.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ -- test target
+ -- main file
+ , "[\"test-package/test/\"]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"test/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Test.Tasty\nimport Test.Tasty.HUnit"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/bar.y\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+ Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Library
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV3_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [0,1,0,0]
+ _pkgLicense desc @?= SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= ""
+ _pkgSynopsis desc @?= ""
+ _pkgCategory desc @?= "(none)"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell2010
+ _libExposedModules lib @?= NEL.fromList (map fromString ["Foo", "Bar"])
+ _libOtherModules lib @?= map fromString ["Baz.Internal"]
+ _libOtherExts lib @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= ["happy"]
+
+ _testMainIs test @?= HsFilePath "Main.hs" Standard
+ _testDirs test @?= ["test"]
+ _testLanguage test @?= Haskell2010
+ _testOtherModules test @?= map fromString ["Foo", "Bar"]
+ _testOtherExts test @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _testDependencies test @?! []
+ _testBuildTools test @?= ["happy"]
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?= Nothing
+ test @?! Nothing
+ Left e -> assertFailure $ show e
+ ]
+ , testGroup "without tests"
+ [ testCase "Check the non-interactive library and executable workflow" $ do
+ let inputs = NEL.fromList
+ -- package type
+ [ "test-package"
+ , "[\".\", \"..\", \"src/\", \"app/Main.hs\"]"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "cabal-install version 3.4.0.0\ncompiled using version 3.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , ""
+ , "Foobar"
+ -- author email
+ , ""
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ -- library target
+ -- source dirs
+ , "src"
+ , "True"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 8.8.4"
+ -- exposed modules
+ , "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ -- other extensions
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"src/Foo.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ -- executable target
+ -- application dirs
+ , "app"
+ , "[]"
+ -- main file
+ , "test-package"
+ , "[\"test-package/app/\"]"
+ , "[]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"app/Main.hs\", \"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"app/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, DataKinds #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc (Just lib) (Just exe) Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= LibraryAndExecutable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV3_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [0,1,0,0]
+ _pkgLicense desc @?= SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= ""
+ _pkgSynopsis desc @?= ""
+ _pkgCategory desc @?= "(none)"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell2010
+ _libExposedModules lib @?= NEL.fromList (map fromString ["Foo", "Bar"])
+ _libOtherModules lib @?= map fromString ["Baz.Internal"]
+ _libOtherExts lib @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= ["happy"]
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["app"]
+ _exeLanguage exe @?= Haskell2010
+ _exeOtherModules exe @?= map fromString ["Foo", "Bar"]
+ _exeOtherExts exe @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= ["happy"]
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?! Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the non-interactive library workflow" $ do
+ let inputs = NEL.fromList
+ -- package type
+ [ "test-package"
+ , "[\".\", \"..\", \"src/\"]"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "cabal-install version 3.4.0.0\ncompiled using version 3.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , ""
+ , "Foobar"
+ -- author email
+ , ""
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ -- library target
+ -- source dirs
+ , "src"
+ , "True"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 8.8.4"
+ -- exposed modules
+ , "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ -- other extensions
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"src/Foo.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc (Just lib) Nothing Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Library
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV3_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [0,1,0,0]
+ _pkgLicense desc @?= SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= ""
+ _pkgSynopsis desc @?= ""
+ _pkgCategory desc @?= "(none)"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _libSourceDirs lib @?= ["src"]
+ _libLanguage lib @?= Haskell2010
+ _libExposedModules lib @?= NEL.fromList (map fromString ["Foo", "Bar"])
+ _libOtherModules lib @?= map fromString ["Baz.Internal"]
+ _libOtherExts lib @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _libDependencies lib @?! []
+ _libBuildTools lib @?= ["happy"]
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?! Nothing
+ exe @?= Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+
+ , testCase "Check the non-interactive executable workflow" $ do
+ let inputs = NEL.fromList
+ -- package type
+ [ "test-package"
+ , "[\".\", \"..\", \"app/Main.hs\"]"
+ -- package dir
+ , "test-package"
+ -- package description
+ -- cabal version
+ , "cabal-install version 3.4.0.0\ncompiled using version 3.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , ""
+ , "Foobar"
+ -- author email
+ , ""
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ -- executable target
+ -- application dirs
+ , "app"
+ , "[]"
+ -- main file
+ , "test-package"
+ , "[\"test-package/app/\"]"
+ , "[]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"app/Main.hs\", \"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"app/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, DataKinds #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ ]
+
+ case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+ Right (ProjectSettings opts desc Nothing (Just exe) Nothing, _) -> do
+ _optOverwrite opts @?= False
+ _optMinimal opts @?= False
+ _optNoComments opts @?= False
+ _optVerbosity opts @?= silent
+ _optPkgDir opts @?= "/home/test/test-package"
+ _optPkgType opts @?= Executable
+ _optPkgName opts @?= mkPackageName "test-package"
+
+ _pkgCabalVersion desc @?= CabalSpecV3_4
+ _pkgName desc @?= mkPackageName "test-package"
+ _pkgVersion desc @?= mkVersion [0,1,0,0]
+ _pkgLicense desc @?= SPDX.NONE
+ _pkgAuthor desc @?= "Foobar"
+ _pkgEmail desc @?= "foobar@qux.com"
+ _pkgHomePage desc @?= ""
+ _pkgSynopsis desc @?= ""
+ _pkgCategory desc @?= "(none)"
+ _pkgExtraSrcFiles desc @?= "CHANGELOG.md" NEL.:| []
+
+ _exeMainIs exe @?= HsFilePath "Main.hs" Standard
+ _exeApplicationDirs exe @?= ["app"]
+ _exeLanguage exe @?= Haskell2010
+ _exeOtherModules exe @?= map fromString ["Foo", "Bar"]
+ _exeOtherExts exe @?= map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards]
+ _exeDependencies exe @?! []
+ _exeBuildTools exe @?= ["happy"]
+
+ Right (ProjectSettings _ _ lib exe test, _) -> do
+ lib @?= Nothing
+ exe @?! Nothing
+ test @?= Nothing
+ Left e -> assertFailure $ show e
+ ]
+ ]
+
+fileCreatorTests
+ :: InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+fileCreatorTests pkgIx srcDb = testGroup "generators"
+ [ testGroup "genPkgDescription"
+ [ testCase "Check common package flags workflow" $ do
+ let inputs = NEL.fromList
+ -- cabal version
+ [ "cabal-install version 2.4.0.0\ncompiled using version 2.4.0.0 of the Cabal library \n"
+ -- package name
+ , "test-package"
+ , "test-package"
+ -- author name
+ , ""
+ , "Foobar"
+ -- author email
+ , ""
+ , "foobar@qux.com"
+ -- extra source files
+ , "test-package"
+ , "[]"
+ ]
+
+ case (_runPrompt $ genPkgDescription emptyFlags srcDb) inputs of
+ Left e -> assertFailure $ show e
+ Right{} -> return ()
+ ]
+ , testGroup "genLibTarget"
+ [ testCase "Check library package flags workflow" $ do
+ let inputs = NEL.fromList
+ -- source dirs
+ [ "src"
+ , "True"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- exposed modules
+ , "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ -- other extensions
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"src/Foo.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ ]
+
+ case (_runPrompt $ genLibTarget emptyFlags pkgIx) inputs of
+ Left e -> assertFailure $ show e
+ Right{} -> return ()
+ ]
+ , testGroup "genExeTarget"
+ [ testCase "Check executable package flags workflow" $ do
+ let inputs = NEL.fromList
+ -- application dirs
+ [ "app"
+ , "[]"
+ -- main file
+ , "test-package"
+ , "[\"test-package/app/\"]"
+ , "[]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"app/Main.hs\", \"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"app/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Control.Monad.Extra"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"
+ ]
+
+ case (_runPrompt $ genExeTarget emptyFlags pkgIx) inputs of
+ Left e -> assertFailure $ show e
+ Right{} -> return ()
+ ]
+ , testGroup "genTestTarget"
+ [ testCase "Check test package flags workflow" $ do
+ let inputs = NEL.fromList
+ -- main file
+ [ "[]"
+ -- language
+ , "The Glorious Glasgow Haskell Compilation System, version 7.10.3"
+ -- other modules
+ , "test-package"
+ , "True"
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ -- other extensions
+ , "[\"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ -- dependencies
+ , "[\"test/Main.hs\"]"
+ , "test-package"
+ , "module Main where"
+ , "import Test.Tasty\nimport Test.Tasty.HUnit"
+ , "{-# LANGUAGE OverloadedStrings, LambdaCase #-}"
+ -- build tools
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/bar.y\"]"
+ ]
+
+ case (_runPrompt $ genTestTarget (emptyFlags {initializeTestSuite = Flag True}) pkgIx) inputs of
+ Left e -> assertFailure $ show e
+ Right{} -> return ()
+ ]
+ ]
+
+nonInteractiveTests
+ :: InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+nonInteractiveTests _pkgIx srcDb = testGroup "Check top level getter functions"
+ [ testGroup "Simple heuristics tests"
+ [ testGroup "Check packageNameHeuristics output"
+ [ testSimple "New package name" (packageNameHeuristics srcDb)
+ (mkPackageName "test-package")
+ [ "test-package"
+ , "test-package"
+ ]
+ , testSimple "Existing package name" (packageNameHeuristics srcDb)
+ (mkPackageName "cabal-install")
+ [ "test-package"
+ , "cabal-install"
+ ]
+ ]
+ , testSimple "Check authorHeuristics output" authorHeuristics "Foobar"
+ [ ""
+ , "Foobar"
+ ]
+ , testSimple "Check emailHeuristics output" emailHeuristics "foobar@qux.com"
+ [ ""
+ , "foobar@qux.com"
+ ]
+ , testSimple "Check srcDirsHeuristics output" srcDirsHeuristics ["src"]
+ [ "src"
+ , "True"
+ ]
+ , testSimple "Check appDirsHeuristics output" appDirsHeuristics ["app"]
+ [ "test-package"
+ , "[\"test-package/app/\"]"
+ ]
+ , testGroup "Check packageTypeHeuristics output"
+ [ testSimple "Library" packageTypeHeuristics Library
+ [ "test-package"
+ , "[\".\", \"..\", \"test/Main.hs\", \"src/\"]"
+ ]
+ , testSimple "Executable" packageTypeHeuristics Executable
+ [ "test-package"
+ , "[\".\", \"..\", \"app/Main.hs\"]"
+ ]
+ , testSimple "Library and Executable" packageTypeHeuristics LibraryAndExecutable
+ [ "test-package"
+ , "[\".\", \"..\", \"src/\", \"app/Main.hs\"]"
+ ]
+ ]
+ , testGroup "Check cabalVersionHeuristics output"
+ [ testSimple "Broken command" cabalVersionHeuristics defaultCabalVersion
+ [""]
+ , testSimple "Proper answer" cabalVersionHeuristics CabalSpecV2_4
+ ["cabal-install version 2.4.0.0\ncompiled using version 2.4.0.0 of the Cabal library \n"]
+ ]
+ , testGroup "Check languageHeuristics output"
+ [ testSimple "No compiler at all" languageHeuristics Haskell2010
+ [""]
+ , testSimple "Higher version compiler" languageHeuristics Haskell2010
+ ["The Glorious Glasgow Haskell Compilation System, version 7.10.3"]
+ , testSimple "Lower version compiler" languageHeuristics Haskell98
+ ["The Glorious Glasgow Haskell Compilation System, version 6.4.2"]
+ ]
+ , testGroup "Check extraSourceFilesHeuristics output"
+ [ testSimple "No extra sources" extraSourceFilesHeuristics
+ (defaultChangelog NEL.:| [])
+ [ "test-package"
+ , "[]"
+ ]
+ , testSimple "Extra source files present" extraSourceFilesHeuristics
+ ("README.md" NEL.:| [])
+ [ "test-package"
+ , "[\"README.md\"]"
+ ]
+ ]
+ , testGroup "Check mainFileHeuristics output"
+ [ testSimple "No main file defined" mainFileHeuristics
+ (toHsFilePath "Main.hs")
+ [ "test-package"
+ , "[\"test-package/app/\"]"
+ , "[]"
+ ]
+ , testSimple "Main file already defined" mainFileHeuristics
+ (toHsFilePath "app/Main.hs")
+ [ "test-package"
+ , "[\"test-package/app/\"]"
+ , "[\"app/Main.hs\"]"
+ ]
+ , testSimple "Main lhs file already defined" mainFileHeuristics
+ (toHsFilePath "app/Main.lhs")
+ [ "test-package"
+ , "[\"test-package/app/\"]"
+ , "[\"app/Main.lhs\"]"
+ ]
+ ]
+ , testGroup "Check exposedModulesHeuristics output"
+ [ testSimple "Default exposed modules" exposedModulesHeuristics
+ (myLibModule NEL.:| [])
+ [ "src"
+ , "True"
+ , "[]"
+ , "test-package"
+ , "True"
+ , "[]"
+ ]
+ , testSimple "Contains exposed modules" exposedModulesHeuristics
+ (NEL.fromList $ map fromString ["Foo", "Bar"])
+ [ "src"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ ]
+ ]
+ , testGroup "Check libOtherModulesHeuristics output"
+ [ testSimple "Library directory exists" libOtherModulesHeuristics
+ (map fromString ["Baz.Internal"])
+ [ "test-package"
+ , "True"
+ , "[\"src/Foo.hs\", \"src/Bar.hs\", \"src/Baz/Internal.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ , "module Baz.Internal where"
+ ]
+ , testSimple "Library directory doesn't exist" libOtherModulesHeuristics []
+ [ "test-package"
+ , "False"
+ ]
+ ]
+ , testGroup "Check exeOtherModulesHeuristics output"
+ [ testSimple "Executable directory exists" exeOtherModulesHeuristics
+ (map fromString ["Foo", "Bar"])
+ [ "test-package"
+ , "True"
+ , "[\"app/Main.hs\", \"app/Foo.hs\", \"app/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ ]
+ , testSimple "Executable directory doesn't exist" exeOtherModulesHeuristics []
+ [ "test-package"
+ , "False"
+ ]
+ ]
+ , testGroup "Check testOtherModulesHeuristics output"
+ [ testSimple "Test directory exists" testOtherModulesHeuristics
+ (map fromString ["Foo", "Bar"])
+ [ "test-package"
+ , "True"
+ , "[\"test/Main.hs\", \"test/Foo.hs\", \"test/Bar.hs\"]"
+ , "module Foo where"
+ , "module Bar where"
+ ]
+ , testSimple "Test directory doesn't exist" testOtherModulesHeuristics []
+ [ "test-package"
+ , "False"
+ ]
+ ]
+ , testSimple "Check buildToolsHeuristics output" (`buildToolsHeuristics` "") ["happy"]
+ ["[\"app/Main.hs\", \"src/Foo.hs\", \"src/bar.y\"]"]
+ , testSimple "Check otherExtsHeuristics output" (`otherExtsHeuristics` "")
+ (map EnableExtension [OverloadedStrings, LambdaCase, RankNTypes, RecordWildCards])
+ [ "[\"src/Foo.hs\", \"src/Bar.hs\"]"
+ , "\"{-# LANGUAGE OverloadedStrings, LambdaCase #-}\n{-# LANGUAGE RankNTypes #-}\""
+ , "\"{-# LANGUAGE RecordWildCards #-}\""
+ ]
+
+ , testSimple "Check versionHeuristics output" versionHeuristics (mkVersion [0,1,0,0]) [""]
+ , testSimple "Check homepageHeuristics output" homepageHeuristics "" [""]
+ , testSimple "Check synopsisHeuristics output" synopsisHeuristics "" [""]
+ , testSimple "Check testDirsHeuristics output" testDirsHeuristics ["test"] [""]
+ , testSimple "Check categoryHeuristics output" categoryHeuristics "(none)" [""]
+ , testSimple "Check minimalHeuristics output" minimalHeuristics False [""]
+ , testSimple "Check overwriteHeuristics output" overwriteHeuristics False [""]
+ , testSimple "Check initializeTestSuiteHeuristics output" initializeTestSuiteHeuristics False [""]
+ , testSimple "Check licenseHeuristics output" licenseHeuristics SPDX.NONE [""]
+ ]
+ , testGroup "Bool heuristics tests"
+ [ testBool "Check noCommentsHeuristics output" noCommentsHeuristics False ""
+ ]
+ ]
+
+testSimple
+ :: Eq a
+ => Show a
+ => String
+ -> (InitFlags -> PurePrompt a)
+ -> a
+ -> [String]
+ -> TestTree
+testSimple label f target =
+ testGo label f (assertFailure . show) (\(a, _) -> target @=? a)
+
+testBool
+ :: String
+ -> (InitFlags -> PurePrompt Bool)
+ -> Bool
+ -> String
+ -> TestTree
+testBool label f target input =
+ testSimple label f target [input]
+
+testGo
+ :: Eq a
+ => Show a
+ => String
+ -> (InitFlags -> PurePrompt a)
+ -> (BreakException -> Assertion)
+ -> ((a, NEL.NonEmpty String) -> Assertion)
+ -> [String]
+ -> TestTree
+testGo label f g h inputs = testCase label $
+ case (_runPrompt $ f emptyFlags) (NEL.fromList inputs) of
+ Left x -> g x
+ Right x -> h x
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init/Simple.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init/Simple.hs
new file mode 100644
index 0000000000..059fc334c8
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init/Simple.hs
@@ -0,0 +1,151 @@
+module UnitTests.Distribution.Client.Init.Simple
+( tests
+) where
+
+
+import Prelude as P
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Distribution.Client.Init.Defaults
+import Distribution.Client.Init.Simple
+import Distribution.Client.Init.Types
+
+
+import Data.List.NonEmpty hiding (zip)
+import Distribution.Client.Types
+import Distribution.Simple.Compiler
+import Distribution.Simple.PackageIndex hiding (fromList)
+import Distribution.Types.PackageName
+import Distribution.Verbosity
+
+
+import UnitTests.Distribution.Client.Init.Utils
+import Distribution.Simple.Setup
+import qualified Data.List.NonEmpty as NEL
+import Distribution.Types.Dependency
+import Distribution.Client.Init.Utils (mkPackageNameDep)
+
+tests
+ :: Verbosity
+ -> InitFlags
+ -> Compiler
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> TestTree
+tests v _initFlags _comp pkgIx srcDb = testGroup "Distribution.Client.Init.Simple.hs"
+ [ simpleCreateProjectTests v pkgIx srcDb pkgName
+ ]
+ where
+ pkgName = mkPackageName "simple-test"
+
+simpleCreateProjectTests
+ :: Verbosity
+ -> InstalledPackageIndex
+ -> SourcePackageDb
+ -> PackageName
+ -> TestTree
+simpleCreateProjectTests v pkgIx srcDb pkgName =
+ testGroup "Simple createProject tests"
+ [ testCase "Simple lib createProject - no tests" $ do
+ let inputs = fromList
+ [ "1" -- package type: Library
+ , "simple-test" -- package dir (ignored, piped to current dir due to prompt monad)
+ , "n" -- no tests
+ ]
+
+ flags = emptyFlags { packageType = Flag Library }
+ settings = ProjectSettings
+ (WriteOpts False False False v "/home/test/1" Library pkgName)
+ (simplePkgDesc pkgName) (Just simpleLibTarget)
+ Nothing Nothing
+
+ case _runPrompt (createProject v pkgIx srcDb flags) inputs of
+ Left e -> assertFailure $ "Failed to create simple lib project: " ++ show e
+ Right (settings', _) -> settings @=? settings'
+
+ , testCase "Simple lib createProject - with tests" $ do
+ let inputs = fromList ["1", "simple-test", "y", "1"]
+ flags = emptyFlags { packageType = Flag Library }
+ settings = ProjectSettings
+ (WriteOpts False False False v "/home/test/1" Library pkgName)
+ (simplePkgDesc pkgName) (Just simpleLibTarget)
+ Nothing (Just $ simpleTestTarget (Just pkgName))
+
+ case _runPrompt (createProject v pkgIx srcDb flags) inputs of
+ Left e -> assertFailure $ "Failed to create simple lib (with tests)project: " ++ show e
+ Right (settings', _) -> settings @=? settings'
+
+ , testCase "Simple exe createProject" $ do
+ let inputs = fromList ["2", "simple-test"]
+ flags = emptyFlags { packageType = Flag Executable }
+ settings = ProjectSettings
+ (WriteOpts False False False v "/home/test/2" Executable pkgName)
+ (simplePkgDesc pkgName) Nothing
+ (Just $ simpleExeTarget Nothing) Nothing
+
+ case _runPrompt (createProject v pkgIx srcDb flags) inputs of
+ Left e -> assertFailure $ "Failed to create simple exe project: " ++ show e
+ Right (settings', _) -> settings @=? settings'
+
+ , testCase "Simple lib+exe createProject - no tests" $ do
+ let inputs = fromList ["2", "simple-test", "n"]
+ flags = emptyFlags { packageType = Flag LibraryAndExecutable }
+ settings = ProjectSettings
+ (WriteOpts False False False v "/home/test/2" LibraryAndExecutable pkgName)
+ (simplePkgDesc pkgName) (Just simpleLibTarget)
+ (Just $ simpleExeTarget (Just pkgName)) Nothing
+
+ case _runPrompt (createProject v pkgIx srcDb flags) inputs of
+ Left e -> assertFailure $ "Failed to create simple lib+exe project: " ++ show e
+ Right (settings', _) -> settings @=? settings'
+ , testCase "Simple lib+exe createProject - with tests" $ do
+ let inputs = fromList ["2", "simple-test", "y", "1"]
+ flags = emptyFlags { packageType = Flag LibraryAndExecutable }
+ settings = ProjectSettings
+ (WriteOpts False False False v "/home/test/2" LibraryAndExecutable pkgName)
+ (simplePkgDesc pkgName) (Just simpleLibTarget)
+ (Just $ simpleExeTarget (Just pkgName))
+ (Just $ simpleTestTarget (Just pkgName))
+
+ case _runPrompt (createProject v pkgIx srcDb flags) inputs of
+ Left e -> assertFailure $ "Failed to create simple lib+exe (with tests) project: " ++ show e
+ Right (settings', _) -> settings @=? settings'
+ ]
+
+-- -------------------------------------------------------------------- --
+-- Utils
+
+mkPkgDep :: Maybe PackageName -> [Dependency]
+mkPkgDep Nothing = []
+mkPkgDep (Just pn) = [mkPackageNameDep pn]
+
+simplePkgDesc :: PackageName -> PkgDescription
+simplePkgDesc pkgName = PkgDescription
+ defaultCabalVersion
+ pkgName
+ defaultVersion
+ defaultLicense
+ "" "" "" "" ""
+ (defaultChangelog NEL.:| [])
+
+simpleLibTarget :: LibTarget
+simpleLibTarget = LibTarget
+ [defaultSourceDir]
+ defaultLanguage
+ (myLibModule NEL.:| [])
+ [] [] [] []
+
+simpleExeTarget :: Maybe PackageName -> ExeTarget
+simpleExeTarget pn = ExeTarget
+ defaultMainIs
+ [defaultApplicationDir]
+ defaultLanguage
+ [] [] (mkPkgDep pn) []
+
+simpleTestTarget :: Maybe PackageName -> TestTarget
+simpleTestTarget pn = TestTarget
+ defaultMainIs
+ [defaultTestDir]
+ defaultLanguage
+ [] [] (mkPkgDep pn) []
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Init/Utils.hs b/cabal-install/tests/UnitTests/Distribution/Client/Init/Utils.hs
new file mode 100644
index 0000000000..199f6f6eb6
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Init/Utils.hs
@@ -0,0 +1,82 @@
+module UnitTests.Distribution.Client.Init.Utils
+( dummyFlags
+, emptyFlags
+, mkLicense
+, mangleBaseDep
+, (@?!)
+, (@!?)
+) where
+
+
+import Distribution.Client.Init.Types
+
+import qualified Distribution.SPDX as SPDX
+
+import Distribution.CabalSpecVersion
+import Distribution.Simple.Setup
+import Distribution.Types.PackageName
+import Distribution.Types.Version
+import Language.Haskell.Extension
+import Test.Tasty.HUnit
+import Distribution.Types.Dependency
+import Distribution.Types.VersionRange
+
+
+-- -------------------------------------------------------------------- --
+-- Test flags
+
+dummyFlags :: InitFlags
+dummyFlags = emptyFlags
+ { noComments = Flag True
+ , packageName = Flag (mkPackageName "QuxPackage")
+ , version = Flag (mkVersion [4,2,6])
+ , cabalVersion = Flag CabalSpecV2_2
+ , license = Flag $ SPDX.License $ SPDX.ELicense (SPDX.ELicenseId SPDX.MIT) Nothing
+ , author = Flag "Foobar"
+ , email = Flag "foobar@qux.com"
+ , homepage = Flag "qux.com"
+ , synopsis = Flag "We are Qux, and this is our package"
+ , category = Flag "Control"
+ , language = Flag Haskell98
+ , initializeTestSuite = Flag True
+ , sourceDirs = Flag ["quxSrc"]
+ , testDirs = Flag ["quxTest"]
+ , applicationDirs = Flag ["quxApp"]
+ }
+
+emptyFlags :: InitFlags
+emptyFlags = mempty
+
+-- -------------------------------------------------------------------- --
+-- Test utils
+
+mkLicense :: SPDX.LicenseId -> SPDX.License
+mkLicense lid = SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)
+
+mangleBaseDep :: a -> (a -> [Dependency]) -> [Dependency]
+mangleBaseDep target f =
+ [ if unPackageName x == "base"
+ then Dependency x anyVersion z
+ else dep
+ | dep@(Dependency x _ z) <- f target
+ ]
+
+infix 1 @?!, @!?
+
+-- | Just like @'@?='@, except it checks for difference rather than equality.
+(@?!)
+ :: (Eq a, Show a, HasCallStack)
+ => a
+ -> a
+ -> Assertion
+actual @?! unexpected = assertBool
+ ("unexpected: " ++ show unexpected)
+ (actual /= unexpected)
+
+-- | Just like @'@=?'@, except it checks for difference rather than equality.
+(@!?)
+ :: (Eq a, Show a, HasCallStack)
+ => a
+ -> a
+ -> Assertion
+(@!?) = flip (@?!)
diff --git a/cabal-install/tests/fixtures/init/exe-only-golden.cabal b/cabal-install/tests/fixtures/init/exe-only-golden.cabal
deleted file mode 100644
index 8887173111..0000000000
--- a/cabal-install/tests/fixtures/init/exe-only-golden.cabal
+++ /dev/null
@@ -1,20 +0,0 @@
-cabal-version: 2.4
-name: foo
-version: 3.2.1
-synopsis: The foo package
-homepage: https://github.com/foo/foo
-license: NONE
-author: me
-maintainer: me@me.me
-category: SomeCat
-extra-source-files: CHANGELOG.md
-
-executable foo
- main-is: Main.hs
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
-
- hs-source-dirs: app
- default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
new file mode 100644
index 0000000000..8c75394d2c
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
@@ -0,0 +1,61 @@
+cabal-version: 2.4
+name: y
+version: 0.1.0.0
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+homepage: home
+license: BSD-3-Clause
+license-file: LICENSE
+author: foo-kmett
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+extra-source-files: CHANGELOG.md
+
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base
+ hs-source-dirs: src
+ default-language: Haskell98
+
+executable y
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends:
+ base,
+ y
+
+ hs-source-dirs: exe
+ default-language: Haskell2010
+
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends:
+ base,
+ y
+
diff --git a/cabal-install/tests/fixtures/init/lib-exe-and-test-with-comments-golden.cabal b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
similarity index 65%
rename from cabal-install/tests/fixtures/init/lib-exe-and-test-with-comments-golden.cabal
rename to cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
index adfaea7733..f0b2b216bd 100644
--- a/cabal-install/tests/fixtures/init/lib-exe-and-test-with-comments-golden.cabal
+++ b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
@@ -1,54 +1,53 @@
cabal-version: 2.4
--- Initial package description 'lib-exe-and-test-with-comments-golden.cabal' generated by
+-- Initial package description 'y' generated by
-- 'cabal init'. For further documentation, see:
-- http://haskell.org/cabal/users-guide/
--
-- The name of the package.
-name: foo
+name: y
-- The package version.
-- See the Haskell package versioning policy (PVP) for standards
-- guiding when and how versions should be incremented.
-- https://pvp.haskell.org
--- PVP summary: +-+------- breaking API changes
--- | | +----- non-breaking API additions
--- | | | +--- code changes with no API change
-version: 3.2.1
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
-- A short (one-line) description of the package.
-synopsis: The foo package
+synopsis: synopsis
-- A longer description of the package.
-- description:
-- URL for the project homepage or repository.
-homepage: https://github.com/foo/foo
-
--- A URL where users can report bugs.
--- bug-reports:
+homepage: home
-- The license under which the package is released.
-license: NONE
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
-- The package author(s).
-author: me
+author: foo-kmett
-- An email address to which users can send suggestions, bug reports, and patches.
-maintainer: me@me.me
+maintainer: foo-kmett@kmett.kmett
-- A copyright notice.
-- copyright:
-category: SomeCat
+category: Data
+build-type: Simple
-- Extra files to be distributed with the package, such as examples or a README.
extra-source-files: CHANGELOG.md
library
-- Modules exported by the library.
- exposed-modules:
- A
- B
+ exposed-modules: MyLib
-- Modules included in this library but not exported.
-- other-modules:
@@ -57,18 +56,15 @@ library
-- other-extensions:
-- Other library packages from which modules are imported.
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
+ build-depends: base
-- Directories containing source files.
hs-source-dirs: src
-- Base language which the package is written in.
- default-language: Haskell2010
+ default-language: Haskell98
-executable foo
+executable y
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
@@ -80,31 +76,36 @@ executable foo
-- Other library packages from which modules are imported.
build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
+ base,
+ y
-- Directories containing source files.
- hs-source-dirs: app
+ hs-source-dirs: exe
-- Base language which the package is written in.
default-language: Haskell2010
-test-suite foo-test
+test-suite y-test
-- Base language which the package is written in.
default-language: Haskell2010
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
-- The interface type and version of the test suite.
type: exitcode-stdio-1.0
-- Directories containing source files.
- hs-source-dirs: tests
+ hs-source-dirs: test
-- The entrypoint to the test suite.
- main-is: MyLibTest.hs
+ main-is: Main.hs
-- Test dependencies.
build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
+ base,
+ y
+
diff --git a/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
new file mode 100644
index 0000000000..336bd3fb21
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+name: y
+version: 0.1.0.0
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+homepage: home
+license: BSD-3-Clause
+license-file: LICENSE
+author: foo-kmett
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+extra-source-files: CHANGELOG.md
+
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base
+ hs-source-dirs: src
+ default-language: Haskell98
+
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends:
+ base,
+ y
+
diff --git a/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
new file mode 100644
index 0000000000..14b06a911c
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
@@ -0,0 +1,90 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
+
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
+
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends:
+ base,
+ y
+
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden b/cabal-install/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
new file mode 100644
index 0000000000..cbf34dde76
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
@@ -0,0 +1,21 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden b/cabal-install/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
new file mode 100644
index 0000000000..88d69ab18d
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
@@ -0,0 +1,5 @@
+executable y
+ main-is: Main.hs
+ build-depends: base
+ hs-source-dirs: exe
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden b/cabal-install/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
new file mode 100644
index 0000000000..19fdb84a1a
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
@@ -0,0 +1,12 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe-simple.golden b/cabal-install/tests/fixtures/init/golden/exe/exe-simple.golden
new file mode 100644
index 0000000000..e6dfaa77eb
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe-simple.golden
@@ -0,0 +1,13 @@
+executable y
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ -- build-depends:
+ hs-source-dirs: app
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe-with-comments.golden b/cabal-install/tests/fixtures/init/golden/exe/exe-with-comments.golden
new file mode 100644
index 0000000000..deb7bb063d
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe-with-comments.golden
@@ -0,0 +1,18 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/exe/exe.golden b/cabal-install/tests/fixtures/init/golden/exe/exe.golden
new file mode 100644
index 0000000000..3f4d9c54fe
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/exe/exe.golden
@@ -0,0 +1,11 @@
+executable y
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base
+ hs-source-dirs: exe
+ default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden b/cabal-install/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
new file mode 100644
index 0000000000..436ed85d09
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
@@ -0,0 +1,21 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden b/cabal-install/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
new file mode 100644
index 0000000000..99e5d7fffb
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
@@ -0,0 +1,5 @@
+library
+ exposed-modules: MyLib
+ build-depends: base
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden b/cabal-install/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
new file mode 100644
index 0000000000..5583deefa1
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
@@ -0,0 +1,12 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib-simple.golden b/cabal-install/tests/fixtures/init/golden/lib/lib-simple.golden
new file mode 100644
index 0000000000..8dd9dbcecb
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib-simple.golden
@@ -0,0 +1,11 @@
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib-with-comments.golden b/cabal-install/tests/fixtures/init/golden/lib/lib-with-comments.golden
new file mode 100644
index 0000000000..d64fb60b61
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib-with-comments.golden
@@ -0,0 +1,18 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/lib/lib.golden b/cabal-install/tests/fixtures/init/golden/lib/lib.golden
new file mode 100644
index 0000000000..8dd9dbcecb
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/lib/lib.golden
@@ -0,0 +1,11 @@
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
new file mode 100644
index 0000000000..776f6abd32
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
@@ -0,0 +1,45 @@
+cabal-version: 2.0
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: QuxPackage
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 4.2.6
+
+-- A short (one-line) description of the package.
+synopsis: We are Qux, and this is our package
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: qux.com
+
+-- The license under which the package is released.
+license: MIT
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Foobar
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foobar@qux.com
+
+-- A copyright notice.
+-- copyright:
+category: Control
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-simple.golden b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-simple.golden
new file mode 100644
index 0000000000..b44bf49512
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-simple.golden
@@ -0,0 +1,21 @@
+cabal-version: 3.0
+name: 4
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+license: NONE
+
+-- The package author(s).
+-- author:
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+-- maintainer:
+
+-- A copyright notice.
+-- copyright:
+build-type: Simple
+extra-source-files: CHANGELOG.md
diff --git a/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
new file mode 100644
index 0000000000..47924235c7
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
new file mode 100644
index 0000000000..52613c0f0d
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.2
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: QuxPackage
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 4.2.6
+
+-- A short (one-line) description of the package.
+synopsis: We are Qux, and this is our package
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: qux.com
+
+-- The license under which the package is released.
+license: MIT
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Foobar
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foobar@qux.com
+
+-- A copyright notice.
+-- copyright:
+category: Control
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg.golden b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg.golden
new file mode 100644
index 0000000000..47924235c7
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/pkg-desc/pkg.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/cabal-install/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden b/cabal-install/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
new file mode 100644
index 0000000000..5171d02708
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
@@ -0,0 +1,24 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
diff --git a/cabal-install/tests/fixtures/init/golden/test/test-minimal-no-comments.golden b/cabal-install/tests/fixtures/init/golden/test/test-minimal-no-comments.golden
new file mode 100644
index 0000000000..b092956a6d
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test-minimal-no-comments.golden
@@ -0,0 +1,6 @@
+test-suite y-test
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends: base
diff --git a/cabal-install/tests/fixtures/init/golden/test/test-simple-with-comments.golden b/cabal-install/tests/fixtures/init/golden/test/test-simple-with-comments.golden
new file mode 100644
index 0000000000..6388f8583d
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test-simple-with-comments.golden
@@ -0,0 +1,15 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base
diff --git a/cabal-install/tests/fixtures/init/golden/test/test-simple.golden b/cabal-install/tests/fixtures/init/golden/test/test-simple.golden
new file mode 100644
index 0000000000..44095ab9a9
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test-simple.golden
@@ -0,0 +1,14 @@
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+
+ -- Test dependencies.
+ -- build-depends:
diff --git a/cabal-install/tests/fixtures/init/golden/test/test-with-comments.golden b/cabal-install/tests/fixtures/init/golden/test/test-with-comments.golden
new file mode 100644
index 0000000000..2381ebd092
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test-with-comments.golden
@@ -0,0 +1,21 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base
diff --git a/cabal-install/tests/fixtures/init/golden/test/test.golden b/cabal-install/tests/fixtures/init/golden/test/test.golden
new file mode 100644
index 0000000000..7a36e096fb
--- /dev/null
+++ b/cabal-install/tests/fixtures/init/golden/test/test.golden
@@ -0,0 +1,12 @@
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends: base
diff --git a/cabal-install/tests/fixtures/init/lib-and-exe-golden.cabal b/cabal-install/tests/fixtures/init/lib-and-exe-golden.cabal
deleted file mode 100644
index d90c89bed1..0000000000
--- a/cabal-install/tests/fixtures/init/lib-and-exe-golden.cabal
+++ /dev/null
@@ -1,31 +0,0 @@
-cabal-version: 2.4
-name: foo
-version: 3.2.1
-synopsis: The foo package
-homepage: https://github.com/foo/foo
-license: NONE
-author: me
-maintainer: me@me.me
-category: SomeCat
-extra-source-files: CHANGELOG.md
-
-library
- exposed-modules: MyLib
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
-
- hs-source-dirs: src
- default-language: Haskell2010
-
-executable foo
- main-is: Main.hs
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0,
- foo
-
- hs-source-dirs: app
- default-language: Haskell2010
diff --git a/cabal-install/tests/fixtures/init/lib-exe-and-test-golden.cabal b/cabal-install/tests/fixtures/init/lib-exe-and-test-golden.cabal
deleted file mode 100644
index 924237c2de..0000000000
--- a/cabal-install/tests/fixtures/init/lib-exe-and-test-golden.cabal
+++ /dev/null
@@ -1,43 +0,0 @@
-cabal-version: 2.4
-name: foo
-version: 3.2.1
-synopsis: The foo package
-homepage: https://github.com/foo/foo
-license: NONE
-author: me
-maintainer: me@me.me
-category: SomeCat
-extra-source-files: CHANGELOG.md
-
-library
- exposed-modules:
- A
- B
-
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
-
- hs-source-dirs: src
- default-language: Haskell2010
-
-executable foo
- main-is: Main.hs
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
-
- hs-source-dirs: app
- default-language: Haskell2010
-
-test-suite foo-test
- default-language: Haskell2010
- type: exitcode-stdio-1.0
- hs-source-dirs: tests
- main-is: MyLibTest.hs
- build-depends:
- base ^>=4.13.0.0,
- containers ^>=5.7.0.0,
- unordered-containers ^>=2.7.0.0
diff --git a/cabal.project b/cabal.project
index e07642f2a2..fd4b237b37 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,7 +1,8 @@
packages: Cabal/ cabal-testsuite/
-packages: cabal-install-solver/
packages: cabal-install/
+packages: cabal-install-solver/
packages: solver-benchmarks/
+
tests: True
packages: Cabal-QuickCheck/
diff --git a/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden b/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
new file mode 100644
index 0000000000..32e4d1ca85
--- /dev/null
+++ b/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-no-comments.golden
@@ -0,0 +1,61 @@
+cabal-version: 2.4
+name: y
+version: 0.1.0.0
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+homepage: home
+license: BSD-3-Clause
+license-file: LICENSE
+author: foo-kmett
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+extra-source-files: CHANGELOG.md
+
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: src
+ default-language: Haskell98
+
+executable y
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
+ hs-source-dirs: exe
+ default-language: Haskell2010
+
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
diff --git a/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden b/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
new file mode 100644
index 0000000000..7dcde8264b
--- /dev/null
+++ b/tests/fixtures/init/golden/cabal/cabal-lib-and-exe-with-comments.golden
@@ -0,0 +1,111 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
+
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
+
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
diff --git a/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden b/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
new file mode 100644
index 0000000000..6cceb21854
--- /dev/null
+++ b/tests/fixtures/init/golden/cabal/cabal-lib-no-comments.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+name: y
+version: 0.1.0.0
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+homepage: home
+license: BSD-3-Clause
+license-file: LICENSE
+author: foo-kmett
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+extra-source-files: CHANGELOG.md
+
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: src
+ default-language: Haskell98
+
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
diff --git a/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden b/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
new file mode 100644
index 0000000000..0ec5e6be0e
--- /dev/null
+++ b/tests/fixtures/init/golden/cabal/cabal-lib-with-comments.golden
@@ -0,0 +1,90 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
+
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
+
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends:
+ base ^>=4.14.1.0,
+ y
+
diff --git a/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden b/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
new file mode 100644
index 0000000000..b2e9986812
--- /dev/null
+++ b/tests/fixtures/init/golden/exe/exe-build-tools-with-comments.golden
@@ -0,0 +1,21 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden b/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
new file mode 100644
index 0000000000..35810f1662
--- /dev/null
+++ b/tests/fixtures/init/golden/exe/exe-minimal-no-comments.golden
@@ -0,0 +1,5 @@
+executable y
+ main-is: Main.hs
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: exe
+ default-language: Haskell2010
diff --git a/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden b/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
new file mode 100644
index 0000000000..a791a4a0ee
--- /dev/null
+++ b/tests/fixtures/init/golden/exe/exe-simple-with-comments.golden
@@ -0,0 +1,12 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/tests/fixtures/init/golden/exe/exe-with-comments.golden b/tests/fixtures/init/golden/exe/exe-with-comments.golden
new file mode 100644
index 0000000000..d7a0a16e9b
--- /dev/null
+++ b/tests/fixtures/init/golden/exe/exe-with-comments.golden
@@ -0,0 +1,18 @@
+executable y
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: exe
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/tests/fixtures/init/golden/exe/exe.golden b/tests/fixtures/init/golden/exe/exe.golden
new file mode 100644
index 0000000000..c61210c04e
--- /dev/null
+++ b/tests/fixtures/init/golden/exe/exe.golden
@@ -0,0 +1,11 @@
+executable y
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: exe
+ default-language: Haskell2010
diff --git a/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden b/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
new file mode 100644
index 0000000000..8d41c633f6
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib-build-tools-with-comments.golden
@@ -0,0 +1,21 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden b/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
new file mode 100644
index 0000000000..64c71f8031
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib-minimal-no-comments.golden
@@ -0,0 +1,5 @@
+library
+ exposed-modules: MyLib
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden b/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
new file mode 100644
index 0000000000..f6daa32841
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib-simple-with-comments.golden
@@ -0,0 +1,12 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/lib/lib-simple.golden b/tests/fixtures/init/golden/lib/lib-simple.golden
new file mode 100644
index 0000000000..6127151806
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib-simple.golden
@@ -0,0 +1,11 @@
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/lib/lib-with-comments.golden b/tests/fixtures/init/golden/lib/lib-with-comments.golden
new file mode 100644
index 0000000000..84ba9445f2
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib-with-comments.golden
@@ -0,0 +1,18 @@
+library
+ -- Modules exported by the library.
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base ^>=4.14.1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/lib/lib.golden b/tests/fixtures/init/golden/lib/lib.golden
new file mode 100644
index 0000000000..6127151806
--- /dev/null
+++ b/tests/fixtures/init/golden/lib/lib.golden
@@ -0,0 +1,11 @@
+library
+ exposed-modules: MyLib
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0
+ hs-source-dirs: src
+ default-language: Haskell98
diff --git a/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden b/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
new file mode 100644
index 0000000000..776f6abd32
--- /dev/null
+++ b/tests/fixtures/init/golden/pkg-desc/pkg-old-cabal-with-flags.golden
@@ -0,0 +1,45 @@
+cabal-version: 2.0
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: QuxPackage
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 4.2.6
+
+-- A short (one-line) description of the package.
+synopsis: We are Qux, and this is our package
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: qux.com
+
+-- The license under which the package is released.
+license: MIT
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Foobar
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foobar@qux.com
+
+-- A copyright notice.
+-- copyright:
+category: Control
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden b/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
new file mode 100644
index 0000000000..47924235c7
--- /dev/null
+++ b/tests/fixtures/init/golden/pkg-desc/pkg-with-comments.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden b/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
new file mode 100644
index 0000000000..52613c0f0d
--- /dev/null
+++ b/tests/fixtures/init/golden/pkg-desc/pkg-with-flags.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.2
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: QuxPackage
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 4.2.6
+
+-- A short (one-line) description of the package.
+synopsis: We are Qux, and this is our package
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: qux.com
+
+-- The license under which the package is released.
+license: MIT
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Foobar
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foobar@qux.com
+
+-- A copyright notice.
+-- copyright:
+category: Control
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/tests/fixtures/init/golden/pkg-desc/pkg.golden b/tests/fixtures/init/golden/pkg-desc/pkg.golden
new file mode 100644
index 0000000000..47924235c7
--- /dev/null
+++ b/tests/fixtures/init/golden/pkg-desc/pkg.golden
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+
+-- Initial package description 'y' generated by
+-- 'cabal init'. For further documentation, see:
+-- http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name: y
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis: synopsis
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage: home
+
+-- The license under which the package is released.
+license: BSD-3-Clause
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: foo-kmett
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer: foo-kmett@kmett.kmett
+
+-- A copyright notice.
+-- copyright:
+category: Data
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a README.
+extra-source-files: CHANGELOG.md
diff --git a/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden b/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
new file mode 100644
index 0000000000..1377709f29
--- /dev/null
+++ b/tests/fixtures/init/golden/test/test-build-tools-with-comments.golden
@@ -0,0 +1,24 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base ^>=4.14.1.0
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ build-tools: happy
diff --git a/tests/fixtures/init/golden/test/test-minimal-no-comments.golden b/tests/fixtures/init/golden/test/test-minimal-no-comments.golden
new file mode 100644
index 0000000000..b7560beb96
--- /dev/null
+++ b/tests/fixtures/init/golden/test/test-minimal-no-comments.golden
@@ -0,0 +1,6 @@
+test-suite y-test
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends: base ^>=4.14.1.0
diff --git a/tests/fixtures/init/golden/test/test-simple-with-comments.golden b/tests/fixtures/init/golden/test/test-simple-with-comments.golden
new file mode 100644
index 0000000000..0ebefd519b
--- /dev/null
+++ b/tests/fixtures/init/golden/test/test-simple-with-comments.golden
@@ -0,0 +1,15 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base ^>=4.14.1.0
diff --git a/tests/fixtures/init/golden/test/test-with-comments.golden b/tests/fixtures/init/golden/test/test-with-comments.golden
new file mode 100644
index 0000000000..df91ae8426
--- /dev/null
+++ b/tests/fixtures/init/golden/test/test-with-comments.golden
@@ -0,0 +1,21 @@
+test-suite y-test
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- The interface type and version of the test suite.
+ type: exitcode-stdio-1.0
+
+ -- Directories containing source files.
+ hs-source-dirs: test
+
+ -- The entrypoint to the test suite.
+ main-is: Main.hs
+
+ -- Test dependencies.
+ build-depends: base ^>=4.14.1.0
diff --git a/tests/fixtures/init/golden/test/test.golden b/tests/fixtures/init/golden/test/test.golden
new file mode 100644
index 0000000000..6bafb43887
--- /dev/null
+++ b/tests/fixtures/init/golden/test/test.golden
@@ -0,0 +1,12 @@
+test-suite y-test
+ default-language: Haskell2010
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
+ build-depends: base ^>=4.14.1.0
--
GitLab