module Distribution.PackageDescription.PrettyPrint (
writeGenericPackageDescription,
showGenericPackageDescription,
ppGenericPackageDescription,
writePackageDescription,
showPackageDescription,
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.Simple.Utils (writeFileAtomic, writeUTF8File)
import Distribution.Types.Mixin (Mixin (..), mkMixin)
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 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
writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO ()
writeGenericPackageDescription fpath pkg = writeUTF8File fpath (showGenericPackageDescription pkg)
showGenericPackageDescription :: GenericPackageDescription -> String
showGenericPackageDescription gpd = showFields (const []) $ ppGenericPackageDescription v gpd
where
v = specVersion $ packageDescription gpd
ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
ppGenericPackageDescription v gpd0 = concat
[ ppPackageDescription v (packageDescription gpd)
, ppSetupBInfo v (setupBuildInfo (packageDescription gpd))
, ppGenPackageFlags v (genPackageFlags gpd)
, ppCondLibrary v (condLibrary gpd)
, ppCondSubLibraries v (condSubLibraries gpd)
, ppCondForeignLibs v (condForeignLibs gpd)
, ppCondExecutables v (condExecutables gpd)
, ppCondTestSuites v (condTestSuites gpd)
, ppCondBenchmarks v (condBenchmarks gpd)
]
where
gpd = preProcessInternalDeps (specVersion (packageDescription gpd0)) gpd0
ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()]
ppPackageDescription v pd =
prettyFieldGrammar v packageDescriptionFieldGrammar pd
++ ppSourceRepos v (sourceRepos pd)
ppSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [PrettyField ()]
ppSourceRepos = map . ppSourceRepo
ppSourceRepo :: CabalSpecVersion -> SourceRepo -> PrettyField ()
ppSourceRepo v repo = PrettySection () "source-repository" [pretty kind] $
prettyFieldGrammar v (sourceRepoFieldGrammar kind) repo
where
kind = repoKind repo
ppSetupBInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [PrettyField ()]
ppSetupBInfo _ Nothing = mempty
ppSetupBInfo v (Just sbi)
| defaultSetupDepends sbi = mempty
| otherwise = pure $ PrettySection () "custom-setup" [] $
prettyFieldGrammar v (setupBInfoFieldGrammar False) sbi
ppGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [PrettyField ()]
ppGenPackageFlags = map . ppFlag
ppFlag :: CabalSpecVersion -> PackageFlag -> PrettyField ()
ppFlag v flag@(MkPackageFlag name _ _ _) = PrettySection () "flag" [ppFlagName name] $
prettyFieldGrammar v (flagFieldGrammar name) flag
ppCondTree2 :: CabalSpecVersion -> PrettyFieldGrammar' s -> CondTree ConfVar [Dependency] s -> [PrettyField ()]
ppCondTree2 v grammar = go
where
go (CondNode it _ ifs) =
prettyFieldGrammar v grammar it ++
concatMap ppIf ifs
ppIf (CondBranch c thenTree Nothing)
| otherwise = [ppIfCondition c thenDoc]
where
thenDoc = go thenTree
ppIf (CondBranch c thenTree (Just elseTree)) =
[ ppIfCondition c (go thenTree)
, PrettySection () "else" [] (go elseTree)
]
ppCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [PrettyField ()]
ppCondLibrary _ Nothing = mempty
ppCondLibrary v (Just condTree) = pure $ PrettySection () "library" [] $
ppCondTree2 v (libraryFieldGrammar LMainLibName) condTree
ppCondSubLibraries :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [PrettyField ()]
ppCondSubLibraries v libs =
[ PrettySection () "library" [pretty n]
$ ppCondTree2 v (libraryFieldGrammar $ LSubLibName n) condTree
| (n, condTree) <- libs
]
ppCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [PrettyField ()]
ppCondForeignLibs v flibs =
[ PrettySection () "foreign-library" [pretty n]
$ ppCondTree2 v (foreignLibFieldGrammar n) condTree
| (n, condTree) <- flibs
]
ppCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [PrettyField ()]
ppCondExecutables v exes =
[ PrettySection () "executable" [pretty n]
$ ppCondTree2 v (executableFieldGrammar n) condTree
| (n, condTree) <- exes
]
ppCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [PrettyField ()]
ppCondTestSuites v suites =
[ PrettySection () "test-suite" [pretty n]
$ ppCondTree2 v testSuiteFieldGrammar (fmap FG.unvalidateTestSuite condTree)
| (n, condTree) <- suites
]
ppCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [PrettyField ()]
ppCondBenchmarks v suites =
[ PrettySection () "benchmark" [pretty n]
$ ppCondTree2 v benchmarkFieldGrammar (fmap FG.unvalidateBenchmark condTree)
| (n, condTree) <- suites
]
ppCondition :: Condition ConfVar -> Doc
ppCondition (Var x) = ppConfVar x
ppCondition (Lit b) = text (show b)
ppCondition (CNot c) = char '!' <<>> (ppCondition c)
ppCondition (COr c1 c2) = parens (hsep [ppCondition c1, text "||"
<+> ppCondition c2])
ppCondition (CAnd c1 c2) = parens (hsep [ppCondition c1, text "&&"
<+> ppCondition c2])
ppConfVar :: ConfVar -> Doc
ppConfVar (OS os) = text "os" <<>> parens (pretty os)
ppConfVar (Arch arch) = text "arch" <<>> parens (pretty arch)
ppConfVar (PackageFlag name) = text "flag" <<>> parens (ppFlagName name)
ppConfVar (Impl c v) = text "impl" <<>> parens (pretty c <+> pretty v)
ppFlagName :: FlagName -> Doc
ppFlagName = text . unFlagName
ppIfCondition :: Condition ConfVar -> [PrettyField ()] -> PrettyField ()
ppIfCondition c = PrettySection () "if" [ppCondition c]
writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription fpath pkg = writeUTF8File fpath (showPackageDescription pkg)
showPackageDescription :: PackageDescription -> String
showPackageDescription = showGenericPackageDescription . pdToGpd
pdToGpd :: PackageDescription -> GenericPackageDescription
pdToGpd pd = GenericPackageDescription
{ packageDescription = pd
, gpdScannedVersion = Nothing
, genPackageFlags = []
, condLibrary = mkCondTree <$> library pd
, condSubLibraries = mkCondTreeL <$> subLibraries pd
, condForeignLibs = mkCondTree' foreignLibName <$> foreignLibs pd
, condExecutables = mkCondTree' exeName <$> executables pd
, condTestSuites = mkCondTree' testName <$> testSuites pd
, condBenchmarks = mkCondTree' benchmarkName <$> benchmarks pd
}
where
mkCondTree x = CondNode x [] []
mkCondTreeL l = (fromMaybe (mkUnqualComponentName "") (libraryNameString (libName l)), CondNode l [] [])
mkCondTree'
:: (a -> UnqualComponentName)
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
mkCondTree' f x = (f x, CondNode x [] [])
preProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
preProcessInternalDeps specVer gpd
| specVer >= CabalSpecV3_4 = gpd
| otherwise = transformAllBuildInfos transformBI transformSBI gpd
where
transformBI :: BuildInfo -> BuildInfo
transformBI
= over L.targetBuildDepends (concatMap transformD)
. over L.mixins (map transformM)
transformSBI :: SetupBuildInfo -> SetupBuildInfo
transformSBI = over L.setupDepends (concatMap transformD)
transformD :: Dependency -> [Dependency]
transformD (Dependency pn vr ln)
| pn == thisPn
= if LMainLibName `NES.member` ln
then Dependency thisPn vr mainLibSet : sublibs
else sublibs
where
sublibs =
[ Dependency (unqualComponentNameToPackageName uqn) vr mainLibSet
| LSubLibName uqn <- NES.toList ln
]
transformD d = [d]
transformM :: Mixin -> Mixin
transformM (Mixin pn (LSubLibName uqn) inc)
| pn == thisPn
= mkMixin (unqualComponentNameToPackageName uqn) LMainLibName inc
transformM m = m
thisPn :: PackageName
thisPn = pkgName (package (packageDescription gpd))
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
. showHookedBuildInfo
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo (mb_lib_bi, ex_bis) = showFields (const []) $
maybe mempty (prettyFieldGrammar cabalSpecLatest buildInfoFieldGrammar) mb_lib_bi ++
[ PrettySection () "executable:" [pretty name]
$ prettyFieldGrammar cabalSpecLatest buildInfoFieldGrammar bi
| (name, bi) <- ex_bis
]