{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.PrettyPrint
-- Copyright   :  Jürgen Nicklisch-Franken 2010
-- License     :  BSD3
--
-- Maintainer  : cabal-devel@haskell.org
-- Stability   : provisional
-- Portability : portable
--
-- Pretty printing for cabal files
--
-----------------------------------------------------------------------------

module Distribution.PackageDescription.PrettyPrint (
    -- * Generic package descriptions
    writeGenericPackageDescription,
    showGenericPackageDescription,
    ppGenericPackageDescription,

    -- * Package descriptions
     writePackageDescription,
     showPackageDescription,

     -- ** Supplementary build information
     writeHookedBuildInfo,
     showHookedBuildInfo,
) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.CabalSpecVersion
import Distribution.Fields.Pretty
import Distribution.Compat.Lens
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.FieldGrammar                     (PrettyFieldGrammar', prettyFieldGrammar)
import Distribution.PackageDescription.Configuration (transformAllBuildInfos)
import Distribution.PackageDescription.FieldGrammar
       (benchmarkFieldGrammar, buildInfoFieldGrammar, executableFieldGrammar, flagFieldGrammar, foreignLibFieldGrammar, libraryFieldGrammar,
       packageDescriptionFieldGrammar, setupBInfoFieldGrammar, sourceRepoFieldGrammar, testSuiteFieldGrammar)
import Distribution.Utils.Generic                    (writeFileAtomic, writeUTF8File)

import qualified Distribution.PackageDescription.FieldGrammar as FG
import qualified Distribution.Types.BuildInfo.Lens                 as L
import qualified Distribution.Types.SetupBuildInfo.Lens            as L

import Text.PrettyPrint (Doc, char, hsep, parens, text)

import qualified Data.ByteString.Lazy.Char8      as BS.Char8
import qualified Distribution.Compat.NonEmptySet as NES

-- | Writes a .cabal file from a generic package description
writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO ()
writeGenericPackageDescription :: String -> GenericPackageDescription -> IO ()
writeGenericPackageDescription String
fpath GenericPackageDescription
pkg = String -> String -> IO ()
writeUTF8File String
fpath (GenericPackageDescription -> String
showGenericPackageDescription GenericPackageDescription
pkg)

-- | Writes a generic package description to a string
showGenericPackageDescription :: GenericPackageDescription -> String
showGenericPackageDescription :: GenericPackageDescription -> String
showGenericPackageDescription GenericPackageDescription
gpd = forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
showFields (forall a b. a -> b -> a
const CommentPosition
NoComment) forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
ppGenericPackageDescription CabalSpecVersion
v GenericPackageDescription
gpd
  where
    v :: CabalSpecVersion
v = PackageDescription -> CabalSpecVersion
specVersion forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd

-- | Convert a generic package description to 'PrettyField's.
ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
ppGenericPackageDescription CabalSpecVersion
v GenericPackageDescription
gpd0 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ CabalSpecVersion -> PackageDescription -> [PrettyField ()]
ppPackageDescription CabalSpecVersion
v (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd)
    , CabalSpecVersion -> Maybe SetupBuildInfo -> [PrettyField ()]
ppSetupBInfo CabalSpecVersion
v (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd))
    , CabalSpecVersion -> [PackageFlag] -> [PrettyField ()]
ppGenPackageFlags CabalSpecVersion
v (GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
gpd)
    , CabalSpecVersion
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [PrettyField ()]
ppCondLibrary CabalSpecVersion
v (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
gpd)
    , CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [PrettyField ()]
ppCondSubLibraries CabalSpecVersion
v (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
gpd)
    , CabalSpecVersion
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [PrettyField ()]
ppCondForeignLibs CabalSpecVersion
v (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
gpd)
    , CabalSpecVersion
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [PrettyField ()]
ppCondExecutables CabalSpecVersion
v (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
gpd)
    , CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [PrettyField ()]
ppCondTestSuites CabalSpecVersion
v (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
gpd)
    , CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [PrettyField ()]
ppCondBenchmarks CabalSpecVersion
v (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
gpd)
    ]
  where
    gpd :: GenericPackageDescription
