Simplify Package data type (#663)
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Wed, 29 Aug 2018 01:33:21 +0000 (02:33 +0100)
committerGitHub <noreply@github.com>
Wed, 29 Aug 2018 01:33:21 +0000 (02:33 +0100)
I noticed that all packages we build have Cabal files now, which means we no longer need to distinguish between C and Haskell packages. This leads to a lot of simplifications and removal of unsafe functions.

23 files changed:
hadrian.cabal
src/Context.hs
src/Context/Type.hs
src/Expression.hs
src/Hadrian/Haskell/Cabal.hs
src/Hadrian/Haskell/Cabal/CabalData.hs
src/Hadrian/Haskell/Cabal/PackageData.hs
src/Hadrian/Haskell/Cabal/Parse.hs
src/Hadrian/Oracles/TextFile.hs
src/Hadrian/Oracles/TextFile/Rules.hs
src/Hadrian/Oracles/TextFile/Type.hs
src/Hadrian/Package.hs
src/Hadrian/Package/Type.hs [deleted file]
src/Hadrian/Utilities.hs
src/Packages.hs
src/Rules/BinaryDist.hs
src/Rules/Documentation.hs
src/Rules/Library.hs
src/Rules/Selftest.hs
src/Settings/Builders/Cabal.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/Haddock.hs
src/Utilities.hs

index 82026c9..6bb0d73 100644 (file)
@@ -44,7 +44,6 @@ executable hadrian
                        , Hadrian.Oracles.TextFile.Rules
                        , Hadrian.Oracles.TextFile.Type
                        , Hadrian.Package
-                       , Hadrian.Package.Type
                        , Hadrian.Target
                        , Hadrian.Utilities
                        , Oracles.Flag
index eaca3bb..f619645 100644 (file)
@@ -4,10 +4,9 @@ module Context (
 
     -- * Expressions
     getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
-    withHsPackage,
 
     -- * Paths
-    contextDir, buildPath, buildDir, pkgId, pkgInplaceConfig, pkgSetupConfigFile,
+    contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
     pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,
     contextPath, getContextPath, libDir, libPath
     ) where
@@ -44,21 +43,6 @@ getWay = way <$> getContext
 getStagedSettingList :: (Stage -> SettingList) -> Args Context b
 getStagedSettingList f = getSettingList . f =<< getStage
 
--- | Construct an expression that depends on the Cabal file of the current
--- package and is empty in a non-Haskell context.
-withHsPackage :: (Monoid a, Semigroup a) => (Context -> Expr Context b a) -> Expr Context b a
-withHsPackage expr = do
-    pkg <- getPackage
-    ctx <- getContext
-    case pkgCabalFile pkg of
-        Just _  -> expr ctx
-        Nothing -> mempty
-
-pkgId :: Context -> Action FilePath
-pkgId ctx@Context {..} = case pkgCabalFile package of
-    Just _  -> pkgIdentifier ctx
-    Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts
-
 libDir :: Context -> FilePath
 libDir Context {..} = stageString stage -/- "lib"
 
@@ -69,7 +53,7 @@ libPath context = buildRoot <&> (-/- libDir context)
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context@Context {..} prefix suffix = do
     path <- buildPath context
-    pid  <- pkgId context
+    pid  <- pkgIdentifier context
     return $ path -/- prefix ++ pid ++ suffix
 
 -- | Path to inplace package configuration file of a given 'Context'.
@@ -108,8 +92,8 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o"
 -- | Path to the configuration file of a given 'Context'.
 pkgConfFile :: Context -> Action FilePath
 pkgConfFile ctx@Context {..} = do
-    root  <- buildRoot
-    pid   <- pkgId ctx
+    root <- buildRoot
+    pid  <- pkgIdentifier ctx
     return $ root -/- relativePackageDbPath stage -/- pid <.> "conf"
 
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
index 59146eb..4ce622e 100644 (file)
@@ -1,12 +1,12 @@
 module Context.Type where
 
-import Hadrian.Package.Type
+import Development.Shake.Classes
+import GHC.Generics
+import Hadrian.Package
+
 import Stage
 import Way.Type
 
-import GHC.Generics
-import Development.Shake.Classes
-
 -- | Build context for a currently built 'Target'. We generate potentially
 -- different build rules for each 'Context'.
 data Context = Context
index 61fd41e..088fc5e 100644 (file)
@@ -30,12 +30,10 @@ import Hadrian.Expression hiding (Expr, Predicate, Args)
 import Hadrian.Haskell.Cabal.PackageData
 import Hadrian.Oracles.TextFile
 
--- TODO: Get rid of partiality.
 -- | Get values from a configured cabal stage.
 getPackageData :: (PackageData -> a) -> Expr a
 getPackageData key = do
-    ctx <- getContext
-    Just packageData <- expr (readPackageData ctx)
+    packageData <- expr . readPackageData =<< getContext
     return $ key packageData
 
 -- | Is the build currently in the provided stage?
index 87b6614..1d7167a 100644 (file)
@@ -13,23 +13,22 @@ module Hadrian.Haskell.Cabal (
     pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
     ) where
 
-import Data.Maybe
 import Development.Shake
 
 import Context.Type
 import Hadrian.Haskell.Cabal.CabalData
-import Hadrian.Package
 import Hadrian.Oracles.TextFile
+import Hadrian.Package
 
 -- | Read a Cabal file and return the package version. The Cabal file is tracked.
-pkgVersion :: Context -> Action (Maybe String)
-pkgVersion = fmap (fmap version) . readCabalData
+pkgVersion :: Context -> Action String
+pkgVersion = fmap version . readCabalData
 
 -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@.
 -- The Cabal file is tracked.
 pkgIdentifier :: Context -> Action String
-pkgIdentifier ctx = do
-    cabal <- fromMaybe (error "Cabal file could not be read") <$> readCabalData ctx
+pkgIdentifier context = do
+    cabal <- readCabalData context
     return $ if null (version cabal)
         then name cabal
         else name cabal ++ "-" ++ version cabal
@@ -38,9 +37,9 @@ pkgIdentifier ctx = do
 -- The current version does not take care of Cabal conditionals and therefore
 -- returns a crude overapproximation of actual dependencies. The Cabal file is
 -- tracked.
-pkgDependencies :: Context -> Action (Maybe [PackageName])
-pkgDependencies = fmap (fmap (map pkgName . packageDependencies)) . readCabalData
+pkgDependencies :: Context -> Action [PackageName]
+pkgDependencies = fmap (map pkgName . packageDependencies) . readCabalData
 
 -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
-pkgSynopsis :: Context -> Action (Maybe String)
-pkgSynopsis = fmap (fmap synopsis) . readCabalData
+pkgSynopsis :: Context -> Action String
+pkgSynopsis = fmap synopsis . readCabalData
index eeb08b6..6e0ac76 100644 (file)
@@ -3,7 +3,7 @@ module Hadrian.Haskell.Cabal.CabalData where
 import Development.Shake.Classes
 import Distribution.PackageDescription
 import GHC.Generics
-import Hadrian.Package.Type
+import Hadrian.Package
 
 -- | Haskell package metadata extracted from a Cabal file, without performing
 -- the resolution of package configuration flags and associated conditionals.
index c607bd6..be45f6f 100644 (file)
@@ -2,7 +2,7 @@ module Hadrian.Haskell.Cabal.PackageData where
 
 import Development.Shake.Classes
 import GHC.Generics
-import Hadrian.Package.Type
+import Hadrian.Package
 
 -- | Most of these fields used to be provided in @package-data.mk@ files.
 data PackageData = PackageData
index 1137711..8dce75e 100644 (file)
@@ -83,7 +83,7 @@ biModules pd = go [ comp | comp@(bi,_,_) <-
 -- such as platform, compiler version conditionals, and package flags.
 parseCabalFile :: Context -> Action CabalData
 parseCabalFile context@Context {..} = do
-    let file = unsafePkgCabalFile package
+    let file = pkgCabalFile package
 
     -- Read the package description from the Cabal file
     gpd <- liftIO $ C.readGenericPackageDescription C.verbose file
@@ -124,7 +124,7 @@ configurePackage :: Context -> Action ()
 configurePackage context@Context {..} = do
     putLoud $ "| Configure package " ++ quote (pkgName package)
 
-    CabalData _ _ _ gpd _pd depPkgs <- unsafeReadCabalData context
+    CabalData _ _ _ gpd _pd depPkgs <- readCabalData context
 
     -- Stage packages are those we have in this stage.
     stagePkgs <- stagePackages stage
@@ -141,7 +141,7 @@ configurePackage context@Context {..} = do
         -- "Custom", but doesn't have a configure script.
         C.Custom -> do
             configureExists <- doesFileExist $
-                replaceFileName (unsafePkgCabalFile package) "configure"
+                replaceFileName (pkgCabalFile package) "configure"
             pure $ if configureExists then C.autoconfUserHooks else C.simpleUserHooks
         -- Not quite right, but good enough for us:
         _ | package == rts ->
@@ -165,7 +165,7 @@ configurePackage context@Context {..} = do
 copyPackage :: Context -> Action ()
 copyPackage context@Context {..} = do
     putLoud $ "| Copy package " ++ quote (pkgName package)
-    CabalData _ _ _ gpd _ _ <- unsafeReadCabalData context
+    CabalData _ _ _ gpd _ _ <- readCabalData context
     ctxPath   <- Context.contextPath context
     pkgDbPath <- packageDbPath stage
     verbosity <- getVerbosity
@@ -178,7 +178,7 @@ registerPackage :: Context -> Action ()
 registerPackage context@Context {..} = do
     putLoud $ "| Register package " ++ quote (pkgName package)
     ctxPath <- Context.contextPath context
-    CabalData _ _ _ gpd _ _ <- unsafeReadCabalData context
+    CabalData _ _ _ gpd _ _ <- readCabalData context
     verbosity <- getVerbosity
     let v = if verbosity >= Loud then "-v3" else "-v0"
     liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
@@ -195,7 +195,7 @@ parsePackageData context@Context {..} = do
     -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd
     --
     -- However when using the new-build path's this might change.
-    CabalData _ _ _ _gpd pd _depPkgs <- unsafeReadCabalData context
+    CabalData _ _ _ _gpd pd _depPkgs <- readCabalData context
 
     cPath <- Context.contextPath context
     need [cPath -/- "setup-config"]
index 9eaf528..f82e79d 100644 (file)
 module Hadrian.Oracles.TextFile (
     readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
     lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
-    readCabalData, unsafeReadCabalData, readPackageData
+    readCabalData, readPackageData
     ) where
 
 import Data.Maybe
 import Development.Shake
-import GHC.Stack
 
 import Context.Type
 import Hadrian.Haskell.Cabal.CabalData
@@ -75,17 +74,11 @@ lookupDependencies depFile file = do
         Just (source : files) -> return (source, files)
 
 -- | Read and parse a @.cabal@ file, caching and tracking the result.
-readCabalData :: Context -> Action (Maybe CabalData)
+readCabalData :: Context -> Action CabalData
 readCabalData = askOracle . CabalFile
 
--- | Like 'readCabalData' but raises an error on a non-Cabal context.
-unsafeReadCabalData :: HasCallStack => Context -> Action CabalData
-unsafeReadCabalData context = fromMaybe (error msg) <$> readCabalData context
-  where
-    msg = "[unsafeReadCabalData] Non-Cabal context: " ++ show context
-
 -- | Read and parse a @.cabal@ file recording the obtained 'PackageData',
 -- caching and tracking the result. Note that unlike 'readCabalData' this
 -- function resolves all Cabal configuration flags and associated conditionals.
-readPackageData :: Context -> Action (Maybe PackageData)
+readPackageData :: Context -> Action PackageData
 readPackageData = askOracle . PackageDataFile
index 7722001..a80e7d8 100644 (file)
@@ -46,22 +46,18 @@ textFileOracle = do
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
     void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
 
-    cabal <- newCache $ \(ctx@Context {..}) ->
-        case pkgCabalFile package of
-            Just file -> do
-                need [file]
-                putLoud $ "| CabalFile oracle: reading " ++ quote file
-                       ++ " (Stage: " ++ stageString stage ++ ")..."
-                Just <$> parseCabalFile ctx
-            Nothing -> return Nothing
+    cabal <- newCache $ \(ctx@Context {..}) -> do
+        let file = pkgCabalFile package
+        need [file]
+        putLoud $ "| CabalFile oracle: reading " ++ quote file
+               ++ " (Stage: " ++ stageString stage ++ ")..."
+        parseCabalFile ctx
     void $ addOracle $ \(CabalFile ctx) -> cabal ctx
 
-    confCabal <- newCache $ \(ctx@Context {..}) ->
-        case pkgCabalFile package of
-            Just file -> do
-                need [file]
-                putLoud $ "| PackageDataFile oracle: reading " ++ quote file
-                       ++ " (Stage: " ++ stageString stage ++ ")..."
-                Just <$> parsePackageData ctx
-            Nothing -> return Nothing
+    confCabal <- newCache $ \(ctx@Context {..}) -> do
+        let file = pkgCabalFile package
+        need [file]
+        putLoud $ "| PackageDataFile oracle: reading " ++ quote file
+               ++ " (Stage: " ++ stageString stage ++ ")..."
+        parsePackageData ctx
     void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx
index b0d55b8..c16c165 100644 (file)
@@ -26,11 +26,11 @@ type instance RuleResult TextFile = String
 
 newtype CabalFile = CabalFile Context
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult CabalFile = Maybe CabalData
+type instance RuleResult CabalFile = CabalData
 
 newtype PackageDataFile = PackageDataFile Context
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult PackageDataFile = Maybe PackageData
+type instance RuleResult PackageDataFile = PackageData
 
 newtype KeyValue = KeyValue (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
index b0e3153..6bc31d7 100644 (file)
 -----------------------------------------------------------------------------
 module Hadrian.Package (
     -- * Data types
-    Package (..), PackageName, PackageLanguage, PackageType,
+    Package (..), PackageName, PackageType,
 
     -- * Construction and properties
-    cLibrary, cProgram, hsLibrary, hsProgram, dummyPackage,
-    isLibrary, isProgram, isCPackage, isHsPackage,
+    library, program, dummyPackage, isLibrary, isProgram,
 
     -- * Package directory structure
-    pkgCabalFile, unsafePkgCabalFile
+    pkgCabalFile
     ) where
 
-import Data.Maybe
+import Development.Shake.Classes
 import Development.Shake.FilePath
-import GHC.Stack
+import GHC.Generics
 
-import Hadrian.Package.Type
 import Hadrian.Utilities
 
--- | Construct a C library package.
-cLibrary :: PackageName -> FilePath -> Package
-cLibrary = Package C Library
+-- TODO: Make PackageType more precise.
+-- See https://github.com/snowleopard/hadrian/issues/12.
+data PackageType = Library | Program deriving (Eq, Generic, Ord, Show)
 
--- | Construct a C program package.
-cProgram :: PackageName -> FilePath -> Package
-cProgram = Package C Program
+type PackageName = String
 
--- | Construct a Haskell library package.
-hsLibrary :: PackageName -> FilePath -> Package
-hsLibrary = Package Haskell Library
+-- TODO: Consider turning Package into a GADT indexed with language and type.
+data Package = Package {
+    -- | The package type. 'Library' and 'Program' packages are supported.
+    pkgType :: PackageType,
+    -- | The package name. We assume that all packages have different names,
+    -- hence two packages with the same name are considered equal.
+    pkgName :: PackageName,
+    -- | The path to the package source code relative to the root of the build
+    -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the
+    -- @Cabal@ and @ghc-bin@ packages in GHC.
+    pkgPath :: FilePath
+    } deriving (Eq, Generic, Ord, Show)
 
--- | Construct a Haskell program package.
-hsProgram :: PackageName -> FilePath -> Package
-hsProgram = Package Haskell Program
+-- | Construct a library package.
+library :: PackageName -> FilePath -> Package
+library = Package Library
 
--- | A dummy package, which we never try to build
---   but just use as a better @undefined@ in code
---   where we need a 'Package' to set up a Context
---   but will not really operate over one.
+-- | Construct a program package.
+program :: PackageName -> FilePath -> Package
+program = Package Program
+
+-- TODO: Remove this hack.
+-- | A dummy package that we never try to build but use when we need a 'Package'
+-- to construct a 'Context' but do not need to access the package field.
 dummyPackage :: Package
-dummyPackage = hsLibrary "dummy" "dummy/path/"
+dummyPackage = library "dummy" "dummy/path/"
 
 -- | Is this a library package?
 isLibrary :: Package -> Bool
-isLibrary (Package Library _ _) = True
+isLibrary (Package Library _ _) = True
 isLibrary _ = False
 
 -- | Is this a program package?
 isProgram :: Package -> Bool
-isProgram (Package Program _ _) = True
+isProgram (Package Program _ _) = True
 isProgram _ = False
 
--- | Is this a C package?
-isCPackage :: Package -> Bool
-isCPackage (Package C _ _ _) = True
-isCPackage _ = False
-
--- | Is this a Haskell package?
-isHsPackage :: Package -> Bool
-isHsPackage (Package Haskell _ _ _) = True
--- we consider the RTS as a haskell package because we
--- use information from its Cabal file to build it,
--- and we e.g want 'pkgCabalFile' to point us to
--- 'rts/rts.cabal' when passed the rts package as argument.
-isHsPackage (Package _ _ "rts" _)   = True
-isHsPackage _ = False
+-- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@.
+pkgCabalFile :: Package -> FilePath
+pkgCabalFile p = pkgPath p -/- pkgName p <.> "cabal"
 
--- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@,
--- or @Nothing@ if the argument is not a Haskell package.
-pkgCabalFile :: Package -> Maybe FilePath
-pkgCabalFile p | isHsPackage p = Just $ pkgPath p -/- pkgName p <.> "cabal"
-               | otherwise     = Nothing
+instance Binary   PackageType
+instance Hashable PackageType
+instance NFData   PackageType
 
--- | Like 'pkgCabalFile' but raises an error on a non-Cabal package.
-unsafePkgCabalFile :: HasCallStack => Package -> FilePath
-unsafePkgCabalFile p = fromMaybe (error msg) (pkgCabalFile p)
-  where
-    msg = "[unsafePkgCabalFile] Non-Cabal package: " ++ show p
+instance Binary   Package
+instance Hashable Package
+instance NFData   Package
\ No newline at end of file
diff --git a/src/Hadrian/Package/Type.hs b/src/Hadrian/Package/Type.hs
deleted file mode 100644 (file)
index c8b86e3..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-module Hadrian.Package.Type where
-
-import GHC.Generics
-import Development.Shake.Classes
-
-data PackageLanguage = C | Haskell deriving (Generic, Show)
-
--- TODO: Make PackageType more precise.
--- See https://github.com/snowleopard/hadrian/issues/12.
-data PackageType = Library | Program deriving (Generic, Show)
-
-type PackageName = String
-
--- TODO: Consider turning Package into a GADT indexed with language and type.
-data Package = Package {
-    -- | The package language. 'C' and 'Haskell' packages are supported.
-    pkgLanguage :: PackageLanguage,
-    -- | The package type. 'Library' and 'Program' packages are supported.
-    pkgType :: PackageType,
-    -- | The package name. We assume that all packages have different names,
-    -- hence two packages with the same name are considered equal.
-    pkgName :: PackageName,
-    -- | The path to the package source code relative to the root of the build
-    -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the
-    -- @Cabal@ and @ghc-bin@ packages in GHC.
-    pkgPath :: FilePath
-    } deriving (Generic, Show)
-
-instance Eq Package where
-    p == q = pkgName p == pkgName q
-
-instance Ord Package where
-    compare p q = compare (pkgName p) (pkgName q)
-
-instance Binary   PackageLanguage
-instance Hashable PackageLanguage
-instance NFData   PackageLanguage
-
-instance Binary   PackageType
-instance Hashable PackageType
-instance NFData   PackageType
-
-instance Binary   Package
-instance Hashable Package
-instance NFData   Package
index 6cd9963..88b5bad 100644 (file)
@@ -408,22 +408,21 @@ renderActionNoOutput what input = do
     i = unifyPath input
 
 -- | Render the successful build of a program.
-renderProgram :: String -> String -> Maybe String -> String
+renderProgram :: String -> String -> String -> String
 renderProgram name bin synopsis = renderBox $
     [ "Successfully built program " ++ name
     , "Executable: " ++ bin ] ++
-    [ "Program synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
+    [ "Program synopsis: " ++ endWithADot synopsis | not (null synopsis) ]
 
 -- | Render the successful build of a library.
-renderLibrary :: String -> String -> Maybe String -> String
+renderLibrary :: String -> String -> String -> String
 renderLibrary name lib synopsis = renderBox $
     [ "Successfully built library " ++ name
     , "Library: " ++ lib ] ++
-    [ "Library synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
+    [ "Library synopsis: " ++ endWithADot synopsis | not (null synopsis) ]
 
-prettySynopsis :: Maybe String -> String
-prettySynopsis Nothing  = ""
-prettySynopsis (Just s) = dropWhileEnd isPunctuation s ++ "."
+endWithADot :: String -> String
+endWithADot s = dropWhileEnd isPunctuation s ++ "."
 
 -- | Render the given set of lines in an ASCII box. The minimum width and
 -- whether to use Unicode symbols are hardcoded in the function's body.
index c4645d4..52d4110 100644 (file)
@@ -44,83 +44,79 @@ isGhcPackage :: Package -> Bool
 isGhcPackage = (`elem` ghcPackages)
 
 -- | Package definitions, see 'Package'.
-array               = hsLib  "array"
-base                = hsLib  "base"
-binary              = hsLib  "binary"
-bytestring          = hsLib  "bytestring"
-cabal               = hsLib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
-checkApiAnnotations = hsUtil "check-api-annotations"
-checkPpr            = hsUtil "check-ppr"
-compareSizes        = hsUtil "compareSizes"    `setPath` "utils/compare_sizes"
-compiler            = hsTop  "ghc"             `setPath` "compiler"
-containers          = hsLib  "containers"
-deepseq             = hsLib  "deepseq"
-deriveConstants     = hsUtil "deriveConstants"
-directory           = hsLib  "directory"
-filepath            = hsLib  "filepath"
-genapply            = hsUtil "genapply"
-genprimopcode       = hsUtil "genprimopcode"
-ghc                 = hsPrg  "ghc-bin"         `setPath` "ghc"
-ghcBoot             = hsLib  "ghc-boot"
-ghcBootTh           = hsLib  "ghc-boot-th"
-ghcCompact          = hsLib  "ghc-compact"
-ghcHeap             = hsLib  "ghc-heap"
-ghci                = hsLib  "ghci"
-ghcPkg              = hsUtil "ghc-pkg"
-ghcPrim             = hsLib  "ghc-prim"
-ghcTags             = hsUtil "ghctags"
-ghcSplit            = hsUtil "ghc-split"
-haddock             = hsUtil "haddock"
-haskeline           = hsLib  "haskeline"
-hsc2hs              = hsUtil "hsc2hs"
-hp2ps               = hsUtil "hp2ps"
-hpc                 = hsLib  "hpc"
-hpcBin              = hsUtil "hpc-bin"         `setPath` "utils/hpc"
-integerGmp          = hsLib  "integer-gmp"
-integerSimple       = hsLib  "integer-simple"
-iserv               = hsUtil "iserv"
-libffi              = cTop   "libffi"
-libiserv            = hsLib  "libiserv"
-mtl                 = hsLib  "mtl"
-parsec              = hsLib  "parsec"
-parallel            = hsLib  "parallel"
-pretty              = hsLib  "pretty"
-primitive           = hsLib  "primitive"
-process             = hsLib  "process"
-rts                 = cTop   "rts"
-runGhc              = hsUtil "runghc"
-stm                 = hsLib  "stm"
-templateHaskell     = hsLib  "template-haskell"
-terminfo            = hsLib  "terminfo"
-text                = hsLib  "text"
-time                = hsLib  "time"
-timeout             = hsUtil "timeout"         `setPath` "testsuite/timeout"
-touchy              = hsUtil "touchy"
-transformers        = hsLib  "transformers"
-unlit               = hsUtil "unlit"
-unix                = hsLib  "unix"
-win32               = hsLib  "Win32"
-xhtml               = hsLib  "xhtml"
-
--- | Construct a Haskell library package, e.g. @array@.
-hsLib :: PackageName -> Package
-hsLib name = hsLibrary name ("libraries" -/- name)
-
--- | Construct a top-level Haskell library package, e.g. @compiler@.
-hsTop :: PackageName -> Package
-hsTop name = hsLibrary name name
-
--- | Construct a top-level C library package, e.g. @rts@.
-cTop :: PackageName -> Package
-cTop name = cLibrary name name
-
--- | Construct a top-level Haskell program package, e.g. @ghc@.
-hsPrg :: PackageName -> Package
-hsPrg name = hsProgram name name
-
--- | Construct a Haskell utility package, e.g. @haddock@.
-hsUtil :: PackageName -> Package
-hsUtil name = hsProgram name ("utils" -/- name)
+array               = lib  "array"
+base                = lib  "base"
+binary              = lib  "binary"
+bytestring          = lib  "bytestring"
+cabal               = lib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
+checkApiAnnotations = util "check-api-annotations"
+checkPpr            = util "check-ppr"
+compareSizes        = util "compareSizes"    `setPath` "utils/compare_sizes"
+compiler            = top  "ghc"             `setPath` "compiler"
+containers          = lib  "containers"
+deepseq             = lib  "deepseq"
+deriveConstants     = util "deriveConstants"
+directory           = lib  "directory"
+filepath            = lib  "filepath"
+genapply            = util "genapply"
+genprimopcode       = util "genprimopcode"
+ghc                 = prg  "ghc-bin"         `setPath` "ghc"
+ghcBoot             = lib  "ghc-boot"
+ghcBootTh           = lib  "ghc-boot-th"
+ghcCompact          = lib  "ghc-compact"
+ghcHeap             = lib  "ghc-heap"
+ghci                = lib  "ghci"
+ghcPkg              = util "ghc-pkg"
+ghcPrim             = lib  "ghc-prim"
+ghcTags             = util "ghctags"
+ghcSplit            = util "ghc-split"
+haddock             = util "haddock"
+haskeline           = lib  "haskeline"
+hsc2hs              = util "hsc2hs"
+hp2ps               = util "hp2ps"
+hpc                 = lib  "hpc"
+hpcBin              = util "hpc-bin"         `setPath` "utils/hpc"
+integerGmp          = lib  "integer-gmp"
+integerSimple       = lib  "integer-simple"
+iserv               = util "iserv"
+libffi              = top  "libffi"
+libiserv            = lib  "libiserv"
+mtl                 = lib  "mtl"
+parsec              = lib  "parsec"
+parallel            = lib  "parallel"
+pretty              = lib  "pretty"
+primitive           = lib  "primitive"
+process             = lib  "process"
+rts                 = top  "rts"
+runGhc              = util "runghc"
+stm                 = lib  "stm"
+templateHaskell     = lib  "template-haskell"
+terminfo            = lib  "terminfo"
+text                = lib  "text"
+time                = lib  "time"
+timeout             = util "timeout"         `setPath` "testsuite/timeout"
+touchy              = util "touchy"
+transformers        = lib  "transformers"
+unlit               = util "unlit"
+unix                = lib  "unix"
+win32               = lib  "Win32"
+xhtml               = lib  "xhtml"
+
+-- | Construct a library package, e.g. @array@.
+lib :: PackageName -> Package
+lib name = library name ("libraries" -/- name)
+
+-- | Construct a top-level library package, e.g. @compiler@.
+top :: PackageName -> Package
+top name = library name name
+
+-- | Construct a top-level program package, e.g. @ghc@.
+prg :: PackageName -> Package
+prg name = program name name
+
+-- | Construct a utility package, e.g. @haddock@.
+util :: PackageName -> Package
+util name = program name ("utils" -/- name)
 
 -- | Amend a package path if it doesn't conform to a typical pattern.
 setPath :: Package -> FilePath -> Package
index 90922bd..8a90346 100644 (file)
@@ -1,5 +1,7 @@
 module Rules.BinaryDist where
 
+import Hadrian.Haskell.Cabal
+
 import Context
 import Expression
 import Oracles.Setting
@@ -19,7 +21,7 @@ bindistRules = do
       targetPlatform <- setting TargetPlatformFull
       hostOs         <- setting BuildOs
       hostArch       <- setting BuildArch
-      rtsDir         <- pkgId $ vanillaContext Stage1 rts
+      rtsDir         <- pkgIdentifier $ vanillaContext Stage1 rts
 
       let ghcBuildDir      = root -/- stageString Stage1
           bindistFilesDir  = root -/- "bindist" -/- ghcVersionPretty
index 23c13b3..8863658 100644 (file)
@@ -42,13 +42,13 @@ documentationRules = do
 manPageBuildPath :: FilePath
 manPageBuildPath = "docs/users_guide/build-man/ghc.1"
 
--- TODO: Add support for Documentation Packages so we can
--- run the builders without this hack.
+-- TODO: Add support for Documentation Packages so we can run the builders
+-- without this hack.
 docPackage :: Package
-docPackage = hsLibrary "Documentation" "docs"
+docPackage = library "Documentation" "docs"
 
 docPaths :: [FilePath]
-docPaths = [ "libraries", "users_guide", "Haddock" ]
+docPaths = ["libraries", "users_guide", "Haddock"]
 
 docRoot :: FilePath
 docRoot = "docs"
@@ -131,7 +131,7 @@ allHaddocks :: Action [FilePath]
 allHaddocks = do
     pkgs <- stagePackages Stage1
     sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
-             | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
+             | pkg <- pkgs, isLibrary pkg ]
 
 haddockHtmlLib ::FilePath
 haddockHtmlLib = "docs/html/haddock-bundle.min.js"
index 1ad67b6..49a7d22 100644 (file)
@@ -3,7 +3,6 @@ module Rules.Library (libraryRules) where
 import Data.Functor
 import Hadrian.Haskell.Cabal
 import Hadrian.Haskell.Cabal.PackageData as PD
-import Hadrian.Package.Type
 import qualified System.Directory as IO
 import qualified Text.Parsec      as Parsec
 
@@ -161,21 +160,21 @@ libAContext :: BuildPath LibA -> Context
 libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
     Context stage pkg way
   where
-    pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
+    pkg = library pkgname pkgpath
 
 -- | Get the 'Context' corresponding to the build path for a given GHCi library.
 libGhciContext :: BuildPath LibGhci -> Context
 libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
     Context stage pkg way
   where
-    pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
+    pkg = library pkgname pkgpath
 
 -- | Get the 'Context' corresponding to the build path for a given dynamic library.
 libDynContext :: BuildPath LibDyn -> Context
 libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
     Context stage pkg way
   where
-    pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
+    pkg = library pkgname pkgpath
 
 -- | Parse a build path for a library to be built under the given build root,
 -- where the filename will be parsed with the given parser argument.
index b435df2..d6c1702 100644 (file)
@@ -54,12 +54,12 @@ testChunksOfSize = do
 testDependencies :: Action ()
 testDependencies = do
     putBuild "==== pkgDependencies"
-    depLists <- mapM (pkgDependencies . vanillaContext Stage1) ghcPackages
-    test $ and [ deps == sort deps | Just deps <- depLists ]
+    let pkgs = ghcPackages \\ [libffi] -- @libffi@ does not have a Cabal file.
+    depLists <- mapM (pkgDependencies . vanillaContext Stage1) pkgs
+    test $ and [ deps == sort deps | deps <- depLists ]
     putBuild "==== Dependencies of the 'ghc-bin' binary"
     ghcDeps <- pkgDependencies (vanillaContext Stage1 ghc)
-    test $ isJust ghcDeps
-    test $ pkgName compiler `elem` fromJust ghcDeps
+    test $ pkgName compiler `elem` ghcDeps
     stage0Deps <- contextDependencies (vanillaContext Stage0 ghc)
     stage1Deps <- contextDependencies (vanillaContext Stage1 ghc)
     stage2Deps <- contextDependencies (vanillaContext Stage2 ghc)
index c314f26..3a91de0 100644 (file)
@@ -1,6 +1,5 @@
 module Settings.Builders.Cabal (cabalBuilderArgs) where
 
-import Data.Maybe (fromJust)
 import Hadrian.Builder (getBuilderPath, needBuilder)
 import Hadrian.Haskell.Cabal
 
@@ -26,7 +25,7 @@ cabalBuilderArgs = builder (Cabal Setup) ? do
             , flag CrossCompiling ? pure [ "--disable-executable-stripping"
                                          , "--disable-library-stripping" ]
             , arg "--cabal-file"
-            , arg =<< fromJust . pkgCabalFile <$> getPackage
+            , arg =<< pkgCabalFile <$> getPackage
             , arg "--distdir"
             , arg $ top -/- path
             , arg "--ipid"
@@ -111,10 +110,10 @@ bootPackageConstraints :: Args
 bootPackageConstraints = stage0 ? do
     bootPkgs <- expr $ stagePackages Stage0
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
-    ctx <- getContext
-    constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do
-        version <- pkgVersion (ctx { Context.package = pkg})
-        return $ fmap ((pkgName pkg ++ " == ") ++) version
+    context <- getContext
+    constraints <- expr $ forM (sort pkgs) $ \pkg -> do
+        version <- pkgVersion (context { Context.package = pkg })
+        return $ ((pkgName pkg ++ " == ") ++) version
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args
index 1eb31a0..d70a034 100644 (file)
@@ -107,8 +107,9 @@ wayGhcArgs = do
               pure ["-ticky", "-DTICKY_TICKY"] ]
 
 packageGhcArgs :: Args
-packageGhcArgs = withHsPackage $ \ctx -> do
-    pkgId <- expr $ pkgIdentifier ctx
+packageGhcArgs = do
+    context <- getContext
+    pkgId   <- expr $ pkgIdentifier context
     mconcat [ arg "-hide-all-packages"
             , arg "-no-user-package-db"
             , packageDatabaseArgs
index a81e3fe..4124023 100644 (file)
@@ -3,6 +3,8 @@ module Settings.Builders.Haddock (haddockBuilderArgs) where
 import Hadrian.Haskell.Cabal
 import Hadrian.Haskell.Cabal.PackageData as PD
 import Hadrian.Utilities
+
+import Packages
 import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
@@ -11,9 +13,8 @@ import Settings.Builders.Ghc
 versionToInt :: String -> Int
 versionToInt = read . dropWhile (=='0') . filter (/='.')
 
--- TODO: Get rid of partiality (see @Just foo <- @).
 haddockBuilderArgs :: Args
-haddockBuilderArgs = withHsPackage $ \ctx -> mconcat
+haddockBuilderArgs = mconcat
     [ builder (Haddock BuildIndex) ? do
         output <- getOutput
         inputs <- getInputs
@@ -31,16 +32,17 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat
                      ++ "," ++ haddock | haddock <- inputs ] ]
 
     , builder (Haddock BuildPackage) ? do
-        output        <- getOutput
-        pkg           <- getPackage
-        root          <- getBuildRoot
-        path          <- getBuildPath
-        Just version  <- expr $ pkgVersion  ctx
-        Just synopsis <- expr $ pkgSynopsis ctx
-        deps          <- getPackageData PD.depNames
-        haddocks      <- expr . haddockDependencies =<< getContext
-        Just hVersion <- expr $ pkgVersion ctx
-        ghcOpts       <- haddockGhcArgs
+        output   <- getOutput
+        pkg      <- getPackage
+        root     <- getBuildRoot
+        path     <- getBuildPath
+        context  <- getContext
+        version  <- expr $ pkgVersion  context
+        synopsis <- expr $ pkgSynopsis context
+        deps     <- getPackageData PD.depNames
+        haddocks <- expr $ haddockDependencies context
+        hVersion <- expr $ pkgVersion (vanillaContext Stage2 haddock)
+        ghcOpts  <- haddockGhcArgs
         mconcat
             [ arg "--verbosity=0"
             , arg $ "-B" ++ root -/- "stage1" -/- "lib"
index 1be1e54..a7abcb9 100644 (file)
@@ -45,11 +45,10 @@ contextDependencies ctx@Context {..} = do
         deps <- concatMapM step pkgs
         let newPkgs = nubOrd $ sort (deps ++ pkgs)
         if pkgs == newPkgs then return pkgs else go newPkgs
-    step pkg = pkgDependencies (ctx { Context.package = pkg }) >>= \case
-        Nothing -> return [] -- Non-Cabal packages have no dependencies.
-        Just deps -> do
-            active <- sort <$> stagePackages depStage
-            return $ intersectOrd (compare . pkgName) active deps
+    step pkg = do
+        deps   <- pkgDependencies $ ctx { Context.package = pkg }
+        active <- sort <$> stagePackages depStage
+        return $ intersectOrd (compare . pkgName) active deps
 
 cabalDependencies :: Context -> Action [String]
 cabalDependencies ctx = interpretInContext ctx $ getPackageData PD.depIpIds