1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Distribution.InstalledPackageInfo
4-- Copyright   :  (c) The University of Glasgow 2004
5--
6-- Maintainer  :  libraries@haskell.org
7-- Portability :  portable
8--
9-- This is the information about an /installed/ package that
10-- is communicated to the @ghc-pkg@ program in order to register
11-- a package.  @ghc-pkg@ now consumes this package format (as of version
12-- 6.4). This is specific to GHC at the moment.
13--
14-- The @.cabal@ file format is for describing a package that is not yet
15-- installed. It has a lot of flexibility, like conditionals and dependency
16-- ranges. As such, that format is not at all suitable for describing a package
17-- that has already been built and installed. By the time we get to that stage,
18-- we have resolved all conditionals and resolved dependency version
19-- constraints to exact versions of dependent packages. So, this module defines
20-- the 'InstalledPackageInfo' data structure that contains all the info we keep
21-- about an installed package. There is a parser and pretty printer. The
22-- textual format is rather simpler than the @.cabal@ format: there are no
23-- sections, for example.
24
25-- This module is meant to be local-only to Distribution...
26
27module Distribution.InstalledPackageInfo (
28        InstalledPackageInfo(..),
29        installedComponentId,
30        installedOpenUnitId,
31        sourceComponentName,
32        requiredSignatures,
33        ExposedModule(..),
34        AbiDependency(..),
35        emptyInstalledPackageInfo,
36        parseInstalledPackageInfo,
37        showInstalledPackageInfo,
38        showFullInstalledPackageInfo,
39        showInstalledPackageInfoField,
40        showSimpleInstalledPackageInfoField,
41  ) where
42
43import Distribution.Compat.Prelude
44import Prelude ()
45
46import Distribution.Backpack
47import Distribution.CabalSpecVersion         (cabalSpecLatest)
48import Distribution.FieldGrammar
49import Distribution.FieldGrammar.FieldDescrs
50import Distribution.ModuleName
51import Distribution.Package                  hiding (installedUnitId)
52import Distribution.Types.ComponentName
53import Distribution.Utils.Generic            (toUTF8BS)
54
55import Data.ByteString (ByteString)
56
57import qualified Data.Map            as Map
58import qualified Distribution.Fields as P
59import qualified Text.PrettyPrint    as Disp
60
61import Distribution.Types.InstalledPackageInfo
62import Distribution.Types.InstalledPackageInfo.FieldGrammar
63
64-- $setup
65-- >>> :set -XOverloadedStrings
66
67installedComponentId :: InstalledPackageInfo -> ComponentId
68installedComponentId ipi =
69    case unComponentId (installedComponentId_ ipi) of
70        "" -> mkComponentId (unUnitId (installedUnitId ipi))
71        _  -> installedComponentId_ ipi
72
73-- | Get the indefinite unit identity representing this package.
74-- This IS NOT guaranteed to give you a substitution; for
75-- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
76-- For indefinite libraries, however, you will correctly get
77-- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'.
78installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
79installedOpenUnitId ipi
80    = mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
81
82-- | Returns the set of module names which need to be filled for
83-- an indefinite package, or the empty set if the package is definite.
84requiredSignatures :: InstalledPackageInfo -> Set ModuleName
85requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
86
87-- -----------------------------------------------------------------------------
88-- Munging
89
90sourceComponentName :: InstalledPackageInfo -> ComponentName
91sourceComponentName = CLibName . sourceLibName
92
93-- -----------------------------------------------------------------------------
94-- Parsing
95
96-- | Return either errors, or IPI with list of warnings
97parseInstalledPackageInfo
98    :: ByteString
99    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
100parseInstalledPackageInfo s = case P.readFields s of
101    Left err -> Left (show err :| [])
102    Right fs -> case partitionFields fs of
103        (fs', _) -> case P.runParseResult $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of
104            (ws, Right x) -> x `deepseq` Right (ws', x) where
105                ws' = [ P.showPWarning "" w
106                      | w@(P.PWarning wt _ _) <- ws
107                      -- filter out warnings about experimental features
108                      , wt /= P.PWTExperimental
109                      ]
110            (_,  Left (_, errs)) -> Left errs' where
111                errs' = fmap (P.showPError "") errs
112
113-- -----------------------------------------------------------------------------
114-- Pretty-printing
115
116-- | Pretty print 'InstalledPackageInfo'.
117--
118-- @pkgRoot@ isn't printed, as ghc-pkg prints it manually (as GHC-8.4).
119showInstalledPackageInfo :: InstalledPackageInfo -> String
120showInstalledPackageInfo ipi =
121    showFullInstalledPackageInfo ipi { pkgRoot = Nothing }
122
123-- | The variant of 'showInstalledPackageInfo' which outputs @pkgroot@ field too.
124showFullInstalledPackageInfo :: InstalledPackageInfo -> String
125showFullInstalledPackageInfo = P.showFields (const []) . prettyFieldGrammar cabalSpecLatest ipiFieldGrammar
126
127-- |
128--
129-- >>> let ipi = emptyInstalledPackageInfo { maintainer = "Tester" }
130-- >>> fmap ($ ipi) $ showInstalledPackageInfoField "maintainer"
131-- Just "maintainer: Tester"
132showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
133showInstalledPackageInfoField fn =
134    fmap (\g -> Disp.render . ppField fn . g) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn)
135
136showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
137showSimpleInstalledPackageInfoField fn =
138    fmap (Disp.renderStyle myStyle .) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn)
139  where
140    myStyle = Disp.style { Disp.mode = Disp.LeftMode }
141
142ppField :: String -> Disp.Doc -> Disp.Doc
143ppField name fielddoc
144     | Disp.isEmpty fielddoc = mempty
145     | otherwise             = Disp.text name <<>> Disp.colon Disp.<+> fielddoc
146