diff --git a/Cabal/Distribution/Fields/Pretty.hs b/Cabal/Distribution/Fields/Pretty.hs index 4b038264fa9..f34c6577d4b 100644 --- a/Cabal/Distribution/Fields/Pretty.hs +++ b/Cabal/Distribution/Fields/Pretty.hs @@ -34,6 +34,7 @@ import qualified Text.PrettyPrint as PP data PrettyField ann = PrettyField ann FieldName PP.Doc + | PrettyFieldCommentedOut ann FieldName | PrettySection ann FieldName [PP.Doc] [PrettyField ann] deriving (Functor, Foldable, Traversable) @@ -72,6 +73,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 (PrettyFieldCommentedOut _ _ : rest) = maxNameLength acc rest maxNameLength !acc (PrettySection {} : rest) = maxNameLength acc rest -- | Block of lines, @@ -115,6 +117,12 @@ renderField (Opts rann indent) fw (PrettyField ann name doc) = narrowStyle :: PP.Style narrowStyle = PP.style { PP.lineLength = PP.lineLength PP.style - fw } +renderField (Opts rann _) _ (PrettyFieldCommentedOut ann name) = + Block NoMargin NoMargin $ comments ++ fieldLine + where + comments = rann ann + fieldLine = [ "-- " ++ fromUTF8BS name ++ ":" ] + renderField opts@(Opts rann indent) _ (PrettySection ann name args fields) = Block Margin Margin $ rann ann ++ diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs index 65acced3fac..2a3c6c2d1b5 100644 --- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -24,6 +24,14 @@ module Distribution.PackageDescription.FieldGrammar ( benchmarkFieldGrammar, validateBenchmark, unvalidateBenchmark, + -- * Field formatters + formatDependencyList, + formatExposedModules, + formatExtraSourceFiles, + formatHsSourceDirs, + formatMixinList, + formatOtherExtensions, + formatOtherModules, -- ** Lenses benchmarkStanzaBenchmarkType, benchmarkStanzaMainIs, @@ -41,6 +49,7 @@ module Distribution.PackageDescription.FieldGrammar ( import Distribution.Compat.Lens import Distribution.Compat.Prelude +import Language.Haskell.Extension import Prelude () import Distribution.CabalSpecVersion @@ -57,6 +66,7 @@ import Distribution.Types.ExecutableScope import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType import Distribution.Types.LibraryVisibility +import Distribution.Types.Mixin import Distribution.Types.UnqualComponentName import qualified Distribution.SPDX as SPDX @@ -100,7 +110,7 @@ packageDescriptionFieldGrammar = PackageDescription -- * Files <*> monoidalFieldAla "data-files" (alaList' VCat FilePathNT) L.dataFiles <*> optionalFieldDefAla "data-dir" FilePathNT L.dataDir "" - <*> monoidalFieldAla "extra-source-files" (alaList' VCat FilePathNT) L.extraSrcFiles + <*> monoidalFieldAla "extra-source-files" formatExtraSourceFiles L.extraSrcFiles <*> monoidalFieldAla "extra-tmp-files" (alaList' VCat FilePathNT) L.extraTmpFiles <*> monoidalFieldAla "extra-doc-files" (alaList' VCat FilePathNT) L.extraDocFiles where @@ -125,7 +135,7 @@ libraryFieldGrammar => LibraryName -> g Library Library libraryFieldGrammar n = Library n - <$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules + <$> monoidalFieldAla "exposed-modules" formatExposedModules L.exposedModules <*> monoidalFieldAla "reexported-modules" (alaList CommaVCat) L.reexportedModules <*> monoidalFieldAla "signatures" (alaList' VCat MQuoted) L.signatures ^^^ availableSince CabalSpecV2_0 [] @@ -408,14 +418,14 @@ buildInfoFieldGrammar = BuildInfo ^^^ availableSince CabalSpecV2_2 [] <*> monoidalFieldAla "js-sources" (alaList' VCat FilePathNT) L.jsSources <*> hsSourceDirsGrammar - <*> monoidalFieldAla "other-modules" (alaList' VCat MQuoted) L.otherModules + <*> monoidalFieldAla "other-modules" formatOtherModules L.otherModules <*> monoidalFieldAla "virtual-modules" (alaList' VCat MQuoted) L.virtualModules ^^^ availableSince CabalSpecV2_2 [] <*> monoidalFieldAla "autogen-modules" (alaList' VCat MQuoted) L.autogenModules <*> optionalFieldAla "default-language" MQuoted L.defaultLanguage <*> monoidalFieldAla "other-languages" (alaList' FSep MQuoted) L.otherLanguages <*> monoidalFieldAla "default-extensions" (alaList' FSep MQuoted) L.defaultExtensions - <*> monoidalFieldAla "other-extensions" (alaList' FSep MQuoted) L.otherExtensions + <*> monoidalFieldAla "other-extensions" formatOtherExtensions L.otherExtensions <*> monoidalFieldAla "extensions" (alaList' FSep MQuoted) L.oldExtensions ^^^ deprecatedSince CabalSpecV1_12 "Please use 'default-extensions' or 'other-extensions' fields." @@ -438,8 +448,8 @@ buildInfoFieldGrammar = BuildInfo <*> sharedOptionsFieldGrammar <*> pure mempty -- static-options ??? <*> prefixedFields "x-" L.customFieldsBI - <*> monoidalFieldAla "build-depends" (alaList CommaVCat) L.targetBuildDepends - <*> monoidalFieldAla "mixins" (alaList CommaVCat) L.mixins + <*> monoidalFieldAla "build-depends" formatDependencyList L.targetBuildDepends + <*> monoidalFieldAla "mixins" formatMixinList L.mixins ^^^ availableSince CabalSpecV2_0 [] {-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-} {-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-} @@ -448,7 +458,7 @@ hsSourceDirsGrammar :: (FieldGrammar g, Applicative (g BuildInfo)) => g BuildInfo [FilePath] hsSourceDirsGrammar = (++) - <$> monoidalFieldAla "hs-source-dirs" (alaList' FSep FilePathNT) L.hsSourceDirs + <$> monoidalFieldAla "hs-source-dirs" formatHsSourceDirs L.hsSourceDirs <*> monoidalFieldAla "hs-source-dir" (alaList' FSep FilePathNT) wrongLens --- https://github.com/haskell/cabal/commit/49e3cdae3bdf21b017ccd42e66670ca402e22b44 ^^^ deprecatedSince CabalSpecV1_2 "Please use 'hs-source-dirs'" @@ -542,3 +552,28 @@ setupBInfoFieldGrammar def = flip SetupBuildInfo def <$> monoidalFieldAla "setup-depends" (alaList CommaVCat) L.setupDepends {-# SPECIALIZE setupBInfoFieldGrammar :: Bool -> ParsecFieldGrammar' SetupBuildInfo #-} {-# SPECIALIZE setupBInfoFieldGrammar :: Bool ->PrettyFieldGrammar' SetupBuildInfo #-} + +------------------------------------------------------------------------------- +-- Field formatters - Define how field values should be formatted for 'pretty'. +------------------------------------------------------------------------------- + +formatDependencyList :: [Dependency] -> List CommaVCat (Identity Dependency) Dependency +formatDependencyList = alaList CommaVCat + +formatMixinList :: [Mixin] -> List CommaVCat (Identity Mixin) Mixin +formatMixinList = alaList CommaVCat + +formatExtraSourceFiles :: [FilePath] -> List VCat FilePathNT FilePath +formatExtraSourceFiles = alaList' VCat FilePathNT + +formatExposedModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName +formatExposedModules = alaList' VCat MQuoted + +formatHsSourceDirs :: [FilePath] -> List FSep FilePathNT FilePath +formatHsSourceDirs = alaList' FSep FilePathNT + +formatOtherExtensions :: [Extension] -> List FSep (MQuoted Extension) Extension +formatOtherExtensions = alaList' FSep MQuoted + +formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName +formatOtherModules = alaList' VCat MQuoted diff --git a/cabal-install/Distribution/Client/Init/Command.hs b/cabal-install/Distribution/Client/Init/Command.hs index 07ad2b1913d..056414440b6 100644 --- a/cabal-install/Distribution/Client/Init/Command.hs +++ b/cabal-install/Distribution/Client/Init/Command.hs @@ -67,7 +67,7 @@ import Distribution.Client.Init.Prompt ( prompt, promptYesNo, promptStr, promptList, maybePrompt , promptListOptional ) import Distribution.Client.Init.Utils - ( eligibleForTestSuite, message ) + ( eligibleForTestSuite, message ) import Distribution.Client.Init.Types ( InitFlags(..), PackageType(..), Category(..) , displayPackageType ) @@ -76,6 +76,8 @@ import Distribution.Client.Init.Heuristics SourceFileEntry(..), scanForModules, neededBuildPrograms ) +import Distribution.Simple.Flag + ( maybeToFlag ) import Distribution.Simple.Setup ( Flag(..), flagToMaybe ) import Distribution.Simple.Configure @@ -169,10 +171,6 @@ f ?>> g = do then return ma else g --- | Witness the isomorphism between Maybe and Flag. -maybeToFlag :: Maybe a -> Flag a -maybeToFlag = maybe NoFlag Flag - -- | Ask if a simple project with sensible defaults should be created. getSimpleProject :: InitFlags -> IO InitFlags getSimpleProject flags = do diff --git a/cabal-install/Distribution/Client/Init/FileCreators.hs b/cabal-install/Distribution/Client/Init/FileCreators.hs index 2a8317bd0ec..f55fbee6c93 100644 --- a/cabal-install/Distribution/Client/Init/FileCreators.hs +++ b/cabal-install/Distribution/Client/Init/FileCreators.hs @@ -33,6 +33,15 @@ import Distribution.Client.Compat.Prelude hiding (empty) import System.FilePath ( (), (<.>), takeExtension ) +import qualified Data.Set as Set + +import Distribution.Pretty (Pretty, pretty) +import Distribution.Types.Dependency +import Distribution.Types.LibraryName + ( LibraryName(LMainLibName) ) +import Distribution.Types.VersionRange + + import Control.Monad ( forM_ ) import Data.Time @@ -59,12 +68,19 @@ import Distribution.License ( licenseFromSPDX ) import qualified Distribution.ModuleName as ModuleName ( toFilePath ) -import qualified Distribution.Package as P - ( unPackageName ) +import Distribution.Parsec.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 - ( dropWhileEndLE ) + ( toUTF8BS ) +import Distribution.Fields.Pretty + ( PrettyField(..), showFields ) import Distribution.Pretty ( prettyShow ) @@ -327,145 +343,143 @@ findNewName oldName = findNewName' 0 e <- doesFileExist newName if e then findNewName' (n+1) else return newName --- | Generate a .cabal file from an InitFlags structure. NOTE: this --- is rather ad-hoc! What we would REALLY like is to have a --- standard low-level AST type representing .cabal files, which --- preserves things like comments, and to write an *inverse* --- parser/pretty-printer pair between .cabal files and this AST. --- Then instead of this ad-hoc code we could just map an InitFlags --- structure onto a low-level AST structure and use the existing --- pretty-printing code to generate the file. + +-- | Generate a .cabal file from an InitFlags structure. generateCabalFile :: String -> InitFlags -> String -generateCabalFile fileName c = trimTrailingWS $ - (++ "\n") . - renderStyle style { lineLength = 79, ribbonsPerLine = 1.1 } $ - -- Starting with 2.2 the `cabal-version` field needs to be the first line of the PD - (if specVer < CabalSpecV1_12 - then fieldS "cabal-version" (Flag $ ">=" ++ showCabalSpecVersion specVer) - else fieldS "cabal-version" (Flag $ showCabalSpecVersion specVer)) - Nothing +generateCabalFile fileName c = + showFields id $ catMaybes + [ fieldP "cabal-version" (Flag . SpecVersion $ specVer) + [] False - $$ - (if minimal c /= Flag True - then showComment (Just $ "Initial package description '" ++ fileName ++ "' generated " - ++ "by 'cabal init'. For further documentation, see " - ++ "http://haskell.org/cabal/users-guide/") - $$ text "" - else empty) - $$ - vcat [ field "name" (packageName c) - (Just "The name of the package.") - True - - , field "version" (version c) - (Just $ "The package version. See the Haskell package versioning policy (PVP) for standards guiding when and how versions should be incremented.\nhttps://pvp.haskell.org\n" - ++ "PVP summary: +-+------- breaking API changes\n" - ++ " | | +----- non-breaking API additions\n" - ++ " | | | +--- code changes with no API change") - True - - , fieldS "synopsis" (synopsis c) - (Just "A short (one-line) description of the package.") - True - , fieldS "description" NoFlag - (Just "A longer description of the package.") + , 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 - , fieldS "homepage" (homepage c) - (Just "URL for the project homepage or repository.") - False + , case license c of + NoFlag -> Nothing + Flag SPDX.NONE -> Nothing + _ -> fieldS "license-file" (Flag "LICENSE") + ["The file containing the license text."] + True - , fieldS "bug-reports" NoFlag - (Just "A URL where users can report bugs.") - True + , fieldS "author" (author c) + ["The package author(s)."] + True - , fieldS "license" licenseStr - (Just "The license under which the package is released.") - True + , fieldS "maintainer" (email c) + ["An email address to which users can send suggestions, bug reports, and patches."] + True - , case license c of - NoFlag -> empty - Flag SPDX.NONE -> empty - _ -> fieldS "license-file" (Flag "LICENSE") - (Just "The file containing the license text.") - True + , fieldS "copyright" NoFlag + ["A copyright notice."] + True - , fieldS "author" (author c) - (Just "The package author(s).") - True - - , fieldS "maintainer" (email c) - (Just "An email address to which users can send suggestions, bug reports, and patches.") - True - - , fieldS "copyright" NoFlag - (Just "A copyright notice.") - True - - , fieldS "category" (either id display `fmap` category c) - Nothing - True + , fieldS "category" (either id display `fmap` category c) + [] + True - , fieldS "build-type" (if specVer >= CabalSpecV2_2 then NoFlag else Flag "Simple") - Nothing - False + , fieldS "build-type" (if specVer >= CabalSpecV2_2 then NoFlag else Flag "Simple") + [] + False - , fieldS "extra-source-files" (listFieldS (extraSrc c)) - (Just "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 - _ -> empty + , fieldP "extra-source-files" (maybeToFlag $ (formatExtraSourceFiles <$> 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 eligibleForTestSuite c then testSuiteStanza else empty - ] where + specVer :: CabalSpecVersion specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c) licenseStr | specVer < CabalSpecV2_2 = prettyShow . licenseFromSPDX <$> license c | otherwise = prettyShow <$> license c - generateBuildInfo :: BuildType -> InitFlags -> Doc - generateBuildInfo buildType c' = vcat - [ fieldS "other-modules" (listField otherMods) - (Just $ case buildType of + generateBuildInfo :: BuildType -> InitFlags -> [PrettyField [String]] + generateBuildInfo buildType c' = catMaybes + [ fieldP "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 - - , fieldS "other-extensions" (listField (otherExts c')) - (Just "LANGUAGE extensions used by modules in this package.") - True - - , fieldS "build-depends" ((++ myLibDep) <$> listField (dependencies c')) - (Just "Other library packages from which modules are imported.") - True - - , fieldS "hs-source-dirs" (listFieldS (case buildType of - LibBuild -> sourceDirs c' - ExecBuild -> applicationDirs c')) - (Just "Directories containing source files.") - True - - , fieldS "build-tools" (listFieldS (buildTools c')) - (Just "Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.") - False - - , field "default-language" (language c') - (Just "Base language which the package is written in.") - True + ExecBuild -> "Modules included in this executable, other than Main."] + True + + , fieldP "other-extensions" (maybeToFlag (formatOtherExtensions <$> otherExts c)) + ["LANGUAGE extensions used by modules in this package."] + True + + , fieldP "build-depends" (maybeToFlag (formatDependencyList <$> buildDependencies)) + ["Other library packages from which modules are imported."] + True + + , fieldP "hs-source-dirs" + (maybeToFlag (formatHsSourceDirs <$> 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 -> ", " ++ P.unPackageName pkgName - _ -> "" - else "" + Flag pkgName -> + [mkDependency pkgName anyVersion (Set.singleton LMainLibName)] + _ -> [] + else [] -- Only include 'MyLib' in 'other-modules' of the executable. otherModsFromFlag = otherModules c' @@ -473,95 +487,132 @@ generateCabalFile fileName c = trimTrailingWS $ then Nothing else otherModsFromFlag - listField :: Text s => Maybe [s] -> Flag String - listField = listFieldS . fmap (map display) - listFieldS :: Maybe [String] -> Flag String - listFieldS = Flag . maybe "" (intercalate ", ") - - field :: Text t => String -> Flag t -> Maybe String -> Bool -> Doc - field s f = fieldS s (fmap display f) - - fieldS :: String -- ^ Name of the field - -> Flag String -- ^ Field contents - -> Maybe String -- ^ Comment to explain the field - -> Bool -- ^ Should the field be included (commented out) even if blank? - -> Doc - fieldS _ NoFlag _ inc | not inc || (minimal c == Flag True) = empty - fieldS _ (Flag "") _ inc | not inc || (minimal c == Flag True) = empty - fieldS s f com _ = case (isJust com, noComments c, minimal c) of - (_, _, Flag True) -> id - (_, Flag True, _) -> id - (True, _, _) -> (showComment com $$) . ($$ text "") - (False, _, _) -> ($$ text "") - $ - comment f <<>> text s <<>> colon - <<>> text (replicate (19 - length s) ' ') - <<>> text (fromMaybe "" . flagToMaybe $ f) - comment NoFlag = text "-- " - comment (Flag "") = text "-- " - comment _ = text "" - - showComment :: Maybe String -> Doc - showComment (Just t) = vcat - . map (text . ("-- "++)) . lines - . renderStyle style { - lineLength = 76, - ribbonsPerLine = 1.05 - } - . vcat - . map (fcat . map text . breakLine) - . lines - $ t - showComment Nothing = text "" - - breakLine [] = [] - breakLine cs = case break (==' ') cs of (w,cs') -> w : breakLine' cs' - breakLine' [] = [] - breakLine' cs = case span (==' ') cs of (w,cs') -> w : breakLine cs' - - trimTrailingWS :: String -> String - trimTrailingWS = unlines . map (dropWhileEndLE isSpace) . lines - - executableStanza :: Doc - executableStanza = text "\nexecutable" <+> - text (maybe "" display . flagToMaybe $ packageName c) $$ - nest 2 (vcat - [ fieldS "main-is" (mainIs c) (Just ".hs or .lhs file containing the Main module.") True - - , generateBuildInfo ExecBuild c - ]) - - libraryStanza :: Doc - libraryStanza = text "\nlibrary" $$ nest 2 (vcat - [ fieldS "exposed-modules" (listField (exposedModules c)) - (Just "Modules exported by the library.") - True - - , generateBuildInfo LibBuild c - ]) - - testSuiteStanza :: Doc - testSuiteStanza = text "\ntest-suite" <+> - text (maybe "" ((++"-test") . display) . flagToMaybe $ packageName c) $$ - nest 2 (vcat - [ field "default-language" (language c) - (Just "Base language which the package is written in.") - True - - , fieldS "type" (Flag "exitcode-stdio-1.0") - (Just "The interface type and version of the test suite.") - True - - , fieldS "hs-source-dirs" (listFieldS (testDirs c)) - (Just "The directory where the test specifications are found.") - True - - , fieldS "main-is" (Flag testFile) - (Just "The entrypoint to the test suite.") - True - - , fieldS "build-depends" (listField (dependencies c)) - (Just "Test dependencies.") - True - ]) + 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 :: Text t => + String + -> Flag t + -> [String] + -> Bool + -> Maybe (PrettyField [String]) + field fieldName fieldContentsFlag = fieldS fieldName (display <$> fieldContentsFlag) + + -- | Construct a 'PrettyField' from a 'String' field. + fieldS :: String -- ^ 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 [String]) + fieldS fieldName fieldContentsFlag = fieldD fieldName (text <$> fieldContentsFlag) + + -- | Construct a 'PrettyField' from a Flag which can be 'pretty'-ied. + fieldP :: Pretty a + => String + -> Flag a + -> [String] + -> Bool + -> Maybe (PrettyField [String]) + fieldP fieldName fieldContentsFlag fieldComments includeField = + fieldD fieldName (pretty <$> fieldContentsFlag) fieldComments includeField + + -- | Construct a 'PrettyField' from a 'Doc' Flag. + fieldD :: String -- ^ 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 [String]) + 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 :: String + -> [String] + -> Bool + -> Maybe (PrettyField [String]) + fieldSEmptyContents fieldName fieldComments includeField + | not includeField || (minimal c == Flag True) = + Nothing + | otherwise = + Just (PrettyFieldCommentedOut (map ("-- " ++) fieldComments) (toUTF8BS fieldName)) + + -- | Produce a field with content. + fieldSWithContents :: String + -> Doc + -> [String] + -> PrettyField [String] + fieldSWithContents fieldName fieldContents fieldComments = + PrettyField (map ("-- " ++) fieldComments) (toUTF8BS fieldName) fieldContents + + executableStanza :: PrettyField [String] + executableStanza = PrettySection [] (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 "" display . flagToMaybe $ packageName c) + + libraryStanza :: PrettyField [String] + libraryStanza = PrettySection [] (toUTF8BS "library") [] $ catMaybes + [ fieldP "exposed-modules" (maybeToFlag (formatExposedModules <$> exposedModules c)) + ["Modules exported by the library."] + True + ] + ++ + generateBuildInfo LibBuild c + + + testSuiteStanza :: PrettyField [String] + testSuiteStanza = PrettySection [] (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 + + , fieldP "hs-source-dirs" + (maybeToFlag (formatHsSourceDirs <$> testDirs c)) + ["Directories containing source files."] + True + + , fieldS "main-is" (Flag testFile) + ["The entrypoint to the test suite."] + True + + , fieldP "build-depends" (maybeToFlag (formatDependencyList <$> dependencies c)) + ["Test dependencies."] + True + ] + where + testSuiteName = + text (maybe "" ((++"-test") . display) . flagToMaybe $ packageName c) diff --git a/tests/fixtures/init/exe-only-golden.cabal b/tests/fixtures/init/exe-only-golden.cabal index ca67e445a4b..8887173111b 100644 --- a/tests/fixtures/init/exe-only-golden.cabal +++ b/tests/fixtures/init/exe-only-golden.cabal @@ -10,7 +10,11 @@ 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 + 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/tests/fixtures/init/lib-and-exe-golden.cabal b/tests/fixtures/init/lib-and-exe-golden.cabal index 31a6f88c530..cf678f8bd99 100644 --- a/tests/fixtures/init/lib-and-exe-golden.cabal +++ b/tests/fixtures/init/lib-and-exe-golden.cabal @@ -10,13 +10,22 @@ 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 + 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 + main-is: Main.hs + build-depends: + base ^>=4.13.0.0, + containers ^>=5.7.0.0, + unordered-containers ^>=2.7.0.0, + foo -any + + hs-source-dirs: app + default-language: Haskell2010 diff --git a/tests/fixtures/init/lib-exe-and-test-golden.cabal b/tests/fixtures/init/lib-exe-and-test-golden.cabal index e6d04dffc67..924237c2dea 100644 --- a/tests/fixtures/init/lib-exe-and-test-golden.cabal +++ b/tests/fixtures/init/lib-exe-and-test-golden.cabal @@ -10,20 +10,34 @@ 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 + 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 + 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 + 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