From 0ec2fd833bac85f42cc2f6d9dbf753e703846a5b Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Sun, 19 May 2019 16:16:52 +0100 Subject: WIP: plugins --- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 2 ++ hadrian/src/Hadrian/Haskell/Cabal/Type.hs | 1 + hadrian/src/Hadrian/Package.hs | 36 ++++++++++++++++++++++++------ hadrian/src/Rules/Register.hs | 4 +++- hadrian/src/UserSettings.hs | 5 ++++- hadrian/src/Utilities.hs | 8 +++++-- 6 files changed, 45 insertions(+), 11 deletions(-) diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs index 5973eaec23..41a1b78e08 100644 --- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs @@ -227,6 +227,7 @@ resolveContextData context@Context {..} = do depDirect = map (fromMaybe (error "resolveContextData: depDirect failed") . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps depIds = map (C.display . Installed.installedUnitId) depDirect + pluginDepIds = pkgPlugins package Just ghcProg = C.lookupProgram C.ghcProgram (C.withPrograms lbi') depPkgs = C.topologicalOrder (packageHacks (C.installedPkgs lbi')) forDeps f = concatMap f depPkgs @@ -265,6 +266,7 @@ resolveContextData context@Context {..} = do , otherModules = map C.display $ C.otherModules buildInfo , srcDirs = C.hsSourceDirs buildInfo , depIds = depIds + , pluginDepIds = pluginDepIds , depNames = map (C.display . C.mungedName . snd) extDeps , includeDirs = C.includeDirs buildInfo , includes = C.includes buildInfo diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs index 2b5d51a719..5a32699d82 100644 --- a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs +++ b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs @@ -45,6 +45,7 @@ data ContextData = ContextData , otherModules :: [String] , srcDirs :: [String] , depIds :: [String] + , pluginDepIds :: [String] , depNames :: [String] , includeDirs :: [String] , includes :: [String] diff --git a/hadrian/src/Hadrian/Package.hs b/hadrian/src/Hadrian/Package.hs index 27b94aa775..8eff8df25c 100644 --- a/hadrian/src/Hadrian/Package.hs +++ b/hadrian/src/Hadrian/Package.hs @@ -17,11 +17,14 @@ module Hadrian.Package ( -- * Construction and properties library, program, external, dummyPackage - , isLibrary, isProgram + , isLibrary, isProgram, + + Plugin(..), PluginArgs(..), addPlugin ) where import Development.Shake.Classes +import Development.Shake import GHC.Generics -- TODO: Make PackageType more precise. @@ -46,19 +49,22 @@ data Package = Package { -- | 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. - pkgLocation :: PackageLocation + pkgLocation :: PackageLocation, + + -- | Plugins to run when building the package + pkgPlugins :: [String] } deriving (Eq, Generic, Ord, Show) -- | Construct a library package. library :: PackageName -> FilePath -> Package -library p fp = Package Library p (Internal fp) +library p fp = Package Library p (Internal fp) [] external :: PackageName -> String -> Package -external p v = Package Library p (External v) +external p v = Package Library p (External v) [] -- | Construct a program package. program :: PackageName -> FilePath -> Package -program p fp = Package Program p (Internal fp) +program p fp = Package Program p (Internal fp) [] -- TODO: Remove this hack. -- | A dummy package that we never try to build but use when we need a 'Package' @@ -68,12 +74,12 @@ 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 instance Binary PackageType @@ -87,3 +93,19 @@ instance NFData PackageLocation instance Binary Package instance Hashable Package instance NFData Package + +{- Plugins -} + +data Plugin = Plugin { pluginPackage :: Package + , pluginName :: String + , pluginOpts :: PluginArgs -> [String] + , initPhase :: PluginArgs -> Action () + , finalPhase :: PluginArgs -> Action () + } + + +data PluginArgs = PluginArgs { pluginOutput :: FilePath + , pluginTargetPackage :: Package } + +addPlugin :: Plugin -> Package -> Package +addPlugin pl p = p { pkgPlugins = pkgName (pluginPackage pl) : pkgPlugins p } diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs index 39899738c1..bad90e7df9 100644 --- a/hadrian/src/Rules/Register.hs +++ b/hadrian/src/Rules/Register.hs @@ -93,8 +93,10 @@ registerPackageRules rs stage = do buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConf _ context@Context {..} conf = do depPkgIds <- cabalDependencies context + pluginDepPkgIds <- pluginDependencies context ensureConfigured context - need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) + (depPkgIds ++ pluginDepPkgIds) ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] diff --git a/hadrian/src/UserSettings.hs b/hadrian/src/UserSettings.hs index c92dd11d44..5d1dbac018 100644 --- a/hadrian/src/UserSettings.hs +++ b/hadrian/src/UserSettings.hs @@ -8,7 +8,7 @@ -- Please update doc/user-settings.md when committing changes to this file. module UserSettings ( userFlavours, userPackages, userDefaultFlavour, - verboseCommand, buildProgressColour, successColour, finalStage + verboseCommand, buildProgressColour, successColour, finalStage, plugins ) where import Flavour @@ -38,6 +38,9 @@ userFlavour = defaultFlavour { name = "user" } -- Modify other settings here. userPackages :: [Package] userPackages = [] +plugins :: [Plugin] +plugins = [] + -- | Set to 'True' to print full command lines during the build process. Note: -- this is a 'Predicate', hence you can enable verbose output only for certain -- targets, e.g.: @verboseCommand = package ghcPrim@. diff --git a/hadrian/src/Utilities.hs b/hadrian/src/Utilities.hs index 2cc7a6e368..693af99138 100644 --- a/hadrian/src/Utilities.hs +++ b/hadrian/src/Utilities.hs @@ -3,7 +3,7 @@ module Utilities ( askWithResources, runBuilder, runBuilderWith, needLibrary, contextDependencies, stage1Dependencies, libraryTargets, - topsortPackages, cabalDependencies + topsortPackages, cabalDependencies, pluginDependencies ) where import qualified Hadrian.Builder as H @@ -48,7 +48,11 @@ contextDependencies Context {..} = do return $ intersectOrd (compare . pkgName) active deps cabalDependencies :: Context -> Action [String] -cabalDependencies ctx = interpretInContext ctx $ getContextData depIds +cabalDependencies ctx = + interpretInContext ctx $ getContextData depIds + +pluginDependencies :: Context -> Action [String] +pluginDependencies ctx = interpretInContext ctx $ getContextData pluginDepIds -- | Lookup dependencies of a 'Package' in the @vanilla Stage1 context@. stage1Dependencies :: Package -> Action [Package] -- cgit v1.2.1