-- |
-- This module defines a simple JSON-based format for exporting basic
-- information about a Cabal package and the compiler configuration Cabal
-- would use to build it. This can be produced with the
-- @cabal build --enable-build-info@ command.
--
--
-- This format is intended for consumption by external tooling and should
-- therefore be rather stable. Moreover, this allows tooling users to avoid
-- linking against Cabal. This is an important advantage as direct API usage
-- tends to be rather fragile in the presence of user-initiated upgrades of
-- Cabal.
--
-- Below is an example of the output this module produces,
--
-- @
-- { "cabal-lib-version": "1.23.0.0",
--   "compiler": {
--     "flavour": "GHC",
--     "compiler-id": "ghc-7.10.2",
--     "path": "/usr/bin/ghc",
--   },
--   "components": [
--     { "type": "lib",
--       "name": "lib:Cabal",
--       "compiler-args":
--         ["-O", "-XHaskell98", "-Wall",
--          "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"]
--       "modules": ["Project.ModA", "Project.ModB", "Paths_project"],
--       "src-files": [],
--       "src-dirs": ["src"]
--     }
--   ]
-- }
-- @
--
-- The output format needs to be validated against 'doc/json-schemas/build-info.schema.json'.
-- If the format changes, update the schema as well!
--
-- The @cabal-lib-version@ property provides the version of the Cabal library
-- which generated the output. The @compiler@ property gives some basic
-- information about the compiler Cabal would use to compile the package.
--
-- The @components@ property gives a list of the Cabal 'Component's defined by
-- the package. Each has,
--
-- * @type@: the type of the component (one of @lib@, @exe@,
--   @test@, @bench@, or @flib@)
-- * @name@: a string serving to uniquely identify the component within the
--   package.
-- * @compiler-args@: the command-line arguments Cabal would pass to the
--   compiler to compile the component
-- * @modules@: the modules belonging to the component
-- * @src-dirs@: a list of directories where the modules might be found
-- * @src-files@: any other Haskell sources needed by the component
--
-- Note: At the moment this is only supported when using the GHC compiler.
--

{-# LANGUAGE OverloadedStrings #-}

module Distribution.Simple.ShowBuildInfo (
  mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo
  ) where

import System.FilePath

import Distribution.Compat.Prelude
import Prelude ()

import qualified Distribution.Simple.GHC   as GHC
import qualified Distribution.Simple.Program.GHC as GHC

import Distribution.PackageDescription
import Distribution.Compiler
import Distribution.Verbosity
import Distribution.Simple.Compiler (Compiler, showCompilerId, compilerFlavor)
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Utils.Json
import Distribution.Types.Component
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Text
import Distribution.Pretty

-- | Construct a JSON document describing the build information for a
-- package.
mkBuildInfo
  :: 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
  -> (ConfiguredProgram, Compiler)
  -- ^ Compiler information.
  -- Needs to be passed explicitly, as we can't extract that information here
  -- without some partial function.
  -> [TargetInfo]
  -> ([String], Json)    -- ^ Json representation of buildinfo alongside generated warnings
mkBuildInfo :: FilePath
-> PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> (ConfiguredProgram, Compiler)
-> [TargetInfo]
-> ([FilePath], Json)
mkBuildInfo FilePath
wdir PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
_flags (ConfiguredProgram, Compiler)
compilerInfo [TargetInfo]
targetsToBuild = ([FilePath]
warnings, [(FilePath, Json)] -> Json
JsonObject [(FilePath, Json)]
buildInfoFields)
  where
    buildInfoFields :: [(FilePath, Json)]
buildInfoFields = Json -> [Json] -> [(FilePath, Json)]
mkBuildInfo' ((ConfiguredProgram -> Compiler -> Json)
-> (ConfiguredProgram, Compiler) -> Json
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ConfiguredProgram -> Compiler -> Json
mkCompilerInfo (ConfiguredProgram, Compiler)
compilerInfo) [Json]
componentInfos
    componentInfosWithWarnings :: [([FilePath], Json)]
componentInfosWithWarnings = (TargetInfo -> ([FilePath], Json))
-> [TargetInfo] -> [([FilePath], Json)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> ([FilePath], Json)
mkComponentInfo FilePath
wdir PackageDescription
pkg_descr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> ([FilePath], Json))
-> (TargetInfo -> ComponentLocalBuildInfo)
-> TargetInfo
-> ([FilePath], Json)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetInfo -> ComponentLocalBuildInfo
targetCLBI) [TargetInfo]
targetsToBuild
    componentInfos :: [Json]
