Commit 833e41cf authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Add Parsec support for Backpack, new Mixin type.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 32d2395c
......@@ -496,6 +496,7 @@ library
Distribution.Types.ModuleReexport
Distribution.Types.ModuleRenaming
Distribution.Types.IncludeRenaming
Distribution.Types.Mixin
Distribution.Types.SetupBuildInfo
Distribution.Types.TestSuite
Distribution.Types.TestSuiteInterface
......
......@@ -19,6 +19,7 @@ import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack.Id
import Distribution.Types.IncludeRenaming
import Distribution.Types.Mixin
import Distribution.Package
import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Simple.Setup as Setup
......@@ -89,7 +90,7 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
-- from @lib_deps@.
explicit_includes
= [ (cid, pid { pkgName = name }, rns)
| (name, rns) <- backpackIncludes bi
| Mixin name rns <- mixins bi
, Just (cid, pid) <- [Map.lookup name deps_map] ]
-- Any @build-depends@ which is not explicitly mentioned in
......
......@@ -1259,7 +1259,7 @@ checkCabalVersion pkg =
depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr) <- buildDepends pkg
, usesMajorBoundSyntax vr ]
usesBackpackIncludes = any (not . null . backpackIncludes) (allBuildInfo pkg)
usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)
testedWithUsingWildcardSyntax =
[ Dependency (mkPackageName (display compiler)) vr
......
......@@ -49,7 +49,6 @@ module Distribution.PackageDescription.Parse (
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.IncludeRenaming
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.ParseUtils hiding (parseFields)
......@@ -71,7 +70,7 @@ import Control.Monad (mapM)
import Text.PrettyPrint
(vcat, ($$), (<+>), text, render,
comma, fsep, nest, ($+$), punctuate, Doc)
comma, fsep, nest, ($+$), punctuate)
-- -----------------------------------------------------------------------------
......@@ -403,17 +402,6 @@ validateBenchmark line stanza =
-- ---------------------------------------------------------------------------
-- The BuildInfo type
showBackpackInclude :: (PackageName, IncludeRenaming) -> Doc
showBackpackInclude (pkg_name, incl) = do
disp pkg_name <+> disp incl
parseBackpackInclude :: ReadP r (PackageName, IncludeRenaming)
parseBackpackInclude = do
pkg_name <- parse
skipSpaces
incl <- parse
return (pkg_name, incl)
binfoFieldDescrs :: [FieldDescr BuildInfo]
binfoFieldDescrs =
[ boolField "buildable"
......@@ -425,8 +413,8 @@ binfoFieldDescrs =
disp parse
targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})
, commaListFieldWithSep vcat "mixins"
showBackpackInclude parseBackpackInclude
backpackIncludes (\xs binfo -> binfo{backpackIncludes=xs})
disp parse
mixins (\xs binfo -> binfo{mixins=xs})
, spaceListField "cpp-options"
showToken parseTokenQ'
cppOptions (\val binfo -> binfo{cppOptions=val})
......
......@@ -182,11 +182,9 @@ libFieldDescrs =
, commaListFieldWithSep vcat "reexported-modules" disp parsec
reexportedModules (\mods lib -> lib{reexportedModules=mods})
{-
, listFieldWithSep vcat "required-signatures" disp parseModuleNameQ
requiredSignatures (\mods lib -> lib{requiredSignatures=mods})
, listFieldWithSep vcat "signatures" disp (parsecMaybeQuoted parsec)
signatures (\mods lib -> lib{signatures=mods})
-}
, boolField "exposed"
libExposed (\val lib -> lib{libExposed=val})
] ++ map biToLib binfoFieldDescrs
......@@ -422,6 +420,9 @@ binfoFieldDescrs =
, commaListFieldWithSep vcat "build-depends"
disp parsec
targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})
, commaListFieldWithSep vcat "mixins"
disp parsec
mixins (\xs binfo -> binfo{mixins=xs})
, spaceListField "cpp-options"
showToken parsecToken'
cppOptions (\val binfo -> binfo{cppOptions=val})
......
......@@ -50,6 +50,9 @@ import Distribution.Types.SourceRepo
import Distribution.Types.TestType (TestType (..))
import Distribution.Types.ForeignLibType (ForeignLibType (..))
import Distribution.Types.ForeignLibOption (ForeignLibOption (..))
import Distribution.Types.ModuleRenaming
import Distribution.Types.IncludeRenaming
import Distribution.Types.Mixin
import Distribution.Version
(Version, VersionRange (..), anyVersion, earlierVersion,
intersectVersionRanges, laterVersion, majorBoundVersion,
......@@ -277,6 +280,49 @@ instance Parsec ModuleReexport where
parsec
return (ModuleReexport mpkgname origname newname)
instance Parsec ModuleRenaming where
-- NB: try not necessary as the first token is obvious
parsec = P.choice [ parseRename, parseHiding, return DefaultRenaming ]
where
parseRename = do
rns <- P.between (P.char '(') (P.char ')') parseList
P.spaces
return (ModuleRenaming rns)
parseHiding = do
_ <- P.string "hiding"
P.spaces
hides <- P.between (P.char '(') (P.char ')')
(P.sepBy parsec (P.char ',' >> P.spaces))
return (HidingRenaming hides)
parseList =
P.sepBy parseEntry (P.char ',' >> P.spaces)
parseEntry = do
orig <- parsec
P.spaces
P.option (orig, orig) $ do
_ <- P.string "as"
P.spaces
new <- parsec
P.spaces
return (orig, new)
instance Parsec IncludeRenaming where
parsec = do
prov_rn <- parsec
req_rn <- P.option defaultRenaming $ P.try $ do
P.spaces
_ <- P.string "requires"
P.spaces
parsec
return (IncludeRenaming prov_rn req_rn)
instance Parsec Mixin where
parsec = do
mod_name <- parsec
P.spaces
incl <- parsec
return (Mixin mod_name incl)
-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------
......
......@@ -84,6 +84,7 @@ import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
import Distribution.Types.Mixin
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
......@@ -951,7 +952,7 @@ configureFinalizedPackage verbosity cfg enabled
checkCompilerProblems :: Compiler -> PackageDescription -> ComponentRequestedSpec -> IO ()
checkCompilerProblems comp pkg_descr enabled = do
unless (renamingPackageFlagsSupported comp ||
all (all (isDefaultIncludeRenaming . snd) . backpackIncludes)
all (all (isDefaultIncludeRenaming . mixinIncludeRenaming) . mixins)
(enabledBuildInfos pkg_descr enabled)) $
die $ "Your compiler does not support thinning and renaming on "
++ "package flags. To use this feature you must use "
......
......@@ -17,7 +17,7 @@ module Distribution.Types.BuildInfo (
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.IncludeRenaming
import Distribution.Types.Mixin
import Distribution.Package
import Distribution.ModuleName
......@@ -59,7 +59,7 @@ data BuildInfo = BuildInfo {
-- with x-, stored in a
-- simple assoc-list.
targetBuildDepends :: [Dependency], -- ^ Dependencies specific to a library or executable target
backpackIncludes :: [(PackageName, IncludeRenaming)]
mixins :: [Mixin]
}
deriving (Generic, Show, Read, Eq, Typeable, Data)
......@@ -96,7 +96,7 @@ instance Monoid BuildInfo where
sharedOptions = [],
customFieldsBI = [],
targetBuildDepends = [],
backpackIncludes = []
mixins = []
}
mappend = (<>)
......@@ -131,7 +131,7 @@ instance Semigroup BuildInfo where
sharedOptions = combine sharedOptions,
customFieldsBI = combine customFieldsBI,
targetBuildDepends = combineNub targetBuildDepends,
backpackIncludes = combine backpackIncludes
mixins = combine mixins
}
where
combine field = field a `mappend` field b
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.Mixin (
Mixin(..),
) where
import Prelude ()
import Distribution.Compat.Prelude
import Text.PrettyPrint ((<+>))
import Distribution.Compat.ReadP
import Distribution.Text
import Distribution.Package
import Distribution.Types.IncludeRenaming
data Mixin = Mixin { mixinPackageName :: PackageName
, mixinIncludeRenaming :: IncludeRenaming }
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
instance Binary Mixin
instance Text Mixin where
disp (Mixin pkg_name incl) =
disp pkg_name <+> disp incl
parse = do
pkg_name <- parse
skipSpaces
incl <- parse
return (Mixin pkg_name incl)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment