diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 5b0842fb9e6f6b8843e0c670a38dc1028e45aa65..596a885b401ee793e42bef05a6d4d7d7d0cd7f83 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -141,8 +141,9 @@ showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal fil showBuildInfo pkg_descr lbi flags = do let verbosity = fromFlag (buildVerbosity flags) targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + pwd <- getCurrentDirectory let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) - doc = mkBuildInfo pkg_descr lbi flags targetsToBuild + doc = mkBuildInfo pwd pkg_descr lbi flags targetsToBuild return $ renderJson doc diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 5dfe8e3a10775191ba8ce9822041c390033f44b3..fbbebbe9e0dd10a76fac4c09798c8c1839293522 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -54,7 +54,10 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- -module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where +{-# LANGUAGE OverloadedStrings #-} + +module Distribution.Simple.ShowBuildInfo + ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where import Distribution.Compat.Prelude import Prelude () @@ -74,71 +77,98 @@ import Distribution.Utils.Json import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty -import Distribution.Utils.Path -- | Construct a JSON document describing the build information for a -- package. mkBuildInfo - :: PackageDescription -- ^ Mostly information from the .cabal file + :: FilePath -- ^ The source directory of the package + -> PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = info - where - targetToNameAndLBI target = - (componentLocalName $ targetCLBI target, targetCLBI target) - componentsToBuild = map targetToNameAndLBI targetsToBuild +mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = + JsonObject $ + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild) - info = JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) - , "compiler" .= mkCompilerInfo - , "components" .= JsonArray (map mkComponentInfo componentsToBuild) - ] +-- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and +-- 'mkComponentInfo' yourself. +mkBuildInfo' + :: Json -- ^ The 'Json' from 'mkCompilerInfo' + -> [Json] -- ^ The 'Json' from 'mkComponentInfo' + -> [(String, Json)] +mkBuildInfo' cmplrInfo componentInfos = + [ "cabal-version" .= JsonString (display cabalVersion) + , "compiler" .= cmplrInfo + , "components" .= JsonArray componentInfos + ] - mkCompilerInfo = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi) - , "compiler-id" .= JsonString (showCompilerId $ compiler lbi) - , "path" .= path - ] - where - path = maybe JsonNull (JsonString . programPath) - $ (flavorToProgram . compilerFlavor $ compiler lbi) - >>= flip lookupProgram (withPrograms lbi) +mkCompilerInfo :: ProgramDb -> Compiler -> Json +mkCompilerInfo programDb cmplr = JsonObject + [ "flavour" .= JsonString (prettyShow $ compilerFlavor cmplr) + , "compiler-id" .= JsonString (showCompilerId cmplr) + , "path" .= path + ] + where + path = maybe JsonNull (JsonString . programPath) + $ (flavorToProgram . compilerFlavor $ cmplr) + >>= flip lookupProgram programDb - flavorToProgram :: CompilerFlavor -> Maybe Program - flavorToProgram GHC = Just ghcProgram - flavorToProgram GHCJS = Just ghcjsProgram - flavorToProgram UHC = Just uhcProgram - flavorToProgram JHC = Just jhcProgram - flavorToProgram _ = Nothing + flavorToProgram :: CompilerFlavor -> Maybe Program + flavorToProgram GHC = Just ghcProgram + flavorToProgram GHCJS = Just ghcjsProgram + flavorToProgram UHC = Just uhcProgram + flavorToProgram JHC = Just jhcProgram + flavorToProgram _ = Nothing - mkComponentInfo (name, clbi) = JsonObject - [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) - , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) - , "modules" .= JsonArray (map (JsonString . display) modules) - , "src-files" .= JsonArray (map JsonString sourceFiles) - , "src-dirs" .= JsonArray (map JsonString $ map getSymbolicPath $ hsSourceDirs bi) - ] - where - bi = componentBuildInfo comp - comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name - compType = case comp of - CLib _ -> "lib" - CExe _ -> "exe" - CTest _ -> "test" - CBench _ -> "bench" - CFLib _ -> "flib" - modules = case comp of - CLib lib -> explicitLibModules lib - CExe exe -> exeModules exe - _ -> [] - sourceFiles = case comp of - CLib _ -> [] - CExe exe -> [modulePath exe] - _ -> [] +mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ + [ "type" .= JsonString compType + , "name" .= JsonString (prettyShow name) + , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) + , "modules" .= JsonArray (map (JsonString . display) modules) + , "src-files" .= JsonArray (map JsonString sourceFiles) + , "hs-src-dirs" .= JsonArray (map (JsonString . prettyShow) $ hsSourceDirs bi) + , "src-dir" .= JsonString wdir + ] <> cabalFile + where + name = componentLocalName clbi + bi = componentBuildInfo comp + comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name + compType = case comp of + CLib _ -> "lib" + CExe _ -> "exe" + CTest _ -> "test" + CBench _ -> "bench" + CFLib _ -> "flib" + modules = case comp of + CLib lib -> explicitLibModules lib + CExe exe -> exeModules exe + CTest test -> + case testInterface test of + TestSuiteExeV10 _ _ -> [] + TestSuiteLibV09 _ modName -> [modName] + TestSuiteUnsupported _ -> [] + CBench bench -> benchmarkModules bench + CFLib flib -> foreignLibModules flib + sourceFiles = case comp of + CLib _ -> [] + CExe exe -> [modulePath exe] + CTest test -> + case testInterface test of + TestSuiteExeV10 _ fp -> [fp] + TestSuiteLibV09 _ _ -> [] + TestSuiteUnsupported _ -> [] + CBench bench -> case benchmarkInterface bench of + BenchmarkExeV10 _ fp -> [fp] + BenchmarkUnsupported _ -> [] + + CFLib _ -> [] + cabalFile + | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString fp)] + | otherwise = [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component.