componentInfos = (([FilePath], Json) -> Json) -> [([FilePath], Json)] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath], Json) -> Json
forall a b. (a, b) -> b
snd [([FilePath], Json)]
componentInfosWithWarnings
    warnings :: [FilePath]
warnings = (([FilePath], Json) -> [FilePath])
-> [([FilePath], Json)] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([FilePath], Json) -> [FilePath]
forall a b. (a, b) -> a
fst [([FilePath], Json)]
componentInfosWithWarnings

-- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and
-- 'mkComponentInfo' yourself.
--
-- If you change the format or any name in the output json, don't forget to update
-- the schema at @\/doc\/json-schemas\/build-info.schema.json@ and the docs of
-- @--enable-build-info@\/@--disable-build-info@.
mkBuildInfo'
  :: Json   -- ^ The 'Json' from 'mkCompilerInfo'
  -> [Json] -- ^ The 'Json' from 'mkComponentInfo'
  -> [(String, Json)]
mkBuildInfo' :: Json -> [Json] -> [(FilePath, Json)]
mkBuildInfo' Json
compilerInfo [Json]
componentInfos =
  [ FilePath
"cabal-lib-version" FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (Version -> FilePath
forall a. Pretty a => a -> FilePath
display Version
cabalVersion)
  , FilePath
"compiler"          FilePath -> Json -> (FilePath, Json)
.= Json
compilerInfo
  , FilePath
"components"        FilePath -> Json -> (FilePath, Json)
.= [Json] -> Json
JsonArray [Json]
componentInfos
  ]

mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json
mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json
mkCompilerInfo ConfiguredProgram
compilerProgram Compiler
compilerInfo = [(FilePath, Json)] -> Json
JsonObject
  [ FilePath
"flavour"     FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (CompilerFlavor -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (CompilerFlavor -> FilePath) -> CompilerFlavor -> FilePath
forall a b. (a -> b) -> a -> b
$ Compiler -> CompilerFlavor
compilerFlavor Compiler
compilerInfo)
  , FilePath
"compiler-id" FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (Compiler -> FilePath
showCompilerId Compiler
compilerInfo)
  , FilePath
"path"        FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
compilerProgram)
  ]

mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> ([String], Json)
mkComponentInfo :: FilePath
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> ([FilePath], Json)
mkComponentInfo FilePath
wdir PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi = ([FilePath]
warnings, [(FilePath, Json)] -> Json
JsonObject ([(FilePath, Json)] -> Json) -> [(FilePath, Json)] -> Json
forall a b. (a -> b) -> a -> b
$
  [ FilePath
"type"          FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString FilePath
compType
  , FilePath
"name"          FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (ComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ComponentName
name)
  , FilePath
"unit-id"       FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (UnitId -> FilePath) -> UnitId -> FilePath
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)
  , FilePath
"compiler-args" FilePath -> Json -> (FilePath, Json)
.= [Json] -> Json
JsonArray ((FilePath -> Json) -> [FilePath] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Json
JsonString [FilePath]
compilerArgs)
  , FilePath
"modules"       FilePath -> Json -> (FilePath, Json)
.= [Json] -> Json
JsonArray ((ModuleName -> Json) -> [ModuleName] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Json
JsonString (FilePath -> Json)
-> (ModuleName -> FilePath) -> ModuleName -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
display) [ModuleName]
modules)
  , FilePath
"src-files"     FilePath -> Json -> (FilePath, Json)
.= [Json] -> Json
JsonArray ((FilePath -> Json) -> [FilePath] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Json
JsonString [FilePath]
sourceFiles)
  , FilePath
"hs-src-dirs"   FilePath -> Json -> (FilePath, Json)
.= [Json] -> Json
JsonArray ((SymbolicPath PackageDir SourceDir -> Json)
-> [SymbolicPath PackageDir SourceDir] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Json
JsonString (FilePath -> Json)
-> (SymbolicPath PackageDir SourceDir -> FilePath)
-> SymbolicPath PackageDir SourceDir
-> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir SourceDir -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow) ([SymbolicPath PackageDir SourceDir] -> [Json])
-> [SymbolicPath PackageDir SourceDir] -> [Json]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
  , FilePath
