content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE TypeFamilies #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- 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.
  
  -- This module is meant to be local-only to Distribution...
  
  module Distribution.InstalledPackageInfo (
          InstalledPackageInfo(..),
          installedPackageId,
          installedComponentId,
          installedOpenUnitId,
          sourceComponentName,
          requiredSignatures,
          ExposedModule(..),
          AbiDependency(..),
          ParseResult(..), PError(..), PWarning,
          emptyInstalledPackageInfo,
          parseInstalledPackageInfo,
          showInstalledPackageInfo,
          showInstalledPackageInfoField,
          showSimpleInstalledPackageInfoField,
          fieldsInstalledPackageInfo,
    ) where
  
  import Prelude ()
  import Distribution.Compat.Prelude
  
  import Distribution.ParseUtils
  import Distribution.License
  import Distribution.Package hiding (installedUnitId, installedPackageId)
  import Distribution.Backpack
  import qualified Distribution.Package as Package
  import Distribution.ModuleName
  import Distribution.Version
  import Distribution.Text
  import qualified Distribution.Compat.ReadP as Parse
  import Distribution.Compat.Graph
  import Distribution.Types.MungedPackageId
  import Distribution.Types.ComponentName
  import Distribution.Types.MungedPackageName
  import Distribution.Types.UnqualComponentName
  
  import Text.PrettyPrint as Disp
  import qualified Data.Char as Char
  import qualified Data.Map as Map
  import Data.Set (Set)
  
  -- -----------------------------------------------------------------------------
  -- The InstalledPackageInfo type
  
  -- For BC reasons, we continue to name this record an InstalledPackageInfo;
  -- but it would more accurately be called an InstalledUnitInfo with Backpack
  data InstalledPackageInfo
     = InstalledPackageInfo {
          -- these parts are exactly the same as PackageDescription
          sourcePackageId   :: PackageId,
          installedUnitId   :: UnitId,
          installedComponentId_ :: ComponentId,
          -- INVARIANT: if this package is definite, OpenModule's
          -- OpenUnitId directly records UnitId.  If it is
          -- indefinite, OpenModule is always an OpenModuleVar
          -- with the same ModuleName as the key.
          instantiatedWith  :: [(ModuleName, OpenModule)],
          sourceLibName     :: Maybe UnqualComponentName,
          compatPackageKey  :: String,
          license           :: License,
          copyright         :: String,
          maintainer        :: String,
          author            :: String,
          stability         :: String,
          homepage          :: String,
          pkgUrl            :: String,
          synopsis          :: String,
          description       :: String,
          category          :: String,
          -- these parts are required by an installed package only:
          abiHash           :: AbiHash,
          indefinite        :: Bool,
          exposed           :: Bool,
          -- INVARIANT: if the package is definite, OpenModule's
          -- OpenUnitId directly records UnitId.
          exposedModules    :: [ExposedModule],
          hiddenModules     :: [ModuleName],
          trusted           :: Bool,
          importDirs        :: [FilePath],
          libraryDirs       :: [FilePath],
          libraryDynDirs    :: [FilePath],  -- ^ overrides 'libraryDirs'
          dataDir           :: FilePath,
          hsLibraries       :: [String],
          extraLibraries    :: [String],
          extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi
          includeDirs       :: [FilePath],
          includes          :: [String],
          -- INVARIANT: if the package is definite, UnitId is NOT
          -- a ComponentId of an indefinite package
          depends           :: [UnitId],
          abiDepends        :: [AbiDependency],
          ccOptions         :: [String],
          ldOptions         :: [String],
          frameworkDirs     :: [FilePath],
          frameworks        :: [String],
          haddockInterfaces :: [FilePath],
          haddockHTMLs      :: [FilePath],
          pkgRoot           :: Maybe FilePath
      }
      deriving (Eq, Generic, Typeable, Read, Show)
  
  installedComponentId :: InstalledPackageInfo -> ComponentId
  installedComponentId ipi =
      case unComponentId (installedComponentId_ ipi) of
          "" -> mkComponentId (unUnitId (installedUnitId ipi))
          _  -> installedComponentId_ 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 ipi
      = mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith 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 ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
  
  {-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
  -- | Backwards compatibility with Cabal pre-1.24.
  --
  -- This type synonym is slightly awful because in etlas
  -- we define an 'InstalledPackageId' but it's a ComponentId,
  -- not a UnitId!
  installedPackageId :: InstalledPackageInfo -> UnitId
  installedPackageId = installedUnitId
  
  instance Binary InstalledPackageInfo
  
  instance Package.HasMungedPackageId InstalledPackageInfo where
     mungedId = mungedPackageId
  
  instance Package.Package InstalledPackageInfo where
     packageId = sourcePackageId
  
  instance Package.HasUnitId InstalledPackageInfo where
     installedUnitId = installedUnitId
  
  instance Package.PackageInstalled InstalledPackageInfo where
     installedDepends = depends
  
  instance IsNode InstalledPackageInfo where
      type Key InstalledPackageInfo = UnitId
      nodeKey       = installedUnitId
      nodeNeighbors = depends
  
  emptyInstalledPackageInfo :: InstalledPackageInfo
  emptyInstalledPackageInfo
     = InstalledPackageInfo {
          sourcePackageId   = PackageIdentifier (mkPackageName "") nullVersion,
          installedUnitId   = mkUnitId "",
          installedComponentId_ = mkComponentId "",
          instantiatedWith  = [],
          sourceLibName     = Nothing,
          compatPackageKey  = "",
          license           = UnspecifiedLicense,
          copyright         = "",
          maintainer        = "",
          author            = "",
          stability         = "",
          homepage          = "",
          pkgUrl            = "",
          synopsis          = "",
          description       = "",
          category          = "",
          abiHash           = mkAbiHash "",
          indefinite        = False,
          exposed           = False,
          exposedModules    = [],
          hiddenModules     = [],
          trusted           = False,
          importDirs        = [],
          libraryDirs       = [],
          libraryDynDirs    = [],
          dataDir           = "",
          hsLibraries       = [],
          extraLibraries    = [],
          extraGHCiLibraries= [],
          includeDirs       = [],
          includes          = [],
          depends           = [],
          abiDepends        = [],
          ccOptions         = [],
          ldOptions         = [],
          frameworkDirs     = [],
          frameworks        = [],
          haddockInterfaces = [],
          haddockHTMLs      = [],
          pkgRoot           = Nothing
      }
  
  -- -----------------------------------------------------------------------------
  -- Exposed modules
  
  data ExposedModule
     = ExposedModule {
         exposedName      :: ModuleName,
         exposedReexport  :: Maybe OpenModule
       }
    deriving (Eq, Generic, Read, Show)
  
  instance Text ExposedModule where
      disp (ExposedModule m reexport) =
          Disp.hsep [ disp m
                    , case reexport of
                       Just m' -> Disp.hsep [Disp.text "from", disp m']
                       Nothing -> Disp.empty
                    ]
      parse = do
          m <- parseModuleNameQ
          Parse.skipSpaces
          reexport <- Parse.option Nothing $ do
              _ <- Parse.string "from"
              Parse.skipSpaces
              fmap Just parse
          return (ExposedModule m reexport)
  
  instance Binary ExposedModule
  
  -- To maintain backwards-compatibility, we accept both comma/non-comma
  -- separated variants of this field.  You SHOULD use the comma syntax if you
  -- use any new functions, although actually it's unambiguous due to a quirk
  -- of the fact that modules must start with capital letters.
  
  showExposedModules :: [ExposedModule] -> Disp.Doc
  showExposedModules xs
      | all isExposedModule xs = fsep (map disp xs)
      | otherwise = fsep (Disp.punctuate comma (map disp xs))
      where isExposedModule (ExposedModule _ Nothing) = True
            isExposedModule _ = False
  
  parseExposedModules :: Parse.ReadP r [ExposedModule]
  parseExposedModules = parseOptCommaList parse
  
  dispMaybe :: Text a => Maybe a -> Disp.Doc
  dispMaybe Nothing = Disp.empty
  dispMaybe (Just x) = disp x
  
  parseMaybe :: Text a => Parse.ReadP r (Maybe a)
  parseMaybe = fmap Just parse Parse.<++ return Nothing
  
  -- -----------------------------------------------------------------------------
  -- ABI dependency
  
  -- | An ABI dependency is a dependency on a library which also
  -- records the ABI hash ('abiHash') of the library it depends
  -- on.
  --
  -- The primary utility of this is to enable an extra sanity when
  -- GHC loads libraries: it can check if the dependency has a matching
  -- ABI and if not, refuse to load this library.  This information
  -- is critical if we are shadowing libraries; differences in the
  -- ABI hash let us know what packages get shadowed by the new version
  -- of a package.
  data AbiDependency = AbiDependency {
          depUnitId  :: UnitId,
          depAbiHash :: AbiHash
      }
    deriving (Eq, Generic, Read, Show)
  
  instance Text AbiDependency where
      disp (AbiDependency uid abi) =
          disp uid <<>> Disp.char '=' <<>> disp abi
      parse = do
          uid <- parse
          _ <- Parse.char '='
          abi <- parse
          return (AbiDependency uid abi)
  
  instance Binary AbiDependency
  
  -- -----------------------------------------------------------------------------
  -- Munging
  
  sourceComponentName :: InstalledPackageInfo -> ComponentName
  sourceComponentName ipi =
      case sourceLibName ipi of
          Nothing -> CLibName
          Just qn -> CSubLibName qn
  
  -- | Returns @Just@ if the @name@ field of the IPI record would not contain
  -- the package name verbatim.  This helps us avoid writing @package-name@
  -- when it's redundant.
  maybePackageName :: InstalledPackageInfo -> Maybe PackageName
  maybePackageName ipi =
      case sourceLibName ipi of
          Nothing -> Nothing
          Just _ -> Just (packageName ipi)
  
  -- | Setter for the @package-name@ field.  It should be acceptable for this
  -- to be a no-op.
  setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
  setMaybePackageName Nothing ipi = ipi
  setMaybePackageName (Just pn) ipi = ipi {
          sourcePackageId=(sourcePackageId ipi){pkgName=pn}
      }
  
  -- | Returns the munged package name, which we write into @name@ for
  -- compatibility with old versions of GHC.
  mungedPackageName :: InstalledPackageInfo -> MungedPackageName
  mungedPackageName ipi =
      computeCompatPackageName
          (packageName ipi)
          (sourceLibName ipi)
  
  setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
  setMungedPackageName mpn ipi =
      let (pn, mb_uqn) = decodeCompatPackageName mpn
      in ipi {
              sourcePackageId = (sourcePackageId ipi) {pkgName=pn},
              sourceLibName   = mb_uqn
          }
  
  mungedPackageId :: InstalledPackageInfo -> MungedPackageId
  mungedPackageId ipi =
      MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
  
  -- -----------------------------------------------------------------------------
  -- Parsing
  
  parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
  parseInstalledPackageInfo =
      parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
      emptyInstalledPackageInfo
  
  -- -----------------------------------------------------------------------------
  -- Pretty-printing
  
  showInstalledPackageInfo :: InstalledPackageInfo -> String
  showInstalledPackageInfo = showFields fieldsInstalledPackageInfo
  
  showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
  showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
  
  showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
  showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo
  
  dispCompatPackageKey :: String -> Doc
  dispCompatPackageKey = text
  
  parseCompatPackageKey :: Parse.ReadP r String
  parseCompatPackageKey = Parse.munch1 uid_char
      where uid_char c = Char.isAlphaNum c || c `elem` "-_.=[],:<>+"
  
  -- -----------------------------------------------------------------------------
  -- Description of the fields, for parsing/printing
  
  fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]
  fieldsInstalledPackageInfo = basicFieldDescrs ++ installedFieldDescrs
  
  basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
  basicFieldDescrs =
   [ simpleField "name"
                             disp                   (parseMaybeQuoted parse)
                             mungedPackageName      setMungedPackageName
   , simpleField "version"
                             disp                   parseOptVersion
                             packageVersion         (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
   , simpleField "id"
                             disp                   parse
                             installedUnitId        (\pk pkg -> pkg{installedUnitId=pk})
   , simpleField "instantiated-with"
          (dispOpenModuleSubst . Map.fromList)    (fmap Map.toList parseOpenModuleSubst)
          instantiatedWith   (\iw    pkg -> pkg{instantiatedWith=iw})
   , simpleField "package-name"
                             dispMaybe              parseMaybe
                             maybePackageName       setMaybePackageName
   , simpleField "lib-name"
                             dispMaybe              parseMaybe
                             sourceLibName          (\n pkg -> pkg{sourceLibName=n})
   , simpleField "key"
                             dispCompatPackageKey   parseCompatPackageKey
                             compatPackageKey       (\pk pkg -> pkg{compatPackageKey=pk})
   , simpleField "license"
                             disp                   parseLicenseQ
                             license                (\l pkg -> pkg{license=l})
   , simpleField "copyright"
                             showFreeText           parseFreeText
                             copyright              (\val pkg -> pkg{copyright=val})
   , simpleField "maintainer"
                             showFreeText           parseFreeText
                             maintainer             (\val pkg -> pkg{maintainer=val})
   , simpleField "stability"
                             showFreeText           parseFreeText
                             stability              (\val pkg -> pkg{stability=val})
   , simpleField "homepage"
                             showFreeText           parseFreeText
                             homepage               (\val pkg -> pkg{homepage=val})
   , simpleField "package-url"
                             showFreeText           parseFreeText
                             pkgUrl                 (\val pkg -> pkg{pkgUrl=val})
   , simpleField "synopsis"
                             showFreeText           parseFreeText
                             synopsis               (\val pkg -> pkg{synopsis=val})
   , simpleField "description"
                             showFreeText           parseFreeText
                             description            (\val pkg -> pkg{description=val})
   , simpleField "category"
                             showFreeText           parseFreeText
                             category               (\val pkg -> pkg{category=val})
   , simpleField "author"
                             showFreeText           parseFreeText
                             author                 (\val pkg -> pkg{author=val})
   ]
  
  installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
  installedFieldDescrs = [
     boolField "exposed"
          exposed            (\val pkg -> pkg{exposed=val})
   , boolField "indefinite"
          indefinite         (\val pkg -> pkg{indefinite=val})
   , simpleField "exposed-modules"
          showExposedModules parseExposedModules
          exposedModules     (\xs    pkg -> pkg{exposedModules=xs})
   , listField   "hidden-modules"
          disp               parseModuleNameQ
          hiddenModules      (\xs    pkg -> pkg{hiddenModules=xs})
   , simpleField "abi"
          disp               parse
          abiHash            (\abi    pkg -> pkg{abiHash=abi})
   , boolField   "trusted"
          trusted            (\val pkg -> pkg{trusted=val})
   , listField   "import-dirs"
          showFilePath       parseFilePathQ
          importDirs         (\xs pkg -> pkg{importDirs=xs})
   , listField   "library-dirs"
          showFilePath       parseFilePathQ
          libraryDirs        (\xs pkg -> pkg{libraryDirs=xs})
   , listField   "dynamic-library-dirs"
          showFilePath       parseFilePathQ
          libraryDynDirs     (\xs pkg -> pkg{libraryDynDirs=xs})
   , simpleField "data-dir"
          showFilePath       (parseFilePathQ Parse.<++ return "")
          dataDir            (\val pkg -> pkg{dataDir=val})
   , listField   "hs-libraries"
          showFilePath       parseTokenQ
          hsLibraries        (\xs pkg -> pkg{hsLibraries=xs})
   , listField   "extra-libraries"
          showToken          parseTokenQ
          extraLibraries     (\xs pkg -> pkg{extraLibraries=xs})
   , listField   "extra-ghci-libraries"
          showToken          parseTokenQ
          extraGHCiLibraries (\xs pkg -> pkg{extraGHCiLibraries=xs})
   , listField   "include-dirs"
          showFilePath       parseFilePathQ
          includeDirs        (\xs pkg -> pkg{includeDirs=xs})
   , listField   "includes"
          showFilePath       parseFilePathQ
          includes           (\xs pkg -> pkg{includes=xs})
   , listField   "depends"
          disp               parse
          depends            (\xs pkg -> pkg{depends=xs})
   , listField   "abi-depends"
          disp               parse
          abiDepends         (\xs pkg -> pkg{abiDepends=xs})
   , listField   "cc-options"
          showToken          parseTokenQ
          ccOptions          (\path  pkg -> pkg{ccOptions=path})
   , listField   "ld-options"
          showToken          parseTokenQ
          ldOptions          (\path  pkg -> pkg{ldOptions=path})
   , listField   "framework-dirs"
          showFilePath       parseFilePathQ
          frameworkDirs      (\xs pkg -> pkg{frameworkDirs=xs})
   , listField   "frameworks"
          showToken          parseTokenQ
          frameworks         (\xs pkg -> pkg{frameworks=xs})
   , listField   "haddock-interfaces"
          showFilePath       parseFilePathQ
          haddockInterfaces  (\xs pkg -> pkg{haddockInterfaces=xs})
   , listField   "haddock-html"
          showFilePath       parseFilePathQ
          haddockHTMLs       (\xs pkg -> pkg{haddockHTMLs=xs})
   , simpleField "pkgroot"
          (const Disp.empty)        parseFilePathQ
          (fromMaybe "" . pkgRoot)  (\xs pkg -> pkg{pkgRoot=Just xs})
   ]
  
  deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo]
  deprecatedFieldDescrs = [
     listField   "hugs-options"
          showToken          parseTokenQ
          (const [])        (const id)
    ]
  