gpd = CabalSpecVersion
-> GenericPackageDescription -> GenericPackageDescription
preProcessInternalDeps (PackageDescription -> CabalSpecVersion
specVersion (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd0)) GenericPackageDescription
gpd0


ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()]
ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()]
ppPackageDescription CabalSpecVersion
v PackageDescription
pd =
    forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
v forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageDescription),
 Applicative (g PackageIdentifier), c (Identity BuildType),
 c (Identity PackageName), c (Identity Version),
 c (List FSep FilePathNT String),
 c (List FSep CompatFilePath String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir LicenseFile))
      (SymbolicPath PackageDir LicenseFile)),
 c (List FSep TestedWith (CompilerFlavor, VersionRange)),
 c (List VCat FilePathNT String), c FilePathNT, c CompatLicenseFile,
 c CompatFilePath, c SpecLicense, c SpecVersion) =>
g PackageDescription PackageDescription
packageDescriptionFieldGrammar PackageDescription
pd
    forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [SourceRepo] -> [PrettyField ()]
ppSourceRepos CabalSpecVersion
v (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pd)

ppSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [PrettyField ()]
ppSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [PrettyField ()]
ppSourceRepos = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> SourceRepo -> PrettyField ()
ppSourceRepo

ppSourceRepo :: CabalSpecVersion -> SourceRepo -> PrettyField ()
ppSourceRepo :: CabalSpecVersion -> SourceRepo -> PrettyField ()
ppSourceRepo CabalSpecVersion
v SourceRepo
repo = forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"source-repository" [forall a. Pretty a => a -> Doc
pretty RepoKind
kind] forall a b. (a -> b) -> a -> b
$
    forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
 c (Identity RepoType), c Token, c FilePathNT) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind) SourceRepo
repo
  where
    kind :: RepoKind
kind = SourceRepo -> RepoKind
repoKind SourceRepo
repo

ppSetupBInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [PrettyField ()]
ppSetupBInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [PrettyField ()]
ppSetupBInfo CabalSpecVersion
_ Maybe SetupBuildInfo
Nothing = forall a. Monoid a => a
mempty
ppSetupBInfo CabalSpecVersion
v (Just SetupBuildInfo
sbi)
    | SetupBuildInfo -> Bool
defaultSetupDepends SetupBuildInfo
sbi = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"custom-setup" [] forall a b. (a -> b) -> a -> b
$
        forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Functor (g SetupBuildInfo),
 c (List CommaVCat (Identity Dependency) Dependency)) =>
Bool -> g SetupBuildInfo SetupBuildInfo
setupBInfoFieldGrammar Bool
False) SetupBuildInfo
sbi

ppGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [PrettyField ()]
ppGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [PrettyField ()]
ppGenPackageFlags = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> PackageFlag -> PrettyField ()
ppFlag

ppFlag :: CabalSpecVersion -> PackageFlag -> PrettyField ()
ppFlag :: CabalSpecVersion -> PackageFlag -> PrettyField ()
ppFlag CabalSpecVersion
v flag :: PackageFlag
flag@(MkPackageFlag FlagName
name String
_ Bool
_ Bool
_)  = forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"flag" [FlagName -> Doc
ppFlagName FlagName
name] forall a b. (a -> b) -> a -> b
$
    forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g PackageFlag)) =>
FlagName -> g PackageFlag PackageFlag
flagFieldGrammar FlagName
name) PackageFlag
flag

ppCondTree2 :: CabalSpecVersion -> PrettyFieldGrammar' s -> CondTree ConfVar [Dependency] s -> [PrettyField ()]
ppCondTree2 :: forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v PrettyFieldGrammar' s
grammar = forall {c}. CondTree ConfVar c s -> [PrettyField ()]
go
  where
    -- TODO: recognise elif opportunities
    go :: CondTree ConfVar c s -> [PrettyField ()]
