    -----------------------------------------------------------------------------

    -- This module is meant to be local-only to Distribution...

    -- |
    -- Module      :  Distribution.InstalledPackageInfo
    -- Copyright   :  (c) The University of Glasgow 2004
    --
    -- Maintainer  :  libraries@haskell.org
    -- Portability :  portable
    --
    -- This is the information about an /installed/ package that
    -- is communicated to the @ghc-pkg@ program in order to register
    -- a package.  @ghc-pkg@ now consumes this package format (as of version
    -- 6.4). This is specific to GHC at the moment.
    --
    -- The @.cabal@ file format is for describing a package that is not yet
    -- installed. It has a lot of flexibility, like conditionals and dependency
    -- ranges. As such, that format is not at all suitable for describing a package
    -- that has already been built and installed. By the time we get to that stage,
    -- we have resolved all conditionals and resolved dependency version
    -- constraints to exact versions of dependent packages. So, this module defines
    -- the 'InstalledPackageInfo' data structure that contains all the info we keep
    -- about an installed package. There is a parser and pretty printer. The
    -- textual format is rather simpler than the @.cabal@ format: there are no
    -- sections, for example.
    module Distribution.InstalledPackageInfo
      ( InstalledPackageInfo (..)
      , installedComponentId
      , installedOpenUnitId
      , sourceComponentName
      , requiredSignatures
      , ExposedModule (..)
      , AbiDependency (..)
      , emptyInstalledPackageInfo
      , parseInstalledPackageInfo
      , showInstalledPackageInfo
      , showFullInstalledPackageInfo
      , showInstalledPackageInfoField
      , showSimpleInstalledPackageInfoField
      ) where

    import Distribution.Compat.Prelude
    import Prelude ()

    import Distribution.Backpack
    import Distribution.CabalSpecVersion (cabalSpecLatest)
    import Distribution.FieldGrammar
    import Distribution.FieldGrammar.FieldDescrs
    import Distribution.Fields.Pretty
    import Distribution.ModuleName
    import Distribution.Package hiding (installedUnitId)
    import Distribution.Types.ComponentName
    import Distribution.Utils.Generic (toUTF8BS)

    import Data.ByteString (ByteString)

    import qualified Data.Map as Map
    import qualified Distribution.Fields as P
    import qualified Text.PrettyPrint as Disp

    import Distribution.Types.InstalledPackageInfo
    import Distribution.Types.InstalledPackageInfo.FieldGrammar

    installedComponentId :: InstalledPackageInfo -> ComponentId
    installedComponentId :: InstalledPackageInfo -> ComponentId
    installedComponentId InstalledPackageInfo
    ipi =
      case ComponentId -> String
    unComponentId (InstalledPackageInfo -> ComponentId
    installedComponentId_ InstalledPackageInfo
    ipi) of
        String
    "" -> String -> ComponentId
    mkComponentId (UnitId -> String
    unUnitId (InstalledPackageInfo -> UnitId
    installedUnitId InstalledPackageInfo
    ipi))
        String
    _ -> InstalledPackageInfo -> ComponentId
    installedComponentId_ InstalledPackageInfo
    ipi

    -- | Get the indefinite unit identity representing this package.
    -- This IS NOT guaranteed to give you a substitution; for
    -- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
    -- For indefinite libraries, however, you will correctly get
    -- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'.
    installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
    installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
    installedOpenUnitId InstalledPackageInfo
    ipi =
      UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
    mkOpenUnitId (InstalledPackageInfo -> UnitId
    installedUnitId InstalledPackageInfo
    ipi) (InstalledPackageInfo -> ComponentId
    installedComponentId InstalledPackageInfo
    ipi) ([(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
    instantiatedWith InstalledPackageInfo
    ipi))

    -- | Returns the set of module names which need to be filled for
    -- an indefinite package, or the empty set if the package is definite.
    requiredSignatures :: InstalledPackageInfo -> Set ModuleName
    requiredSignatures :: InstalledPackageInfo -> Set ModuleName
    requiredSignatures InstalledPackageInfo
    ipi = OpenModuleSubst -> Set ModuleName
    openModuleSubstFreeHoles ([(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
    instantiatedWith InstalledPackageInfo
    ipi))

    -- -----------------------------------------------------------------------------
    -- Munging

    sourceComponentName :: InstalledPackageInfo -> ComponentName
    sourceComponentName :: InstalledPackageInfo -> ComponentName
    sourceComponentName = LibraryName -> ComponentName
    CLibName (LibraryName -> ComponentName)
    -> (InstalledPackageInfo -> LibraryName)
    -> InstalledPackageInfo
    -> ComponentName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InstalledPackageInfo -> LibraryName
    sourceLibName

    -- -----------------------------------------------------------------------------
    -- Parsing

    -- | Return either errors, or IPI with list of warnings
    parseInstalledPackageInfo
      :: ByteString
      -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    parseInstalledPackageInfo :: ByteString
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    parseInstalledPackageInfo ByteString
    s = case ByteString -> Either ParseError [Field Position]
    P.readFields ByteString
    s of
      Left ParseError
    err -> NonEmpty String
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    forall a b. a -> Either a b
    Left (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    err String -> [String] -> NonEmpty String
    forall a. a -> [a] -> NonEmpty a
    :| [])
      Right [Field Position]
    fs -> case [Field Position] -> (Fields Position, [[Section Position]])
    forall ann. [Field ann] -> (Fields ann, [[Section ann]])
    partitionFields [Field Position]
    fs of
        (Fields Position
    fs', [[Section Position]]
    _) -> case ParseResult InstalledPackageInfo
    -> ([PWarning],
        Either (Maybe Version, NonEmpty PError) InstalledPackageInfo)
    forall a.
    ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    P.runParseResult (ParseResult InstalledPackageInfo
     -> ([PWarning],
         Either (Maybe Version, NonEmpty PError) InstalledPackageInfo))
    -> ParseResult InstalledPackageInfo
    -> ([PWarning],
        Either (Maybe Version, NonEmpty PError) InstalledPackageInfo)
    forall a b. (a -> b) -> a -> b
    $ CabalSpecVersion
    -> Fields Position
    -> ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo
    -> ParseResult InstalledPackageInfo
    forall s a.
    CabalSpecVersion
    -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
    parseFieldGrammar CabalSpecVersion
    cabalSpecLatest Fields Position
    fs' ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo
    forall (c :: * -> Constraint) (g :: * -> * -> *).
    (FieldGrammar c g, Applicative (g InstalledPackageInfo),
     Applicative (g Basic), c (Identity AbiHash),
     c (Identity LibraryVisibility), c (Identity PackageName),
     c (Identity UnitId), c (Identity UnqualComponentName),
     c (List FSep (Identity AbiDependency) AbiDependency),
     c (List FSep (Identity UnitId) UnitId),
     c (List FSep (MQuoted ModuleName) ModuleName),
     c (List FSep FilePathNT String), c (List FSep Token String),
     c (MQuoted MungedPackageName), c (MQuoted Version),
     c CompatPackageKey, c ExposedModules, c InstWith,
     c SpecLicenseLenient) =>
    g InstalledPackageInfo InstalledPackageInfo
    ipiFieldGrammar of
          ([PWarning]
    ws, Right InstalledPackageInfo
    x) -> InstalledPackageInfo
    x InstalledPackageInfo
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    forall a b. NFData a => a -> b -> b
    `deepseq` ([String], InstalledPackageInfo)
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    forall a b. b -> Either a b
    Right ([String]
    ws', InstalledPackageInfo
    x)
            where
              ws' :: [String]
    ws' =
                [ String -> PWarning -> String
    P.showPWarning String
    "" PWarning
    w
                | w :: PWarning
    w@(P.PWarning PWarnType
    wt Position
    _ String
    _) <- [PWarning]
    ws
                , -- filter out warnings about experimental features
                PWarnType
    wt PWarnType -> PWarnType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= PWarnType
    P.PWTExperimental
                ]
          ([PWarning]
    _, Left (Maybe Version
    _, NonEmpty PError
    errs)) -> NonEmpty String
    -> Either (NonEmpty String) ([String], InstalledPackageInfo)
    forall a b. a -> Either a b
    Left NonEmpty String
    errs'
            where
              errs' :: NonEmpty String
    errs' = (PError -> String) -> NonEmpty PError -> NonEmpty String
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> PError -> String
    P.showPError String
    "") NonEmpty PError
    errs

    -- -----------------------------------------------------------------------------
    -- Pretty-printing

    -- | Pretty print 'InstalledPackageInfo'.
    --
    -- @pkgRoot@ isn't printed, as ghc-pkg prints it manually (as GHC-8.4).
    showInstalledPackageInfo :: InstalledPackageInfo -> String
    showInstalledPackageInfo :: InstalledPackageInfo -> String
    showInstalledPackageInfo InstalledPackageInfo
    ipi =
      InstalledPackageInfo -> String
    showFullInstalledPackageInfo InstalledPackageInfo
    ipi{pkgRoot = Nothing}

    -- | The variant of 'showInstalledPackageInfo' which outputs @pkgroot@ field too.
    showFullInstalledPackageInfo :: InstalledPackageInfo -> String
    showFullInstalledPackageInfo :: InstalledPackageInfo -> String
    showFullInstalledPackageInfo = (() -> CommentPosition) -> [PrettyField ()] -> String
    forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
    P.showFields (CommentPosition -> () -> CommentPosition
    forall a b. a -> b -> a
    const CommentPosition
    NoComment) ([PrettyField ()] -> String)
    -> (InstalledPackageInfo -> [PrettyField ()])
    -> InstalledPackageInfo
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CabalSpecVersion
    -> PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo
    -> InstalledPackageInfo
    -> [PrettyField ()]
    forall s a.
    CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
    prettyFieldGrammar CabalSpecVersion
    cabalSpecLatest PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo
    forall (c :: * -> Constraint) (g :: * -> * -> *).
    (FieldGrammar c g, Applicative (g InstalledPackageInfo),
     Applicative (g Basic), c (Identity AbiHash),
     c (Identity LibraryVisibility), c (Identity PackageName),
     c (Identity UnitId), c (Identity UnqualComponentName),
     c (List FSep (Identity AbiDependency) AbiDependency),
     c (List FSep (Identity UnitId) UnitId),
     c (List FSep (MQuoted ModuleName) ModuleName),
     c (List FSep FilePathNT String), c (List FSep Token String),
     c (MQuoted MungedPackageName), c (MQuoted Version),
     c CompatPackageKey, c ExposedModules, c InstWith,
     c SpecLicenseLenient) =>
    g InstalledPackageInfo InstalledPackageInfo
    ipiFieldGrammar

    -- |
    --
    -- >>> let ipi = emptyInstalledPackageInfo { maintainer = fromString "Tester" }
    -- >>> fmap ($ ipi) $ showInstalledPackageInfoField "maintainer"
    -- Just "maintainer: Tester"
    showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showInstalledPackageInfoField String
    fn =
      ((InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String)
    -> Maybe (InstalledPackageInfo -> Doc)
    -> Maybe (InstalledPackageInfo -> String)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\InstalledPackageInfo -> Doc
    g -> Doc -> String
    Disp.render (Doc -> String)
    -> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc -> Doc
    ppField String
    fn (Doc -> Doc)
    -> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InstalledPackageInfo -> Doc
    g) (Maybe (InstalledPackageInfo -> Doc)
     -> Maybe (InstalledPackageInfo -> String))
    -> Maybe (InstalledPackageInfo -> Doc)
    -> Maybe (InstalledPackageInfo -> String)
    forall a b. (a -> b) -> a -> b
    $ FieldDescrs InstalledPackageInfo InstalledPackageInfo
    -> ByteString -> Maybe (InstalledPackageInfo -> Doc)
    forall s a. FieldDescrs s a -> ByteString -> Maybe (s -> Doc)
    fieldDescrPretty FieldDescrs InstalledPackageInfo InstalledPackageInfo
    forall (c :: * -> Constraint) (g :: * -> * -> *).
    (FieldGrammar c g, Applicative (g InstalledPackageInfo),
     Applicative (g Basic), c (Identity AbiHash),
     c (Identity LibraryVisibility), c (Identity PackageName),
     c (Identity UnitId), c (Identity UnqualComponentName),
     c (List FSep (Identity AbiDependency) AbiDependency),
     c (List FSep (Identity UnitId) UnitId),
     c (List FSep (MQuoted ModuleName) ModuleName),
     c (List FSep FilePathNT String), c (List FSep Token String),
     c (MQuoted MungedPackageName), c (MQuoted Version),
     c CompatPackageKey, c ExposedModules, c InstWith,
     c SpecLicenseLenient) =>
    g InstalledPackageInfo InstalledPackageInfo
    ipiFieldGrammar (String -> ByteString
    toUTF8BS String
    fn)

    showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showSimpleInstalledPackageInfoField String
    fn =
      ((InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String)
    -> Maybe (InstalledPackageInfo -> Doc)
    -> Maybe (InstalledPackageInfo -> String)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Style -> Doc -> String
    Disp.renderStyle Style
    myStyle (Doc -> String)
    -> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) (Maybe (InstalledPackageInfo -> Doc)
     -> Maybe (InstalledPackageInfo -> String))
    -> Maybe (InstalledPackageInfo -> Doc)
    -> Maybe (InstalledPackageInfo -> String)
    forall a b. (a -> b) -> a -> b
    $ FieldDescrs InstalledPackageInfo InstalledPackageInfo
    -> ByteString -> Maybe (InstalledPackageInfo -> Doc)
    forall s a. FieldDescrs s a -> ByteString -> Maybe (s -> Doc)
    fieldDescrPretty FieldDescrs InstalledPackageInfo InstalledPackageInfo
    forall (c :: * -> Constraint) (g :: * -> * -> *).
    (FieldGrammar c g, Applicative (g InstalledPackageInfo),
     Applicative (g Basic), c (Identity AbiHash),
     c (Identity LibraryVisibility), c (Identity PackageName),
     c (Identity UnitId), c (Identity UnqualComponentName),
     c (List FSep (Identity AbiDependency) AbiDependency),
     c (List FSep (Identity UnitId) UnitId),
     c (List FSep (MQuoted ModuleName) ModuleName),
     c (List FSep FilePathNT String), c (List FSep Token String),
     c (MQuoted MungedPackageName), c (MQuoted Version),
     c CompatPackageKey, c ExposedModules, c InstWith,
     c SpecLicenseLenient) =>
    g InstalledPackageInfo InstalledPackageInfo
    ipiFieldGrammar (String -> ByteString
    toUTF8BS String
    fn)
      where
        myStyle :: Style
    myStyle = Style
    Disp.style{Disp.mode = Disp.LeftMode}

    ppField :: String -> Disp.Doc -> Disp.Doc
    ppField :: String -> Doc -> Doc
    ppField String
    name Doc
    fielddoc
      | Doc -> Bool
    Disp.isEmpty Doc
    fielddoc = Doc
    forall a. Monoid a => a
    mempty
      | Bool
    otherwise = String -> Doc
    Disp.text String
    name Doc -> Doc -> Doc
    <<>> Doc
    Disp.colon Doc -> Doc -> Doc
    Disp.<+> Doc
    fielddoc