Commit ff04b336 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Rearrange PackageDescription some more

Previously we moved the types into Distribution.PackageDescription.Types.
Now all the remaining utils have been removed from D.PackageDescription we
can move D.PackageDescription.Types back to D.PackageDescription. Also move
D.Configuration to be D.PackageDescription.Configuration and move the types
used for GenericPackageDescription into D.PackageDescription and move the
functions that convert GenericPackageDescription -> PackageDescription into
the D.PackageDescription.Configuration module.
parent d5f606dc
This diff is collapsed.
......@@ -43,26 +43,32 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Configuration (
Flag(..),
ConfVar(..),
Condition(..), parseCondition, simplifyCondition,
CondTree(..), ppCondTree, mapTreeData, freeVars,
--satisfyFlags,
resolveWithFlags, ignoreConditions,
DepTestRslt(..)
module Distribution.PackageDescription.Configuration (
finalizePackageDescription,
flattenPackageDescription,
-- Utils
satisfyDependency,
parseCondition,
freeVars,
) where
import Distribution.PackageDescription
( GenericPackageDescription(..), PackageDescription(..)
, Library(..), Executable(..), BuildInfo(..)
, Flag(..), CondTree(..), ConfVar(..), ConfFlag(..), Condition(..) )
import Distribution.Package (PackageIdentifier(..))
import Distribution.Version
( Version(..), Dependency(..), VersionRange(..)
, withinRange, parseVersionRange )
import Distribution.Simple.Utils (currentDir)
import Distribution.Compat.ReadP as ReadP hiding ( char )
import qualified Distribution.Compat.ReadP as ReadP ( char )
import Distribution.Version
( Version(..), VersionRange(..), withinRange
, showVersionRange, parseVersionRange )
import Text.PrettyPrint.HughesPJ
import Data.Char ( isAlphaNum, toLower )
import Data.Maybe ( catMaybes, maybeToList )
import Data.Maybe ( isJust, catMaybes, maybeToList )
import Data.List ( nub, maximumBy )
import Data.Monoid
#ifdef DEBUG
......@@ -72,52 +78,6 @@ import Distribution.ParseUtils
------------------------------------------------------------------------------
-- | A flag can represent a feature to be included, or a way of linking
-- a target against its dependencies, or in fact whatever you can think of.
data Flag = MkFlag
{ flagName :: String
, flagDescription :: String
, flagDefault :: Bool
}
instance Show Flag where show (MkFlag n _ _) = n
-- | A @ConfFlag@ represents an user-defined flag
data ConfFlag = ConfFlag String
deriving Eq
-- | A @ConfVar@ represents the variable type used.
data ConfVar = OS String
| Arch String
| Flag ConfFlag
| Impl String VersionRange
deriving Eq
instance Show ConfVar where
show (OS n) = "os(" ++ n ++ ")"
show (Arch n) = "arch(" ++ n ++ ")"
show (Flag (ConfFlag f)) = "flag(" ++ f ++ ")"
show (Impl c v) = "impl(" ++ c ++ " " ++ showVersionRange v ++ ")"
-- | A boolean expression parameterized over the variable type used.
data Condition c = Var c
| Lit Bool
| CNot (Condition c)
| COr (Condition c) (Condition c)
| CAnd (Condition c) (Condition c)
instance Show c => Show (Condition c) where
show c = render $ ppCond c
-- | Pretty print a @Condition@.
ppCond :: Show c => Condition c -> Doc
ppCond (Var x) = text (show x)
ppCond (Lit b) = text (show b)
ppCond (CNot c) = char '!' <> parens (ppCond c)
ppCond (COr c1 c2) = parens $ sep [ppCond c1, text "||" <+> ppCond c2]
ppCond (CAnd c1 c2) = parens $ sep [ppCond c1, text "&&" <+> ppCond c2]
-- | Simplify the condition and return its free variables.
simplifyCondition :: Condition c
-> (c -> Either d Bool) -- ^ (partial) variable assignment
......@@ -219,14 +179,6 @@ parseCondition = condOr
------------------------------------------------------------------------------
data CondTree v c a = CondNode
{ condTreeData :: a
, condTreeConstraints :: c
, condTreeComponents :: [( Condition v
, CondTree v c a
, Maybe (CondTree v c a))]
}
mapCondTree :: (a -> b) -> (c -> d) -> (Condition v -> Condition w)
-> CondTree v c a -> CondTree w d b
mapCondTree fa fc fcnd (CondNode a c ifs) =
......@@ -244,23 +196,6 @@ mapTreeConds f = mapCondTree id id f
mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData f = mapCondTree f id id
instance (Show v, Show c) => Show (CondTree v c a) where
show t = render $ ppCondTree t (text . show)
ppCondTree :: Show v => CondTree v c a -> (c -> Doc) -> Doc
ppCondTree (CondNode _dat cs ifs) ppD =
(text "build-depends: " <+>
ppD cs)
$+$
(vcat $ map ppIf ifs)
where
ppIf (c,thenTree,mElseTree) =
((text "if" <+> ppCond c <> colon) $$
nest 2 (ppCondTree thenTree ppD))
$+$ (maybe empty (\t -> text "else: " $$ nest 2 (ppCondTree t ppD))
mElseTree)
-- | Result of dependency test. Isomorphic to @Maybe d@ but renamed for
-- clarity.
data DepTestRslt d = DepOk | MissingDeps d
......@@ -394,6 +329,141 @@ freeVars t = [ s | Flag (ConfFlag s) <- freeVars' t ]
COr c1 c2 -> condfv c1 ++ condfv c2
CAnd c1 c2 -> condfv c1 ++ condfv c2
------------------------------------------------------------------------------
-- Convert GenericPackageDescription to PackageDescription
--
data PDTagged = Lib Library | Exe String Executable | PDNull
instance Monoid PDTagged where
mempty = PDNull
PDNull `mappend` x = x
x `mappend` PDNull = x
Lib l `mappend` Lib l' = Lib (l `mappend` l')
Exe n e `mappend` Exe n' e' | n == n' = Exe n (e `mappend` e')
_ `mappend` _ = bug "Cannot combine incompatible tags"
finalizePackageDescription
:: [(String,Bool)] -- ^ Explicitly specified flag assignments
-> Maybe [PackageIdentifier] -- ^ Available dependencies. Pass 'Nothing' if this
-- is unknown.
-> String -- ^ OS-name
-> String -- ^ Arch-name
-> (String, Version) -- ^ Compiler + Version
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, [(String,Bool)])
-- ^ Either missing dependencies or the resolved package
-- description along with the flag assignments chosen.
finalizePackageDescription userflags mpkgs os arch impl
(GenericPackageDescription pkg flags mlib0 exes0) =
case resolveFlags of
Right ((mlib, exes'), deps, flagVals) ->
Right ( pkg { library = mlib
, executables = exes'
, buildDepends = nub deps
}
, flagVals )
Left missing -> Left $ nub missing
where
-- Combine lib and exes into one list of @CondTree@s with tagged data
condTrees = maybeToList (fmap (mapTreeData Lib) mlib0 )
++ map (\(name,tree) -> mapTreeData (Exe name) tree) exes0
untagRslts = foldr untag (Nothing, [])
where
untag (Lib _) (Just _, _) = bug "Only one library expected"
untag (Lib l) (Nothing, exes) = (Just l, exes)
untag (Exe n e) (mlib, exes)
| any ((== n) . fst) exes = bug "Exe with same name found"
| otherwise = (mlib, exes ++ [(n, e)])
untag PDNull x = x -- actually this should not happen, but let's be liberal
resolveFlags =
case resolveWithFlags flagChoices os arch impl condTrees check of
Right (as, ds, fs) ->
let (mlib, exes) = untagRslts as in
Right ( (fmap libFillInDefaults mlib,
map (\(n,e) -> (exeFillInDefaults e) { exeName = n }) exes),
ds, fs)
Left missing -> Left missing
flagChoices = map (\(MkFlag n _ d) -> (n, d2c n d)) flags
d2c n b = maybe [b, not b] (\x -> [x]) $ lookup n userflags
--flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
check ds = if all satisfyDep ds
then DepOk
else MissingDeps $ filter (not . satisfyDep) ds
-- if we don't know which packages are present, we just accept any
-- dependency
satisfyDep = maybe (const True)
(\pkgs -> isJust . satisfyDependency pkgs)
mpkgs
satisfyDependency :: [PackageIdentifier] -> Dependency
-> Maybe PackageIdentifier
satisfyDependency pkgs (Dependency pkgname vrange) =
case filter ok pkgs of
[] -> Nothing
qs -> Just (maximumBy versions qs)
where
ok p = pkgName p == pkgname && pkgVersion p `withinRange` vrange
versions a b = pkgVersion a `compare` pkgVersion b
-- | Flatten a generic package description by ignoring all conditions and just
-- join the field descriptors into on package description. Note, however,
-- that this may lead to inconsistent field values, since all values are
-- joined into one field, which may not be possible in the original package
-- description, due to the use of exclusive choices (if ... else ...).
--
-- XXX: One particularly tricky case is defaulting. In the original package
-- description, e.g., the source dirctory might either be the default or a
-- certain, explicitly set path. Since defaults are filled in only after the
-- package has been resolved and when no explicit value has been set, the
-- default path will be missing from the package description returned by this
-- function.
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0) =
pkg { library = mlib
, executables = reverse exes
, buildDepends = nub $ ldeps ++ reverse edeps
}
where
(mlib, ldeps) = case mlib0 of
Just lib -> let (l,ds) = ignoreConditions lib in
(Just (libFillInDefaults l), ds)
Nothing -> (Nothing, [])
(exes, edeps) = foldr flattenExe ([],[]) exes0
flattenExe (n, t) (es, ds) =
let (e, ds') = ignoreConditions t in
( (exeFillInDefaults $ e { exeName = n }) : es, ds' ++ ds )
-- This is in fact rather a hack. The original version just overrode the
-- default values, however, when adding conditions we had to switch to a
-- modifier-based approach. There, nothing is ever overwritten, but only
-- joined together.
--
-- This is the cleanest way i could think of, that doesn't require
-- changing all field parsing functions to return modifiers instead.
libFillInDefaults :: Library -> Library
libFillInDefaults lib@(Library { libBuildInfo = bi }) =
lib { libBuildInfo = biFillInDefaults bi }
exeFillInDefaults :: Executable -> Executable
exeFillInDefaults exe@(Executable { buildInfo = bi }) =
exe { buildInfo = biFillInDefaults bi }
biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults bi =
if null (hsSourceDirs bi)
then bi { hsSourceDirs = [currentDir] }
else bi
bug :: String -> a
bug msg = error $ msg ++ ". Consider this a bug."
------------------------------------------------------------------------------
-- Testing
......
......@@ -75,14 +75,13 @@ import Text.PrettyPrint.HughesPJ
import Distribution.Compat.ReadP hiding (get)
import Distribution.ParseUtils
import Distribution.PackageDescription.Types
import Distribution.PackageDescription
import Distribution.Package (PackageIdentifier(..), parsePackageName)
import Distribution.Version (Dependency, showVersion, parseVersion,
showVersionRange, parseVersionRange, isAnyVersion)
import Distribution.Verbosity (Verbosity)
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.Configuration (CondTree(..), ConfVar(..), Flag(..),
parseCondition, freeVars)
import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
import Distribution.Simple.Utils (die, dieWithLocation, warn)
......
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PackageDescription.Types
-- Copyright : Isaac Jones 2003-2005
--
-- Maintainer : Isaac Jones <ijones@syntaxpolice.org>
-- Stability : alpha
-- Portability : portable
--
-- Package description and parsing.
{- All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.PackageDescription.Types (
-- * Package descriptions
PackageDescription(..),
GenericPackageDescription(..),
emptyPackageDescription,
BuildType(..),
-- ** Libraries
Library(..),
emptyLibrary,
withLib,
hasLibs,
libModules,
-- ** Executables
Executable(..),
emptyExecutable,
withExe,
hasExes,
exeModules,
-- * Build information
BuildInfo(..),
emptyBuildInfo,
allBuildInfo,
unionBuildInfo,
-- ** Supplementary build information
HookedBuildInfo,
emptyHookedBuildInfo,
updatePackageDescription,
) where
import Data.List (nub)
import Data.Monoid (Monoid(mempty, mappend))
import Distribution.Package (PackageIdentifier(PackageIdentifier))
import Distribution.Version (Version(Version), VersionRange(AnyVersion))
import Distribution.License (License(AllRightsReserved))
import Distribution.Version (Dependency)
import Distribution.Compiler (CompilerFlavor)
import Distribution.Configuration (CondTree, ConfVar, Flag)
import Distribution.Simple.Utils (currentDir)
import Language.Haskell.Extension (Extension)
-- -----------------------------------------------------------------------------
-- The PackageDescription type
-- | This data type is the internal representation of the file @pkg.cabal@.
-- It contains two kinds of information about the package: information
-- which is needed for all packages, such as the package name and version, and
-- information which is needed for the simple build system only, such as
-- the compiler options and library name.
--
data PackageDescription
= PackageDescription {
-- the following are required by all packages:
package :: PackageIdentifier,
license :: License,
licenseFile :: FilePath,
copyright :: String,
maintainer :: String,
author :: String,
stability :: String,
testedWith :: [(CompilerFlavor,VersionRange)],
homepage :: String,
pkgUrl :: String,
synopsis :: String, -- ^A one-line summary of this package
description :: String, -- ^A more verbose description of this package
category :: String,
buildDepends :: [Dependency],
descCabalVersion :: VersionRange, -- ^If this package depends on a specific version of Cabal, give that here.
buildType :: Maybe BuildType,
-- components
library :: Maybe Library,
executables :: [Executable],
dataFiles :: [FilePath],
extraSrcFiles :: [FilePath],
extraTmpFiles :: [FilePath]
}
deriving (Show, Read, Eq)
emptyPackageDescription :: PackageDescription
emptyPackageDescription
= PackageDescription {package = PackageIdentifier "" (Version [] []),
license = AllRightsReserved,
licenseFile = "",
descCabalVersion = AnyVersion,
buildType = Nothing,
copyright = "",
maintainer = "",
author = "",
stability = "",
testedWith = [],
buildDepends = [],
homepage = "",
pkgUrl = "",
synopsis = "",
description = "",
category = "",
library = Nothing,
executables = [],
dataFiles = [],
extraSrcFiles = [],
extraTmpFiles = []
}
data GenericPackageDescription =
GenericPackageDescription {
packageDescription :: PackageDescription,
genPackageFlags :: [Flag],
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library),
condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)]
}
--deriving (Show)
-- | The type of build system used by this package.
data BuildType
= Simple -- ^ calls @Distribution.Simple.defaultMain@
| Configure -- ^ calls @Distribution.Simple.defaultMainWithHooks defaultUserHooks@,
-- which invokes @configure@ to generate additional build
-- information used by later phases.
| Make -- ^ calls @Distribution.Make.defaultMain@
| Custom -- ^ uses user-supplied @Setup.hs@ or @Setup.lhs@ (default)
deriving (Show, Read, Eq)
-- ---------------------------------------------------------------------------
-- The Library type
data Library = Library {
exposedModules :: [String],
libBuildInfo :: BuildInfo
}
deriving (Show, Eq, Read)
instance Monoid Library where
mempty = nullLibrary
mappend = unionLibrary
emptyLibrary :: Library
emptyLibrary = Library [] emptyBuildInfo
nullLibrary :: Library
nullLibrary = Library [] nullBuildInfo
-- |does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = maybe False (buildable . libBuildInfo) (library p)
-- |'Maybe' version of 'hasLibs'
maybeHasLibs :: PackageDescription -> Maybe Library
maybeHasLibs p =
library p >>= \lib -> if buildable (libBuildInfo lib)
then Just lib
else Nothing
-- |If the package description has a library section, call the given
-- function with the library build info as argument.
withLib :: PackageDescription -> a -> (Library -> IO a) -> IO a
withLib pkg_descr a f =
maybe (return a) f (maybeHasLibs pkg_descr)
-- |Get all the module names from the libraries in this package
libModules :: PackageDescription -> [String]
libModules PackageDescription{library=lib}
= maybe [] exposedModules lib
++ maybe [] (otherModules . libBuildInfo) lib
unionLibrary :: Library -> Library -> Library
unionLibrary l1 l2 =
l1 { exposedModules = combine exposedModules
, libBuildInfo = unionBuildInfo (libBuildInfo l1) (libBuildInfo l2)
}
where combine f = f l1 ++ f l2
-- ---------------------------------------------------------------------------
-- The Executable type
data Executable = Executable {
exeName :: String,
modulePath :: FilePath,
buildInfo :: BuildInfo
}
deriving (Show, Read, Eq)
instance Monoid Executable where
mempty = nullExecutable
mappend = unionExecutable
emptyExecutable :: Executable
emptyExecutable = Executable {
exeName = "",
modulePath = "",
buildInfo = emptyBuildInfo
}
nullExecutable :: Executable
nullExecutable = emptyExecutable { buildInfo = nullBuildInfo }
-- |does this package have any executables?
hasExes :: PackageDescription -> Bool
hasExes p = any (buildable . buildInfo) (executables p)
-- | Perform the action on each buildable 'Executable' in the package
-- description.
withExe :: PackageDescription -> (Executable -> IO a) -> IO ()
withExe pkg_descr f =
sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)]
-- |Get all the module names from the exes in this package
exeModules :: PackageDescription -> [String]
exeModules PackageDescription{executables=execs}
= concatMap (otherModules . buildInfo) execs
unionExecutable :: Executable -> Executable -> Executable
unionExecutable e1 e2 =
e1 { exeName = combine exeName
, modulePath = combine modulePath
, buildInfo = unionBuildInfo (buildInfo e1) (buildInfo e2)
}
where combine f = case (f e1, f e2) of
("","") -> ""
("", x) -> x
(x, "") -> x
(x, y) -> error $ "Ambiguous values for executable field: '"
++ x ++ "' and '" ++ y ++ "'"
-- ---------------------------------------------------------------------------
-- The BuildInfo type
-- Consider refactoring into executable and library versions.
data BuildInfo = BuildInfo {
buildable :: Bool, -- ^ component is buildable here
buildTools :: [Dependency], -- ^ tools needed to build this bit
cppOptions :: [String], -- ^ options for pre-processing Haskell code
ccOptions :: [String], -- ^ options for C compiler
ldOptions :: [String], -- ^ options for linker
pkgconfigDepends :: [Dependency], -- ^ pkg-config packages that are used
frameworks :: [String], -- ^support frameworks for Mac OS X
cSources :: [FilePath],
hsSourceDirs :: [FilePath], -- ^ where to look for the haskell module hierarchy
otherModules :: [String], -- ^ non-exposed or non-main modules
extensions :: [Extension],
extraLibs :: [String], -- ^ what libraries to link with when compiling a program that uses your package
extraLibDirs :: [String],
includeDirs :: [FilePath], -- ^directories to find .h files
includes :: [FilePath], -- ^ The .h files to be found in includeDirs
installIncludes :: [FilePath], -- ^ .h files to install with the package
options :: [(CompilerFlavor,[String])],
ghcProfOptions :: [String],
ghcSharedOptions :: [String]
}
deriving (Show,Read,Eq)
nullBuildInfo :: BuildInfo
nullBuildInfo = BuildInfo {
buildable = True,
buildTools = [],
cppOptions = [],
ccOptions = [],