Skip to content

Make more dependency types #4067

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Nov 2, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,7 @@ library
Distribution.Make
Distribution.ModuleName
Distribution.Package
Distribution.Package.TextClass
Distribution.PackageDescription
Distribution.PackageDescription.Check
Distribution.PackageDescription.Configuration
Expand Down
4 changes: 2 additions & 2 deletions Cabal/Distribution/Backpack/ComponentsGraph.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,8 +52,8 @@ toComponentsGraph enabled pkg_descr =
-- The dependencies for the given component
componentDeps component =
[ CExeName toolname
| Dependency pkgname _ <- buildTools bi
, let toolname = packageNameToUnqualComponentName pkgname
| LegacyExeDependency name _ <- buildTools bi
, let toolname = mkUnqualComponentName name
, toolname `elem` map exeName (executables pkg_descr) ]

++ [ if pkgname == packageName pkg_descr
Expand Down
5 changes: 2 additions & 3 deletions Cabal/Distribution/Backpack/ConfiguredComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -140,9 +140,8 @@ toConfiguredComponent pkg_descr this_cid
| otherwise
= Map.toList external_lib_map
exe_deps = [ cid
| Dependency pkgname _ <- buildTools bi
, let name = packageNameToUnqualComponentName pkgname
, Just cid <- [ Map.lookup name exe_map ] ]
| LegacyExeDependency name _ <- buildTools bi
, Just cid <- [ Map.lookup (mkUnqualComponentName name) exe_map ] ]

-- | Also computes the 'ComponentId', and sets cc_public if necessary.
-- This is Cabal-only; cabal-install won't use this.
Expand Down
1 change: 1 addition & 0 deletions Cabal/Distribution/InstalledPackageInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ import Distribution.Compat.Prelude
import Distribution.ParseUtils
import Distribution.License
import Distribution.Package hiding (installedUnitId, installedPackageId)
import Distribution.Package.TextClass ()
import Distribution.Backpack
import qualified Distribution.Package as Package
import Distribution.ModuleName
Expand Down
77 changes: 66 additions & 11 deletions Cabal/Distribution/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ module Distribution.Package (
packageNameToUnqualComponentName, unqualComponentNameToPackageName,
PackageIdentifier(..),
PackageId,
PkgconfigName, unPkgconfigName, mkPkgconfigName,

-- * Package keys/installed package IDs (used for linker symbols)
ComponentId, unComponentId, mkComponentId,
Expand All @@ -43,6 +44,8 @@ module Distribution.Package (

-- * Package source dependencies
Dependency(..),
LegacyExeDependency(..),
PkgconfigDependency(..),
thisPackageVersion,
notThisPackageVersion,
simplifyDependency,
Expand All @@ -59,7 +62,7 @@ import Distribution.Compat.Prelude
import Distribution.Utils.ShortText

import Distribution.Version
( Version, VersionRange, anyVersion, thisVersion
( Version, VersionRange, thisVersion
, notThisVersion, simplifyVersionRange
, nullVersion )

Expand All @@ -69,7 +72,7 @@ import Distribution.Compat.ReadP
import Distribution.Text
import Distribution.ModuleName

import Text.PrettyPrint ((<+>), text)
import Text.PrettyPrint (text)

-- | An unqualified component name, for any kind of component.
--
Expand Down Expand Up @@ -175,6 +178,44 @@ instance Text PackageName where
instance NFData PackageName where
rnf (PackageName pkg) = rnf pkg

-- | A pkg-config library name
--
-- This is parsed as any valid argument to the pkg-config utility.
--
-- @since 2.0
newtype PkgconfigName = PkgconfigName ShortText
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)

-- | Convert 'PkgconfigName' to 'String'
--
-- @since 2.0
unPkgconfigName :: PkgconfigName -> String
unPkgconfigName (PkgconfigName s) = fromShortText s

-- | Construct a 'PkgconfigName' from a 'String'
--
-- 'mkPkgconfigName' is the inverse to 'unPkgconfigName'
--
-- Note: No validations are performed to ensure that the resulting
-- 'PkgconfigName' is valid
--
-- @since 2.0
mkPkgconfigName :: String -> PkgconfigName
mkPkgconfigName = PkgconfigName . toShortText

instance Binary PkgconfigName

-- pkg-config allows versions and other letters in package names, eg
-- "gtk+-2.0" is a valid pkg-config package _name_. It then has a package
-- version number like 2.10.13
instance Text PkgconfigName where
disp = Disp.text . unPkgconfigName
parse = mkPkgconfigName
<$> munch1 (\c -> isAlphaNum c || c `elem` "+-._")

instance NFData PkgconfigName where
rnf (PkgconfigName pkg) = rnf pkg

-- | Type alias so we can use the shorter name PackageId.
type PackageId = PackageIdentifier

Expand Down Expand Up @@ -354,19 +395,33 @@ mkLegacyUnitId = newSimpleUnitId . mkComponentId . display
data Dependency = Dependency PackageName VersionRange
deriving (Generic, Read, Show, Eq, Typeable, Data)

instance Binary Dependency
-- | Describes a legacy `build-tools`-style dependency on an executable
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is "legacy" because we do not know if the build-tool referred to, refers to a pkg-config executable, or an internal executable (thus it is stringly typed.)

--
-- It is "legacy" because we do not know what the build-tool referred to. It
-- could refer to a pkg-config executable (PkgconfigName), or an internal
-- executable (UnqualComponentName). Thus the name is stringly typed.
--
-- @since 2.0
data LegacyExeDependency = LegacyExeDependency
String
VersionRange
deriving (Generic, Read, Show, Eq, Typeable, Data)

instance Text Dependency where
disp (Dependency name ver) =
disp name <+> disp ver
-- | Describes a dependency on a pkg-config library
--
-- @since 2.0
data PkgconfigDependency = PkgconfigDependency
PkgconfigName
VersionRange
deriving (Generic, Read, Show, Eq, Typeable, Data)

parse = do name <- parse
Parse.skipSpaces
ver <- parse <++ return anyVersion
Parse.skipSpaces
return (Dependency name ver)
instance Binary Dependency
instance Binary LegacyExeDependency
instance Binary PkgconfigDependency

instance NFData Dependency where rnf = genericRnf
instance NFData LegacyExeDependency where rnf = genericRnf
instance NFData PkgconfigDependency where rnf = genericRnf

thisPackageVersion :: PackageIdentifier -> Dependency
thisPackageVersion (PackageIdentifier n v) =
Expand Down
56 changes: 56 additions & 0 deletions Cabal/Distribution/Package/TextClass.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
-- | *Dependency Text instances moved from Distribution.Package
{-# OPTIONS_GHC -fno-warn-orphans #-}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

OK for now. Let's refactor it away later.

module Distribution.Package.TextClass () where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Package
import Distribution.ParseUtils
import Distribution.Version (anyVersion)

import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Distribution.Compat.ReadP
import Distribution.Text

import Text.PrettyPrint ((<+>))


instance Text Dependency where
disp (Dependency name ver) =
disp name <+> disp ver

parse = do name <- parse
Parse.skipSpaces
ver <- parse <++ return anyVersion
Parse.skipSpaces
return (Dependency name ver)

instance Text LegacyExeDependency where
disp (LegacyExeDependency name ver) =
Disp.text name <+> disp ver

parse = do name <- parseMaybeQuoted parseBuildToolName
Parse.skipSpaces
ver <- parse <++ return anyVersion
Parse.skipSpaces
return $ LegacyExeDependency name ver
where
-- like parsePackageName but accepts symbols in components
parseBuildToolName :: Parse.ReadP r String
parseBuildToolName = do ns <- sepBy1 component (Parse.char '-')
return (intercalate "-" ns)
where component = do
cs <- munch1 (\c -> isAlphaNum c || c == '+' || c == '_')
if all isDigit cs then pfail else return cs

instance Text PkgconfigDependency where
disp (PkgconfigDependency name ver) =
disp name <+> disp ver

parse = do name <- parse
Parse.skipSpaces
ver <- parse <++ return anyVersion
Parse.skipSpaces
return $ PkgconfigDependency name ver
5 changes: 3 additions & 2 deletions Cabal/Distribution/PackageDescription/Parse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ import Distribution.ParseUtils hiding (parseFields)
import Distribution.PackageDescription
import Distribution.PackageDescription.Utils
import Distribution.Package
import Distribution.Package.TextClass ()
import Distribution.ModuleName
import Distribution.Version
import Distribution.Verbosity
Expand Down Expand Up @@ -407,7 +408,7 @@ binfoFieldDescrs =
[ boolField "buildable"
buildable (\val binfo -> binfo{buildable=val})
, commaListField "build-tools"
disp parseBuildTool
disp parse
buildTools (\xs binfo -> binfo{buildTools=xs})
, commaListFieldWithSep vcat "build-depends"
disp parse
Expand All @@ -425,7 +426,7 @@ binfoFieldDescrs =
showToken parseTokenQ'
ldOptions (\val binfo -> binfo{ldOptions=val})
, commaListField "pkgconfig-depends"
disp parsePkgconfigDependency
disp parse
pkgconfigDepends (\xs binfo -> binfo{pkgconfigDepends=xs})
, listField "frameworks"
showToken parseTokenQ
Expand Down
5 changes: 3 additions & 2 deletions Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ import qualified Distribution.Compat.Parsec as Parsec
import Distribution.Compiler (CompilerFlavor (..))
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.Package.TextClass ()
import Distribution.PackageDescription
import Distribution.Types.ForeignLib
import Distribution.Parsec.Class
Expand Down Expand Up @@ -415,7 +416,7 @@ binfoFieldDescrs =
[ boolField "buildable"
buildable (\val binfo -> binfo{buildable=val})
, commaListField "build-tools"
disp parsecBuildTool
disp parsec
buildTools (\xs binfo -> binfo{buildTools=xs})
, commaListFieldWithSep vcat "build-depends"
disp parsec
Expand All @@ -433,7 +434,7 @@ binfoFieldDescrs =
showToken parsecToken'
ldOptions (\val binfo -> binfo{ldOptions=val})
, commaListField "pkgconfig-depends"
disp parsecPkgconfigDependency
disp parsec
pkgconfigDepends (\xs binfo -> binfo{pkgconfigDepends=xs})
, listField "frameworks"
showToken parsecToken
Expand Down
49 changes: 13 additions & 36 deletions Cabal/Distribution/ParseUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@
-- This module is meant to be local-only to Distribution...

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE Rank2Types #-}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

OK, excellent use of rank 2 types :)

module Distribution.ParseUtils (
LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,
runP, runE, ParseResult(..), catchParseError, parseFail, showPWarning,
Expand All @@ -27,14 +28,14 @@ module Distribution.ParseUtils (
showFields, showSingleNamedField, showSimpleSingleNamedField,
parseFields, parseFieldsFlat,
parseFilePathQ, parseTokenQ, parseTokenQ',
parseModuleNameQ, parseBuildTool, parsePkgconfigDependency,
parseModuleNameQ,
parseOptVersion, parsePackageNameQ,
parseTestedWithQ, parseLicenseQ, parseLanguageQ, parseExtensionQ,
parseSepList, parseCommaList, parseOptCommaList,
showFilePath, showToken, showTestedWith, showFreeText, parseFreeText,
field, simpleField, listField, listFieldWithSep, spaceListField,
commaListField, commaListFieldWithSep, commaNewLineListField,
optsField, liftField, boolField, parseQuoted, indentWith,
optsField, liftField, boolField, parseQuoted, parseMaybeQuoted, indentWith,

UnrecFieldParser, warnUnrec, ignoreUnrec,
) where
Expand Down Expand Up @@ -611,7 +612,7 @@ ifelse (f:fs) = do fs' <- ifelse fs

-- |parse a module name
parseModuleNameQ :: ReadP r ModuleName
parseModuleNameQ = parseQuoted parse <++ parse
parseModuleNameQ = parseMaybeQuoted parse

parseFilePathQ :: ReadP r FilePath
parseFilePathQ = parseTokenQ
Expand All @@ -624,62 +625,35 @@ betweenSpaces act = do skipSpaces
skipSpaces
return res

parseBuildTool :: ReadP r Dependency
parseBuildTool = do name <- parseBuildToolNameQ
ver <- betweenSpaces $
parse <++ return anyVersion
return $ Dependency name ver

parseBuildToolNameQ :: ReadP r PackageName
parseBuildToolNameQ = parseQuoted parseBuildToolName <++ parseBuildToolName

-- like parsePackageName but accepts symbols in components
parseBuildToolName :: ReadP r PackageName
parseBuildToolName = do ns <- sepBy1 component (ReadP.char '-')
return (mkPackageName (intercalate "-" ns))
where component = do
cs <- munch1 (\c -> isAlphaNum c || c == '+' || c == '_')
if all isDigit cs then pfail else return cs

-- pkg-config allows versions and other letters in package names,
-- eg "gtk+-2.0" is a valid pkg-config package _name_.
-- It then has a package version number like 2.10.13
parsePkgconfigDependency :: ReadP r Dependency
parsePkgconfigDependency = do name <- munch1
(\c -> isAlphaNum c || c `elem` "+-._")
ver <- betweenSpaces $
parse <++ return anyVersion
return $ Dependency (mkPackageName name) ver

parsePackageNameQ :: ReadP r PackageName
parsePackageNameQ = parseQuoted parse <++ parse
parsePackageNameQ = parseMaybeQuoted parse

parseOptVersion :: ReadP r Version
parseOptVersion = parseQuoted ver <++ ver
parseOptVersion = parseMaybeQuoted ver
where ver :: ReadP r Version
ver = parse <++ return nullVersion

parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange)
parseTestedWithQ = parseQuoted tw <++ tw
parseTestedWithQ = parseMaybeQuoted tw
where
tw :: ReadP r (CompilerFlavor,VersionRange)
tw = do compiler <- parseCompilerFlavorCompat
version <- betweenSpaces $ parse <++ return anyVersion
return (compiler,version)

parseLicenseQ :: ReadP r License
parseLicenseQ = parseQuoted parse <++ parse
parseLicenseQ = parseMaybeQuoted parse

-- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a
-- because the "compat" version of ReadP isn't quite powerful enough. In
-- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a
-- Hence the trick above to make 'lic' polymorphic.

parseLanguageQ :: ReadP r Language
parseLanguageQ = parseQuoted parse <++ parse
parseLanguageQ = parseMaybeQuoted parse

parseExtensionQ :: ReadP r Extension
parseExtensionQ = parseQuoted parse <++ parse
parseExtensionQ = parseMaybeQuoted parse

parseHaskellString :: ReadP r String
parseHaskellString = readS_to_P reads
Expand Down Expand Up @@ -711,5 +685,8 @@ parseOptCommaList = parseSepList (optional (ReadP.char ','))
parseQuoted :: ReadP r a -> ReadP r a
parseQuoted = between (ReadP.char '"') (ReadP.char '"')

parseMaybeQuoted :: (forall r. ReadP r a) -> ReadP r' a
parseMaybeQuoted p = parseQuoted p <++ p

parseFreeText :: ReadP.ReadP s String
parseFreeText = ReadP.munch (const True)
Loading