Distribution/InstalledPackageInfo.hs

    {-# LANGUAGE DeriveGeneric #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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_(..), InstalledPackageInfo,
            OriginalModule(..), ExposedModule(..),
            ParseResult(..), PError(..), PWarning,
            emptyInstalledPackageInfo,
            parseInstalledPackageInfo,
            showInstalledPackageInfo,
            showInstalledPackageInfoField,
            showSimpleInstalledPackageInfoField,
            fieldsInstalledPackageInfo,
      ) where

    import Distribution.ParseUtils
             ( FieldDescr(..), ParseResult(..), PError(..), PWarning
             , simpleField, listField, parseLicenseQ
             , showFields, showSingleNamedField, showSimpleSingleNamedField
             , parseFieldsFlat
             , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
             , showFilePath, showToken, boolField, parseOptVersion
             , parseFreeText, showFreeText, parseOptCommaList )
    import Distribution.License     ( License(..) )
    import Distribution.Package
             ( PackageName(..), PackageIdentifier(..)
             , PackageId, InstalledPackageId(..)
             , packageName, packageVersion, PackageKey(..) )
    import qualified Distribution.Package as Package
    import Distribution.ModuleName
             ( ModuleName )
    import Distribution.Version
             ( Version(..) )
    import Distribution.Text
             ( Text(disp, parse) )
    import Text.PrettyPrint as Disp
    import qualified Distribution.Compat.ReadP as Parse

    import Distribution.Compat.Binary  (Binary)
    import Data.Maybe   (fromMaybe)
    import GHC.Generics (Generic)

    -- -----------------------------------------------------------------------------
    -- The InstalledPackageInfo type

    data InstalledPackageInfo_ m
       = InstalledPackageInfo {
            -- these parts are exactly the same as PackageDescription
            installedPackageId :: InstalledPackageId,
            sourcePackageId    :: PackageId,
            packageKey         :: PackageKey,
            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:
            exposed           :: Bool,
            exposedModules    :: [ExposedModule],
            instantiatedWith  :: [(m, OriginalModule)],
            hiddenModules     :: [m],
            trusted           :: Bool,
            importDirs        :: [FilePath],
            libraryDirs       :: [FilePath],
            dataDir           :: FilePath,
            hsLibraries       :: [String],
            extraLibraries    :: [String],
            extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi
            includeDirs       :: [FilePath],
            includes          :: [String],
            depends           :: [InstalledPackageId],
            ccOptions         :: [String],
            ldOptions         :: [String],
            frameworkDirs     :: [FilePath],
            frameworks        :: [String],
            haddockInterfaces :: [FilePath],
            haddockHTMLs      :: [FilePath],
            pkgRoot           :: Maybe FilePath
        }
        deriving (Generic, Read, Show)

    instance Binary m => Binary (InstalledPackageInfo_ m)

    instance Package.Package          (InstalledPackageInfo_ str) where
       packageId = sourcePackageId

    instance Package.PackageInstalled (InstalledPackageInfo_ str) where
       installedPackageId = installedPackageId
       installedDepends = depends

    type InstalledPackageInfo = InstalledPackageInfo_ ModuleName

    emptyInstalledPackageInfo :: InstalledPackageInfo_ m
    emptyInstalledPackageInfo
       = InstalledPackageInfo {
            installedPackageId = InstalledPackageId "",
            sourcePackageId    = PackageIdentifier (PackageName "") noVersion,
            packageKey         = OldPackageKey (PackageIdentifier
                                                   (PackageName "") noVersion),
            license           = UnspecifiedLicense,
            copyright         = "",
            maintainer        = "",
            author            = "",
            stability         = "",
            homepage          = "",
            pkgUrl            = "",
            synopsis          = "",
            description       = "",
            category          = "",
            exposed           = False,
            exposedModules    = [],
            hiddenModules     = [],
            instantiatedWith  = [],
            trusted           = False,
            importDirs        = [],
            libraryDirs       = [],
            dataDir           = "",
            hsLibraries       = [],
            extraLibraries    = [],
            extraGHCiLibraries= [],
            includeDirs       = [],
            includes          = [],
            depends           = [],
            ccOptions         = [],
            ldOptions         = [],
            frameworkDirs     = [],
            frameworks        = [],
            haddockInterfaces = [],
            haddockHTMLs      = [],
            pkgRoot           = Nothing
        }

    noVersion :: Version
    noVersion = Version [] []

    -- -----------------------------------------------------------------------------
    -- Exposed modules

    data OriginalModule
       = OriginalModule {
           originalPackageId :: InstalledPackageId,
           originalModuleName :: ModuleName
         }
      deriving (Generic, Eq, Read, Show)

    data ExposedModule
       = ExposedModule {
           exposedName      :: ModuleName,
           exposedReexport  :: Maybe OriginalModule,
           exposedSignature :: Maybe OriginalModule -- This field is unused for now.
         }
      deriving (Generic, Read, Show)

    instance Text OriginalModule where
        disp (OriginalModule ipi m) =
            disp ipi <> Disp.char ':' <> disp m
        parse = do
            ipi <- parse
            _ <- Parse.char ':'
            m <- parse
            return (OriginalModule ipi m)

    instance Text ExposedModule where
        disp (ExposedModule m reexport signature) =
            Disp.sep [ disp m
                     , case reexport of
                        Just m' -> Disp.sep [Disp.text "from", disp m']
                        Nothing -> Disp.empty
                     , case signature of
                        Just m' -> Disp.sep [Disp.text "is", disp m']
                        Nothing -> Disp.empty
                     ]
        parse = do
            m <- parseModuleNameQ
            Parse.skipSpaces
            reexport <- Parse.option Nothing $ do
                _ <- Parse.string "from"
                Parse.skipSpaces
                fmap Just parse
            Parse.skipSpaces
            signature <- Parse.option Nothing $ do
                _ <- Parse.string "is"
                Parse.skipSpaces
                fmap Just parse
            return (ExposedModule m reexport signature)

    instance Binary OriginalModule

    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 Nothing) = True
              isExposedModule _ = False

    parseExposedModules :: Parse.ReadP r [ExposedModule]
    parseExposedModules = parseOptCommaList parse

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

    parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
    parseInstalledPackageInfo =
        parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
        emptyInstalledPackageInfo

    parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule)
    parseInstantiatedWith = do k <- parse
                               _ <- Parse.char '='
                               n <- parse
                               _ <- Parse.char '@'
                               p <- parse
                               return (k, OriginalModule p n)

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

    showInstalledPackageInfo :: InstalledPackageInfo -> String
    showInstalledPackageInfo = showFields fieldsInstalledPackageInfo

    showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo

    showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
    showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo

    showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc
    showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p

    -- -----------------------------------------------------------------------------
    -- Description of the fields, for parsing/printing

    fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]
    fieldsInstalledPackageInfo = basicFieldDescrs ++ installedFieldDescrs

    basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
    basicFieldDescrs =
     [ simpleField "name"
                               disp                   parsePackageNameQ
                               packageName            (\name pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgName=name}})
     , simpleField "version"
                               disp                   parseOptVersion
                               packageVersion         (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
     , simpleField "id"
                               disp                   parse
                               installedPackageId     (\ipid pkg -> pkg{installedPackageId=ipid})
     , simpleField "key"
                               disp                   parse
                               packageKey             (\ipid pkg -> pkg{packageKey=ipid})
     , 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})
     , simpleField "exposed-modules"
            showExposedModules parseExposedModules
            exposedModules     (\xs    pkg -> pkg{exposedModules=xs})
     , listField   "hidden-modules"
            disp               parseModuleNameQ
            hiddenModules      (\xs    pkg -> pkg{hiddenModules=xs})
     , listField   "instantiated-with"
            showInstantiatedWith parseInstantiatedWith
            instantiatedWith   (\xs    pkg -> pkg{instantiatedWith=xs})
     , 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})
     , 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   "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)
      ]