"src-dir"       FilePath -> Json -> (FilePath, Json)
.= FilePath -> Json
JsonString (FilePath -> FilePath
addTrailingPathSeparator FilePath
wdir)
  ] [(FilePath, Json)] -> [(FilePath, Json)] -> [(FilePath, Json)]
forall a. Semigroup a => a -> a -> a
<> [(FilePath, Json)]
cabalFile)
  where
    ([FilePath]
warnings, [FilePath]
compilerArgs) = BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> ([FilePath], [FilePath])
getCompilerArgs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    name :: ComponentName
name = ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi
    bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
comp
    -- If this error happens, a cabal invariant has been violated
    comp :: Component
comp = Component -> Maybe Component -> Component
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Component
forall a. HasCallStack => FilePath -> a
error (FilePath -> Component) -> FilePath -> Component
forall a b. (a -> b) -> a -> b
$ FilePath
"mkBuildInfo: no component " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ComponentName
name) (Maybe Component -> Component) -> Maybe Component -> Component
forall a b. (a -> b) -> a -> b
$ PackageDescription -> ComponentName -> Maybe Component
lookupComponent PackageDescription
pkg_descr ComponentName
name
    compType :: FilePath
compType = case Component
comp of
      CLib Library
_   -> FilePath
"lib"
      CExe Executable
_   -> FilePath
"exe"
      CTest TestSuite
_  -> FilePath
"test"
      CBench Benchmark
_ -> FilePath
"bench"
      CFLib ForeignLib
_  -> FilePath
"flib"
    modules :: [ModuleName]
modules = case Component
comp of
      CLib Library
lib -> Library -> [ModuleName]
explicitLibModules Library
lib
      CExe Executable
exe -> Executable -> [ModuleName]
exeModules Executable
exe
      CTest TestSuite
test ->
        case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
          TestSuiteExeV10 Version
_ FilePath
_ -> []
          TestSuiteLibV09 Version
_ ModuleName
modName -> [ModuleName
modName]
          TestSuiteUnsupported TestType
_ -> []
      CBench Benchmark
bench -> Benchmark -> [ModuleName]
benchmarkModules Benchmark
bench
      CFLib ForeignLib
flib -> ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
    sourceFiles :: [FilePath]
sourceFiles = case Component
comp of
      CLib Library
_   -> []
      CExe Executable
exe -> [Executable -> FilePath
modulePath Executable
exe]
      CTest TestSuite
test ->
        case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
          TestSuiteExeV10 Version
_ FilePath
fp -> [FilePath
fp]
          TestSuiteLibV09 Version
_ ModuleName
_ -> []
          TestSuiteUnsupported TestType
_ -> []
      CBench Benchmark
bench -> case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bench of
        BenchmarkExeV10 Version
_ FilePath
fp -> [FilePath
fp]
        BenchmarkUnsupported BenchmarkType
_ -> []

      CFLib ForeignLib
_ -> []
    cabalFile :: [(FilePath, Json)]
cabalFile
      | Just FilePath
fp <- LocalBuildInfo -> Maybe FilePath
pkgDescrFile LocalBuildInfo
lbi = [(FilePath
"cabal-file", FilePath -> Json
JsonString FilePath
fp)]
      | Bool
otherwise                   = []

-- | Get the command-line arguments that would be passed
-- to the compiler to build the given component.
getCompilerArgs
  :: BuildInfo
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> ([String], [String])
getCompilerArgs :: BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> ([FilePath], [FilePath])
getCompilerArgs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  case Compiler -> CompilerFlavor
compilerFlavor (Compiler -> CompilerFlavor) -> Compiler -> CompilerFlavor
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
      CompilerFlavor
GHC   -> ([], [FilePath]
ghc)
      CompilerFlavor
GHCJS -> ([], [FilePath]
ghc)
      CompilerFlavor
c     ->
        ( [FilePath
"ShowBuildInfo.getCompilerArgs: Don't know how to get build "
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" arguments for compiler " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CompilerFlavor -> FilePath
forall a. Show a => a -> FilePath
show CompilerFlavor
c]
        , [])
  where
    -- This is absolutely awful
    ghc :: [FilePath]
ghc = Compiler -> Platform -> GhcOptions -> [FilePath]
GHC.renderGhcOptions (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) GhcOptions
baseOpts
      where
        baseOpts :: GhcOptions
baseOpts = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
GHC.componentGhcOptions Verbosity
normal LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi)