Cabal-syntax/src/Distribution/InstalledPackageInfo.hs

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