go (CondNode s
it c
_ [CondBranch ConfVar c s]
ifs) =
        forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
v PrettyFieldGrammar' s
grammar s
it forall a. [a] -> [a] -> [a]
++
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch ConfVar c s -> [PrettyField ()]
ppIf [CondBranch ConfVar c s]
ifs

    ppIf :: CondBranch ConfVar c s -> [PrettyField ()]
ppIf (CondBranch Condition ConfVar
c CondTree ConfVar c s
thenTree Maybe (CondTree ConfVar c s)
Nothing)
--        | isEmpty thenDoc = mempty
        | Bool
otherwise       = [Condition ConfVar -> [PrettyField ()] -> PrettyField ()
ppIfCondition Condition ConfVar
c [PrettyField ()]
thenDoc]
      where
        thenDoc :: [PrettyField ()]
thenDoc = CondTree ConfVar c s -> [PrettyField ()]
go CondTree ConfVar c s
thenTree

    ppIf (CondBranch Condition ConfVar
c CondTree ConfVar c s
thenTree (Just CondTree ConfVar c s
elseTree)) =
      -- See #6193
      [ Condition ConfVar -> [PrettyField ()] -> PrettyField ()
ppIfCondition Condition ConfVar
c (CondTree ConfVar c s -> [PrettyField ()]
go CondTree ConfVar c s
thenTree)
      , forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"else" [] (CondTree ConfVar c s -> [PrettyField ()]
go CondTree ConfVar c s
elseTree)
      ]

ppCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [PrettyField ()]
ppCondLibrary :: CabalSpecVersion
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [PrettyField ()]
ppCondLibrary CabalSpecVersion
_ Maybe (CondTree ConfVar [Dependency] Library)
Nothing = forall a. Monoid a => a
mempty
ppCondLibrary CabalSpecVersion
v (Just CondTree ConfVar [Dependency] Library
condTree) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"library" [] forall a b. (a -> b) -> a -> b
$
    forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
 Applicative (g BuildInfo), c (Identity LibraryVisibility),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar LibraryName
LMainLibName) CondTree ConfVar [Dependency] Library
condTree

ppCondSubLibraries :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [PrettyField ()]
ppCondSubLibraries :: CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [PrettyField ()]
ppCondSubLibraries CabalSpecVersion
v [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
libs =
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"library" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n]
    forall a b. (a -> b) -> a -> b
$ forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Library),
 Applicative (g BuildInfo), c (Identity LibraryVisibility),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List CommaVCat (Identity ModuleReexport) ModuleReexport),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
LibraryName -> g Library Library
libraryFieldGrammar forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n) CondTree ConfVar [Dependency] Library
condTree
    | (UnqualComponentName
n, CondTree ConfVar [Dependency] Library
condTree) <- [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
libs
    ]

ppCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [PrettyField ()]
ppCondForeignLibs :: CabalSpecVersion
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [PrettyField ()]
ppCondForeignLibs CabalSpecVersion
v [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs =
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"foreign-library" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n]
    forall a b. (a -> b) -> a -> b
$ forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g ForeignLib),
 Applicative (g BuildInfo), c (Identity ForeignLibType),
 c (Identity LibVersionInfo), c (Identity Version),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (Identity ForeignLibOption) ForeignLibOption),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String), c (List VCat Token String),
 c (MQuoted Language)) =>
UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar UnqualComponentName
n) CondTree ConfVar [Dependency] ForeignLib
condTree
    | (UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
condTree) <- [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs
    ]

ppCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [PrettyField ()]
ppCondExecutables :: CabalSpecVersion
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [PrettyField ()]
ppCondExecutables CabalSpecVersion
v [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes =
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"executable" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n]
    forall a b. (a -> b) -> a -> b
$ forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v (forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Executable),
 Applicative (g BuildInfo), c (Identity ExecutableScope),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String), c (List VCat Token String),
 c (MQuoted Language)) =>
UnqualComponentName -> g Executable Executable
executableFieldGrammar UnqualComponentName
n) CondTree ConfVar [Dependency] Executable
condTree
    | (UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
condTree) <- [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes
    ]

ppCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [PrettyField ()]
ppCondTestSuites :: CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [PrettyField ()]
ppCondTestSuites CabalSpecVersion
v [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
suites =
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"test-suite" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n]
    forall a b. (a -> b) -> a -> b
$ forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g TestSuiteStanza),
 Applicative (g BuildInfo), c (Identity ModuleName),
 c (Identity TestType),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaFSep Token String),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestSuite -> TestSuiteStanza
FG.unvalidateTestSuite CondTree ConfVar [Dependency] TestSuite
condTree)
    | (UnqualComponentName
n, CondTree ConfVar [Dependency] TestSuite
condTree) <- [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
suites
    ]

ppCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [PrettyField ()]
ppCondBenchmarks :: CabalSpecVersion
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [PrettyField ()]
ppCondBenchmarks CabalSpecVersion
v [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
suites =
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"benchmark" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n]
    forall a b. (a -> b) -> a -> b
$ forall s.
CabalSpecVersion
-> PrettyFieldGrammar' s
-> CondTree ConfVar [Dependency] s
-> [PrettyField ()]
ppCondTree2 CabalSpecVersion
v forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BenchmarkStanza),
 Applicative (g BuildInfo), c (Identity BenchmarkType),
 c (Identity ModuleName),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Benchmark -> BenchmarkStanza
FG.unvalidateBenchmark CondTree ConfVar [Dependency] Benchmark
condTree)
    | (UnqualComponentName
n, CondTree ConfVar [Dependency] Benchmark
condTree) <- [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
suites
    ]

ppCondition :: Condition ConfVar -> Doc
ppCondition :: Condition ConfVar -> Doc
ppCondition (Var ConfVar
x)                      = ConfVar -> Doc
ppConfVar ConfVar
x
ppCondition (Lit Bool
b)                      = String -> Doc
text (forall a. Show a => a -> String
show Bool
b)
ppCondition (CNot Condition ConfVar
c)                     = Char -> Doc
char Char
'!' Doc -> Doc -> Doc
<<>> (Condition ConfVar -> Doc
ppCondition Condition ConfVar
c)
ppCondition (COr Condition ConfVar
c1 Condition ConfVar
c2)                  = Doc -> Doc
parens ([Doc] -> Doc
hsep [Condition ConfVar -> Doc
ppCondition Condition ConfVar
c1, String -> Doc
text String
"||"
                                                         Doc -> Doc -> Doc
<+> Condition ConfVar -> Doc
ppCondition Condition ConfVar
c2])
ppCondition (CAnd Condition ConfVar
c1 Condition ConfVar
c2)                 = Doc -> Doc
parens ([Doc] -> Doc
hsep [Condition ConfVar -> Doc
ppCondition Condition ConfVar
c1, String -> Doc
text String
"&&"
                                                         Doc -> Doc -> Doc
<+> Condition ConfVar -> Doc
ppCondition Condition ConfVar
c2])
ppConfVar :: ConfVar -> Doc
ppConfVar :: ConfVar -> Doc
ppConfVar (OS OS
os)            = String -> Doc
text String
"os"   Doc -> Doc -> Doc
<<>> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty OS
os)
ppConfVar (Arch Arch
arch)        = String -> Doc
text String
"arch" Doc -> Doc -> Doc
<<>> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty Arch
arch)
ppConfVar (PackageFlag FlagName
name) = String -> Doc
text String
"flag" Doc -> Doc -> Doc
<<>> Doc -> Doc
parens (FlagName -> Doc
ppFlagName FlagName
name)
ppConfVar (Impl CompilerFlavor
c VersionRange
v)         = String -> Doc
text String
"impl" Doc -> Doc -> Doc
<<>> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
pretty CompilerFlavor
c Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty VersionRange
v)

ppFlagName :: FlagName -> Doc
ppFlagName :: FlagName -> Doc
ppFlagName                               = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> String
unFlagName

ppIfCondition :: Condition ConfVar -> [PrettyField ()] -> PrettyField ()
ppIfCondition :: Condition ConfVar -> [PrettyField ()] -> PrettyField ()
ppIfCondition Condition ConfVar
c = forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"if" [Condition ConfVar -> Doc
ppCondition Condition ConfVar
c]

-- | @since 2.0.0.2
writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription :: String -> PackageDescription -> IO ()
writePackageDescription String
fpath PackageDescription
pkg = String -> String -> IO ()
writeUTF8File String
fpath (PackageDescription -> String
showPackageDescription PackageDescription
pkg)

--TODO: make this use section syntax
-- add equivalent for GenericPackageDescription

-- | @since 2.0.0.2
showPackageDescription :: PackageDescription -> String
showPackageDescription :: PackageDescription -> String
showPackageDescription = GenericPackageDescription -> String
showGenericPackageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> GenericPackageDescription
pdToGpd

pdToGpd :: PackageDescription -> GenericPackageDescription
pdToGpd :: PackageDescription -> GenericPackageDescription
pdToGpd PackageDescription
pd = GenericPackageDescription
    { packageDescription :: PackageDescription
packageDescription = PackageDescription
pd
    , gpdScannedVersion :: Maybe Version
gpdScannedVersion  = forall a. Maybe a
Nothing
    , genPackageFlags :: [PackageFlag]
genPackageFlags    = []
    , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condLibrary        = forall {a} {v} {a}. a -> CondTree v [a] a
mkCondTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> Maybe Library
library PackageDescription
pd
    , condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries   = forall {v} {a}.
Library -> (UnqualComponentName, CondTree v [a] Library)
mkCondTreeL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Library]
subLibraries PackageDescription
pd
    , condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs    = forall a.
(a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' ForeignLib -> UnqualComponentName
foreignLibName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pd
    , condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables    = forall a.
(a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' Executable -> UnqualComponentName
exeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
executables PackageDescription
pd
    , condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites     = forall a.
(a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' TestSuite -> UnqualComponentName
testName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [TestSuite]
testSuites PackageDescription
pd
    , condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks     = forall a.
(a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' Benchmark -> UnqualComponentName
benchmarkName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Benchmark]
benchmarks PackageDescription
pd
    }
  where
    -- We set CondTree's [Dependency] to an empty list, as it
    -- is not pretty printed anyway.
    mkCondTree :: a -> CondTree v [a] a
mkCondTree  a
x = forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x [] []
    mkCondTreeL :: Library -> (UnqualComponentName, CondTree v [a] Library)
mkCondTreeL Library
l = (forall a. a -> Maybe a -> a
fromMaybe (String -> UnqualComponentName
mkUnqualComponentName String
"") (LibraryName -> Maybe UnqualComponentName
libraryNameString (Library -> LibraryName
libName Library
l)), forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode Library
l [] [])

    mkCondTree'
        :: (a -> UnqualComponentName)
        -> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
    mkCondTree' :: forall a.
(a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' a -> UnqualComponentName
f a
x = (a -> UnqualComponentName
f a
x, forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode a
x [] [])

-------------------------------------------------------------------------------
-- Internal libs
-------------------------------------------------------------------------------

-- See Note [Dependencies on sublibraries] in Distribution.PackageDescription.Parsec
--
preProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
preProcessInternalDeps :: CabalSpecVersion
-> GenericPackageDescription -> GenericPackageDescription
preProcessInternalDeps CabalSpecVersion
specVer GenericPackageDescription
gpd
    | CabalSpecVersion
specVer forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_4 = GenericPackageDescription
gpd
    | Bool
otherwise                = (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos BuildInfo -> BuildInfo
transformBI SetupBuildInfo -> SetupBuildInfo
transformSBI GenericPackageDescription
gpd
  where
    transformBI :: BuildInfo -> BuildInfo
    transformBI :: BuildInfo -> BuildInfo
transformBI
        = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
transformD)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasBuildInfo a => Lens' a [Mixin]
L.mixins (forall a b. (a -> b) -> [a] -> [b]
map Mixin -> Mixin
transformM)

    transformSBI :: SetupBuildInfo -> SetupBuildInfo
    transformSBI :: SetupBuildInfo -> SetupBuildInfo
transformSBI = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SetupBuildInfo [Dependency]
L.setupDepends (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dependency -> [Dependency]
transformD)

    transformD :: Dependency -> [Dependency]
    transformD :: Dependency -> [Dependency]
transformD (Dependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
ln)
        | PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
thisPn
        = if LibraryName
LMainLibName forall a. Ord a => a -> NonEmptySet a -> Bool
`NES.member` NonEmptySet LibraryName
ln
          then PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
thisPn VersionRange
vr NonEmptySet LibraryName
mainLibSet forall a. a -> [a] -> [a]
: [Dependency]
sublibs
          else [Dependency]
sublibs
      where
        sublibs :: [Dependency]
sublibs =
            [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency (UnqualComponentName -> PackageName
unqualComponentNameToPackageName UnqualComponentName
uqn) VersionRange
vr NonEmptySet LibraryName
mainLibSet
            | LSubLibName UnqualComponentName
uqn <- forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
ln
            ]

    transformD Dependency
d = [Dependency
d]

    transformM :: Mixin -> Mixin
    transformM :: Mixin -> Mixin
transformM (Mixin PackageName
pn (LSubLibName UnqualComponentName
uqn) IncludeRenaming
inc)
        | PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
thisPn
        = PackageName -> LibraryName -> IncludeRenaming -> Mixin
mkMixin (UnqualComponentName -> PackageName
unqualComponentNameToPackageName UnqualComponentName
uqn) LibraryName
LMainLibName IncludeRenaming
inc
    transformM Mixin
m = Mixin
m

    thisPn :: PackageName
    thisPn :: PackageName
thisPn = PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
gpd))

-------------------------------------------------------------------------------
-- HookedBuildInfo
-------------------------------------------------------------------------------

-- | @since 2.0.0.2
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo :: String -> HookedBuildInfo -> IO ()
writeHookedBuildInfo String
fpath = String -> ByteString -> IO ()
writeFileAtomic String
fpath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.Char8.pack
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. HookedBuildInfo -> String
showHookedBuildInfo

-- | @since 2.0.0.2
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo (Maybe BuildInfo
mb_lib_bi, [(UnqualComponentName, BuildInfo)]
ex_bis) = forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
showFields (forall a b. a -> b -> a
const CommentPosition
NoComment) forall a b. (a -> b) -> a -> b
$
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
cabalSpecLatest forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar) Maybe BuildInfo
mb_lib_bi forall a. [a] -> [a] -> [a]
++
    [ forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"executable:" [forall a. Pretty a => a -> Doc
pretty UnqualComponentName
name]
    forall a b. (a -> b) -> a -> b
$ forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
cabalSpecLatest forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g BuildInfo),
 c (List CommaFSep (Identity ExeDependency) ExeDependency),
 c (List
      CommaFSep (Identity LegacyExeDependency) LegacyExeDependency),
 c (List
      CommaFSep (Identity PkgconfigDependency) PkgconfigDependency),
 c (List CommaVCat (Identity Dependency) Dependency),
 c (List CommaVCat (Identity Mixin) Mixin),
 c (List FSep (MQuoted Extension) Extension),
 c (List FSep (MQuoted Language) Language),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (List NoCommaFSep Token' String),
 c (List VCat (MQuoted ModuleName) ModuleName),
 c (List VCat FilePathNT String),
 c (List
      FSep
      (Identity (SymbolicPath PackageDir SourceDir))
      (SymbolicPath PackageDir SourceDir)),
 c (List VCat Token String), c (MQuoted Language)) =>
g BuildInfo BuildInfo
buildInfoFieldGrammar BuildInfo
bi
    | (UnqualComponentName
name, BuildInfo
bi) <- [(UnqualComponentName, BuildInfo)]
ex_bis
    ]