{-# 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
  , mkCommonStanza
  , mkLibStanza
  , mkExeStanza
  , mkTestStanza
  , mkPkgDescription
  ) where

import Distribution.CabalSpecVersion
import Distribution.Client.Init.Types
import Distribution.FieldGrammar.Newtypes (SpecLicense (SpecLicense))
import Distribution.Fields
import Distribution.License
import Distribution.Package (unPackageName)
import Distribution.PackageDescription.FieldGrammar
import Distribution.Pretty
import qualified Distribution.SPDX.License as SPDX
import Distribution.Simple.Utils hiding (cabalVersion)
import Distribution.Solver.Compat.Prelude hiding (empty)
import Distribution.Utils.Path
import Text.PrettyPrint

-- | 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 :: forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field FieldName
fieldName a -> b
modifier a
fieldContents =
  FieldName
-> Doc
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
fieldD FieldName
fieldName (b -> Doc
forall a. Pretty a => a -> Doc
pretty (b -> Doc) -> b -> Doc
forall a b. (a -> b) -> a -> b
$ a -> b
modifier a
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
-> Doc
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
fieldD FieldName
fieldName Doc
fieldContents [String]
fieldComments Bool
includeField WriteOpts
opts
  -- If the "--no-comments" or "--minimal" flag is set, strip comments.
  | Bool
hasNoComments Bool -> Bool -> Bool
|| Bool
isMinimal = CommentPosition -> PrettyField FieldAnnotation
contents CommentPosition
NoComment
  | Bool
otherwise = CommentPosition -> PrettyField FieldAnnotation
contents (CommentPosition -> PrettyField FieldAnnotation)
-> CommentPosition -> PrettyField FieldAnnotation
forall a b. (a -> b) -> a -> b
$ FieldName -> [String] -> CommentPosition
forall {a}. (Eq a, IsString a) => a -> [String] -> CommentPosition
commentPositionFor FieldName
fieldName [String]
fieldComments
  where
    commentPositionFor :: a -> [String] -> CommentPosition
commentPositionFor a
fn
      | a
fn a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"cabal-version" = [String] -> CommentPosition
CommentAfter
      | Bool
otherwise = [String] -> CommentPosition
CommentBefore

    isMinimal :: Bool
isMinimal = WriteOpts -> Bool
_optMinimal WriteOpts
opts
    hasNoComments :: Bool
hasNoComments = WriteOpts -> Bool
_optNoComments WriteOpts
opts

    contents :: CommentPosition -> PrettyField FieldAnnotation
contents
      -- If there is no content, optionally produce a commented out field.
      | Doc
fieldContents Doc -> Doc -> Bool
forall a. Eq a => a -> a -> Bool
== Doc
empty = CommentPosition -> PrettyField FieldAnnotation
fieldSEmptyContents
      | Bool
otherwise = CommentPosition -> PrettyField FieldAnnotation
fieldSWithContents

    fieldSEmptyContents :: CommentPosition -> PrettyField FieldAnnotation
fieldSEmptyContents CommentPosition
cs
      | Bool -> Bool
not Bool
includeField Bool -> Bool -> Bool
|| Bool
isMinimal = PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
      | Bool
otherwise =
          FieldAnnotation -> FieldName -> Doc -> PrettyField FieldAnnotation
forall ann. ann -> FieldName -> Doc -> PrettyField ann
PrettyField
            (CommentPosition -> FieldAnnotation
commentedOutWithComments CommentPosition
cs)
            FieldName
fieldName
            Doc
empty

    fieldSWithContents :: CommentPosition -> PrettyField FieldAnnotation
fieldSWithContents CommentPosition
cs =
      FieldAnnotation -> FieldName -> Doc -> PrettyField FieldAnnotation
forall ann. ann -> FieldName -> Doc -> PrettyField ann
PrettyField (CommentPosition -> FieldAnnotation
withComments CommentPosition
cs) FieldName
fieldName Doc
fieldContents

-- | A field annotation instructing the pretty printer to comment out the field
--   and any contents, with no comments.
commentedOutWithComments :: CommentPosition -> FieldAnnotation
commentedOutWithComments :: CommentPosition -> FieldAnnotation
commentedOutWithComments (CommentBefore [String]
cs) = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
True (CommentPosition -> FieldAnnotation)
-> ([String] -> CommentPosition) -> [String] -> FieldAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommentPosition
CommentBefore ([String] -> FieldAnnotation) -> [String] -> FieldAnnotation
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
commentNoTrailing [String]
cs
commentedOutWithComments (CommentAfter [String]
cs) = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
True (CommentPosition -> FieldAnnotation)
-> ([String] -> CommentPosition) -> [String] -> FieldAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommentPosition
CommentAfter ([String] -> FieldAnnotation) -> [String] -> FieldAnnotation
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
commentNoTrailing [String]
cs
commentedOutWithComments CommentPosition
NoComment = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
True CommentPosition
NoComment

-- | A field annotation with the specified comment lines.
withComments :: CommentPosition -> FieldAnnotation
withComments :: CommentPosition -> FieldAnnotation
withComments (CommentBefore [String]
cs) = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
False (CommentPosition -> FieldAnnotation)
-> ([String] -> CommentPosition) -> [String] -> FieldAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommentPosition
CommentBefore ([String] -> FieldAnnotation) -> [String] -> FieldAnnotation
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
commentNoTrailing [String]
cs
withComments (CommentAfter [String]
cs) = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
False (CommentPosition -> FieldAnnotation)
-> ([String] -> CommentPosition) -> [String] -> FieldAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommentPosition
CommentAfter ([String] -> FieldAnnotation) -> [String] -> FieldAnnotation
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
commentNoTrailing [String]
cs
withComments CommentPosition
NoComment = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
False CommentPosition
NoComment

-- | A field annotation with no comments.
annNoComments :: FieldAnnotation
annNoComments :: FieldAnnotation
annNoComments = Bool -> CommentPosition -> FieldAnnotation
FieldAnnotation Bool
False CommentPosition
NoComment

postProcessFieldLines :: FieldAnnotation -> [String] -> [String]
postProcessFieldLines :: FieldAnnotation -> [String] -> [String]
postProcessFieldLines FieldAnnotation
ann
  | FieldAnnotation -> Bool
annCommentedOut FieldAnnotation
ann = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
commentNoTrailing
  | Bool
otherwise = [String] -> [String]
forall a. a -> a
id

-- -------------------------------------------------------------------- --
-- Stanzas

-- The common stanzas are hardcoded for simplicity purposes,
-- see https://github.com/haskell/cabal/pull/7558#discussion_r693173846
mkCommonStanza :: WriteOpts -> PrettyField FieldAnnotation
mkCommonStanza :: WriteOpts -> PrettyField FieldAnnotation
mkCommonStanza WriteOpts
opts = case CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas (CabalSpecVersion -> HasCommonStanzas)
-> CabalSpecVersion -> HasCommonStanzas
forall a b. (a -> b) -> a -> b
$ WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts of
  HasCommonStanzas
NoCommonStanzas -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
  HasCommonStanzas
_ ->
    FieldAnnotation
-> FieldName
-> [Doc]
-> [PrettyField FieldAnnotation]
-> PrettyField FieldAnnotation
forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection
      FieldAnnotation
annNoComments
      FieldName
"common"
      [String -> Doc
text String
"warnings"]
      [FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field FieldName
"ghc-options" String -> Doc
text String
"-Wall" [] Bool
False WriteOpts
opts]

mkLibStanza :: WriteOpts -> LibTarget -> PrettyField FieldAnnotation
mkLibStanza :: WriteOpts -> LibTarget -> PrettyField FieldAnnotation
mkLibStanza WriteOpts
opts (LibTarget [String]
srcDirs Language
lang NonEmpty ModuleName
expMods [ModuleName]
otherMods [Extension]
exts [Dependency]
deps [Dependency]
tools) =
  FieldAnnotation
-> FieldName
-> [Doc]
-> [PrettyField FieldAnnotation]
-> PrettyField FieldAnnotation
forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection
    FieldAnnotation
annNoComments
    (String -> FieldName
toUTF8BS String
"library")
    []
    [ case CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas (CabalSpecVersion -> HasCommonStanzas)
-> CabalSpecVersion -> HasCommonStanzas
forall a b. (a -> b) -> a -> b
$ WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts of
        HasCommonStanzas
NoCommonStanzas -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
        HasCommonStanzas
_ ->
          FieldName
-> ([String] -> Doc)
-> [String]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
            FieldName
"import"
            ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text)
            [String
"warnings"]
            [String
"Import common warning flags."]
            Bool
False
            WriteOpts
opts
    , FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> [ModuleName]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"exposed-modules"
        [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatExposedModules
        (NonEmpty ModuleName -> [ModuleName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ModuleName
expMods)
        [String
"Modules exported by the library."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> [ModuleName]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-modules"
        [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules
        [ModuleName]
otherMods
        [String
"Modules included in this library but not exported."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> [Extension]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-extensions"
        [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions
        [Extension]
exts
        [String
"LANGUAGE extensions used by modules in this package."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"build-depends"
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
deps
        [String
"Other library packages from which modules are imported."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([SymbolicPath Pkg ('Dir Source)]
    -> List
         FSep
         (SymbolicPathNT Pkg ('Dir Source))
         (SymbolicPath Pkg ('Dir Source)))
-> [SymbolicPath Pkg ('Dir Source)]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"hs-source-dirs"
        [SymbolicPath Pkg ('Dir Source)]
-> List
     FSep
     (SymbolicPathNT Pkg ('Dir Source))
     (SymbolicPath Pkg ('Dir Source))
formatHsSourceDirs
        (String -> SymbolicPath Pkg ('Dir Source)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath (String -> SymbolicPath Pkg ('Dir Source))
-> [String] -> [SymbolicPath Pkg ('Dir Source)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
srcDirs)
        [String
"Directories containing source files."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        (WriteOpts -> FieldName
buildToolTag WriteOpts
opts)
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
tools
        [String
"Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
        Bool
False
        WriteOpts
opts
    , FieldName
-> (Language -> Language)
-> Language
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"default-language"
        Language -> Language
forall a. a -> a
id
        Language
lang
        [String
"Base language which the package is written in."]
        Bool
True
        WriteOpts
opts
    ]

mkExeStanza :: WriteOpts -> ExeTarget -> PrettyField FieldAnnotation
mkExeStanza :: WriteOpts -> ExeTarget -> PrettyField FieldAnnotation
mkExeStanza WriteOpts
opts (ExeTarget HsFilePath
exeMain [String]
appDirs Language
lang [ModuleName]
otherMods [Extension]
exts [Dependency]
deps [Dependency]
tools) =
  FieldAnnotation
-> FieldName
-> [Doc]
-> [PrettyField FieldAnnotation]
-> PrettyField FieldAnnotation
forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection
    FieldAnnotation
annNoComments
    (String -> FieldName
toUTF8BS String
"executable")
    [Doc
exeName]
    [ case CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas (CabalSpecVersion -> HasCommonStanzas)
-> CabalSpecVersion -> HasCommonStanzas
forall a b. (a -> b) -> a -> b
$ WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts of
        HasCommonStanzas
NoCommonStanzas -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
        HasCommonStanzas
_ ->
          FieldName
-> ([String] -> Doc)
-> [String]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
            FieldName
"import"
            ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text)
            [String
"warnings"]
            [String
"Import common warning flags."]
            Bool
False
            WriteOpts
opts
    , FieldName
-> (HsFilePath -> Doc)
-> HsFilePath
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"main-is"
        HsFilePath -> Doc
unsafeFromHs
        HsFilePath
exeMain
        [String
".hs or .lhs file containing the Main module."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> [ModuleName]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-modules"
        [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules
        [ModuleName]
otherMods
        [String
"Modules included in this executable, other than Main."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> [Extension]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-extensions"
        [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions
        [Extension]
exts
        [String
"LANGUAGE extensions used by modules in this package."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"build-depends"
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
deps
        [String
"Other library packages from which modules are imported."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([SymbolicPath Pkg ('Dir Source)]
    -> List
         FSep
         (SymbolicPathNT Pkg ('Dir Source))
         (SymbolicPath Pkg ('Dir Source)))
-> [SymbolicPath Pkg ('Dir Source)]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"hs-source-dirs"
        [SymbolicPath Pkg ('Dir Source)]
-> List
     FSep
     (SymbolicPathNT Pkg ('Dir Source))
     (SymbolicPath Pkg ('Dir Source))
formatHsSourceDirs
        (String -> SymbolicPath Pkg ('Dir Source)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath (String -> SymbolicPath Pkg ('Dir Source))
-> [String] -> [SymbolicPath Pkg ('Dir Source)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
appDirs)
        [String
"Directories containing source files."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        (WriteOpts -> FieldName
buildToolTag WriteOpts
opts)
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
tools
        [String
"Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
        Bool
False
        WriteOpts
opts
    , FieldName
-> (Language -> Language)
-> Language
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"default-language"
        Language -> Language
forall a. a -> a
id
        Language
lang
        [String
"Base language which the package is written in."]
        Bool
True
        WriteOpts
opts
    ]
  where
    exeName :: Doc
exeName = PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty (PackageName -> Doc) -> PackageName -> Doc
forall a b. (a -> b) -> a -> b
$ WriteOpts -> PackageName
_optPkgName WriteOpts
opts

mkTestStanza :: WriteOpts -> TestTarget -> PrettyField FieldAnnotation
mkTestStanza :: WriteOpts -> TestTarget -> PrettyField FieldAnnotation
mkTestStanza WriteOpts
opts (TestTarget HsFilePath
testMain [String]
dirs Language
lang [ModuleName]
otherMods [Extension]
exts [Dependency]
deps [Dependency]
tools) =
  FieldAnnotation
-> FieldName
-> [Doc]
-> [PrettyField FieldAnnotation]
-> PrettyField FieldAnnotation
forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection
    FieldAnnotation
annNoComments
    (String -> FieldName
toUTF8BS String
"test-suite")
    [Doc
suiteName]
    [ case CabalSpecVersion -> HasCommonStanzas
specHasCommonStanzas (CabalSpecVersion -> HasCommonStanzas)
-> CabalSpecVersion -> HasCommonStanzas
forall a b. (a -> b) -> a -> b
$ WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts of
        HasCommonStanzas
NoCommonStanzas -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
        HasCommonStanzas
_ ->
          FieldName
-> ([String] -> Doc)
-> [String]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
            FieldName
"import"
            ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text)
            [String
"warnings"]
            [String
"Import common warning flags."]
            Bool
False
            WriteOpts
opts
    , FieldName
-> (Language -> Language)
-> Language
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"default-language"
        Language -> Language
forall a. a -> a
id
        Language
lang
        [String
"Base language which the package is written in."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> [ModuleName]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-modules"
        [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules
        [ModuleName]
otherMods
        [String
"Modules included in this executable, other than Main."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Extension] -> List FSep (MQuoted Extension) Extension)
-> [Extension]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"other-extensions"
        [Extension] -> List FSep (MQuoted Extension) Extension
formatOtherExtensions
        [Extension]
exts
        [String
"LANGUAGE extensions used by modules in this package."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"type"
        String -> Doc
text
        String
"exitcode-stdio-1.0"
        [String
"The interface type and version of the test suite."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([SymbolicPath Pkg ('Dir Source)]
    -> List
         FSep
         (SymbolicPathNT Pkg ('Dir Source))
         (SymbolicPath Pkg ('Dir Source)))
-> [SymbolicPath Pkg ('Dir Source)]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"hs-source-dirs"
        [SymbolicPath Pkg ('Dir Source)]
-> List
     FSep
     (SymbolicPathNT Pkg ('Dir Source))
     (SymbolicPath Pkg ('Dir Source))
formatHsSourceDirs
        (String -> SymbolicPath Pkg ('Dir Source)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath (String -> SymbolicPath Pkg ('Dir Source))
-> [String] -> [SymbolicPath Pkg ('Dir Source)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
dirs)
        [String
"Directories containing source files."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> (HsFilePath -> Doc)
-> HsFilePath
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"main-is"
        HsFilePath -> Doc
unsafeFromHs
        HsFilePath
testMain
        [String
"The entrypoint to the test suite."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        FieldName
"build-depends"
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
deps
        [String
"Test dependencies."]
        Bool
True
        WriteOpts
opts
    , FieldName
-> ([Dependency]
    -> List CommaVCat (Identity Dependency) Dependency)
-> [Dependency]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
        (WriteOpts -> FieldName
buildToolTag WriteOpts
opts)
        [Dependency] -> List CommaVCat (Identity Dependency) Dependency
formatDependencyList
        [Dependency]
tools
        [String
"Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
        Bool
False
        WriteOpts
opts
    ]
  where
    suiteName :: Doc
suiteName = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ PackageName -> String
unPackageName (WriteOpts -> PackageName
_optPkgName WriteOpts
opts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-test"

mkPkgDescription :: WriteOpts -> PkgDescription -> [PrettyField FieldAnnotation]
mkPkgDescription :: WriteOpts -> PkgDescription -> [PrettyField FieldAnnotation]
mkPkgDescription WriteOpts
opts PkgDescription
pkgDesc =
  [ FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"cabal-version"
      String -> Doc
text
      ((if CabalSpecVersion
cabalSpec CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_12 then String
">=" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> String
showCabalSpecVersion CabalSpecVersion
cabalSpec)
      [ String
"The cabal-version field refers to the version of the .cabal specification,"
      , String
"and can be different from the cabal-install (the tool) version and the"
      , String
"Cabal (the library) version you are using. As such, the Cabal (the library)"
      , String
"version used must be equal or greater than the version stated in this field."
      , String
"Starting from the specification version 2.2, the cabal-version field must be"
      , String
"the first thing in the cabal file."
      ]
      Bool
False
      WriteOpts
opts
  , FieldName
-> (PackageName -> Doc)
-> PackageName
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"name"
      PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty
      (PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc)
      [ String
"Initial package description '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (WriteOpts -> PackageName
_optPkgName WriteOpts
opts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' generated by"
      , String
"'cabal init'. For further documentation, see:"
      , String
"  http://haskell.org/cabal/users-guide/"
      , String
""
      , String
"The name of the package."
      ]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (Version -> Doc)
-> Version
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"version"
      Version -> Doc
forall a. Pretty a => a -> Doc
pretty
      (PkgDescription -> Version
_pkgVersion PkgDescription
pkgDesc)
      [ String
"The package version."
      , String
"See the Haskell package versioning policy (PVP) for standards"
      , String
"guiding when and how versions should be incremented."
      , String
"https://pvp.haskell.org"
      , String
"PVP summary:     +-+------- breaking API changes"
      , String
"                 | | +----- non-breaking API additions"
      , String
"                 | | | +--- code changes with no API change"
      ]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"synopsis"
      String -> Doc
text
      (PkgDescription -> String
_pkgSynopsis PkgDescription
pkgDesc)
      [String
"A short (one-line) description of the package."]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"description"
      String -> Doc
text
      String
""
      [String
"A longer description of the package."]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"homepage"
      String -> Doc
text
      (PkgDescription -> String
_pkgHomePage PkgDescription
pkgDesc)
      [String
"URL for the project homepage or repository."]
      Bool
False
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"bug-reports"
      String -> Doc
text
      String
""
      [String
"A URL where users can report bugs."]
      Bool
False
      WriteOpts
opts
  , FieldName
-> (SpecLicense -> Doc)
-> SpecLicense
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"license"
      SpecLicense -> Doc
forall a. Pretty a => a -> Doc
pretty
      (PkgDescription -> SpecLicense
_pkgLicense PkgDescription
pkgDesc)
      [String
"The license under which the package is released."]
      Bool
True
      WriteOpts
opts
  , case PkgDescription -> SpecLicense
_pkgLicense PkgDescription
pkgDesc of
      SpecLicense (Left License
SPDX.NONE) -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
      SpecLicense (Right License
AllRightsReserved) -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
      SpecLicense (Right License
UnspecifiedLicense) -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
      SpecLicense
_ ->
        FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
          FieldName
"license-file"
          String -> Doc
text
          String
"LICENSE"
          [String
"The file containing the license text."]
          Bool
False
          WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"author"
      String -> Doc
text
      (PkgDescription -> String
_pkgAuthor PkgDescription
pkgDesc)
      [String
"The package author(s)."]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"maintainer"
      String -> Doc
text
      (PkgDescription -> String
_pkgEmail PkgDescription
pkgDesc)
      [String
"An email address to which users can send suggestions, bug reports, and patches."]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"copyright"
      String -> Doc
text
      String
""
      [String
"A copyright notice."]
      Bool
True
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"category"
      String -> Doc
text
      (PkgDescription -> String
_pkgCategory PkgDescription
pkgDesc)
      []
      Bool
False
      WriteOpts
opts
  , FieldName
-> (String -> Doc)
-> String
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"build-type"
      String -> Doc
text
      String
"Simple"
      []
      Bool
False
      WriteOpts
opts
  , case PkgDescription -> Maybe (Set String)
_pkgExtraDocFiles PkgDescription
pkgDesc of
      Maybe (Set String)
Nothing -> PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
      Just Set String
fs ->
        FieldName
-> ([String]
    -> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File))
-> [String]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
          FieldName
"extra-doc-files"
          ([RelativePath Pkg 'File]
-> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File)
formatExtraSourceFiles ([RelativePath Pkg 'File]
 -> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File))
-> ([String] -> [RelativePath Pkg 'File])
-> [String]
-> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RelativePath Pkg 'File)
-> [String] -> [RelativePath Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
map String -> RelativePath Pkg 'File
forall (allowAbs :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbs from to
unsafeMakeSymbolicPath)
          (Set String -> [String]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set String
fs)
          [String
"Extra doc files to be distributed with the package, such as a CHANGELOG or a README."]
          Bool
True
          WriteOpts
opts
  , FieldName
-> ([String]
    -> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File))
-> [String]
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
forall b a.
Pretty b =>
FieldName
-> (a -> b)
-> a
-> [String]
-> Bool
-> WriteOpts
-> PrettyField FieldAnnotation
field
      FieldName
"extra-source-files"
      ([RelativePath Pkg 'File]
-> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File)
formatExtraSourceFiles ([RelativePath Pkg 'File]
 -> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File))
-> ([String] -> [RelativePath Pkg 'File])
-> [String]
-> List VCat (RelativePathNT Pkg 'File) (RelativePath Pkg 'File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RelativePath Pkg 'File)
-> [String] -> [RelativePath Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
map String -> RelativePath Pkg 'File
forall (allowAbs :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbs from to
unsafeMakeSymbolicPath)
      (Set String -> [String]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set String -> [String]) -> Set String -> [String]
forall a b. (a -> b) -> a -> b
$ PkgDescription -> Set String
_pkgExtraSrcFiles PkgDescription
pkgDesc)
      [String
"Extra source files to be distributed with the package, such as examples, or a tutorial module."]
      Bool
True
      WriteOpts
opts
  ]
  where
    cabalSpec :: CabalSpecVersion
cabalSpec = PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc

-- -------------------------------------------------------------------- --
-- Utils

listFieldS :: [String] -> Doc
listFieldS :: [String] -> Doc
listFieldS = String -> Doc
text (String -> Doc) -> ([String] -> String) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "

unsafeFromHs :: HsFilePath -> Doc
unsafeFromHs :: HsFilePath -> Doc
unsafeFromHs = String -> Doc
text (String -> Doc) -> (HsFilePath -> String) -> HsFilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFilePath -> String
_hsFilePath

buildToolTag :: WriteOpts -> FieldName
buildToolTag :: WriteOpts -> FieldName
buildToolTag WriteOpts
opts
  | WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_0 = FieldName
"build-tools"
  | Bool
otherwise = FieldName
"build-tool-depends"

commentNoTrailing :: String -> String
commentNoTrailing :: String -> String
commentNoTrailing String
"" = String
"--"
commentNoTrailing String
c = String
"-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c