-- |
-- 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 new-show-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-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 @cabal-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.
--

module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where

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
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Simple.Utils.Json
import Distribution.Types.TargetInfo
import Distribution.Text
import Distribution.Pretty

-- | Construct a JSON document describing the build information for a
-- package.
mkBuildInfo
  :: PackageDescription  -- ^ Mostly information from the .cabal file
  -> LocalBuildInfo      -- ^ Configuration information
  -> BuildFlags          -- ^ Flags that the user passed to build
  -> [TargetInfo]
  -> Json
mkBuildInfo :: PackageDescription
-> LocalBuildInfo -> BuildFlags -> [TargetInfo] -> Json
mkBuildInfo PackageDescription
pkg_descr LocalBuildInfo
lbi BuildFlags
_flags [TargetInfo]
targetsToBuild = Json
info
  where
    targetToNameAndLBI :: TargetInfo -> (ComponentName, ComponentLocalBuildInfo)
targetToNameAndLBI TargetInfo
target =
      (ComponentLocalBuildInfo -> ComponentName
componentLocalName (ComponentLocalBuildInfo -> ComponentName)
-> ComponentLocalBuildInfo -> ComponentName
forall a b. (a -> b) -> a -> b
$ TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target, TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
    componentsToBuild :: [(ComponentName, ComponentLocalBuildInfo)]
componentsToBuild = (TargetInfo -> (ComponentName, ComponentLocalBuildInfo))
-> [TargetInfo] -> [(ComponentName, ComponentLocalBuildInfo)]
forall a b. (a -> b) -> [a] -> [b]
map TargetInfo -> (ComponentName, ComponentLocalBuildInfo)
targetToNameAndLBI [TargetInfo]
targetsToBuild
    (.=) :: String -> Json -> (String, Json)
    String
k .= :: String -> Json -> (String, Json)
.= Json
v = (String
k, Json
v)

    info :: Json
info = [(String, Json)] -> Json
JsonObject
      [ String
"cabal-version" String -> Json -> (String, Json)
.= String -> Json
JsonString (Version -> String
forall a. Pretty a => a -> String
display Version
cabalVersion)
      , String
"compiler"      String -> Json -> (String, Json)
.= Json
mkCompilerInfo
      , String
"components"    String -> Json -> (String, Json)
.= [Json] -> Json
JsonArray (((ComponentName, ComponentLocalBuildInfo) -> Json)
-> [(ComponentName, ComponentLocalBuildInfo)] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentName, ComponentLocalBuildInfo) -> Json
mkComponentInfo [(ComponentName, ComponentLocalBuildInfo)]
componentsToBuild)
      ]

    mkCompilerInfo :: Json
mkCompilerInfo = [(String, Json)] -> Json
JsonObject
      [ String
"flavour"     String -> Json -> (String, Json)
.= String -> Json
JsonString (CompilerFlavor -> String
forall a. Pretty a => a -> String
prettyShow (CompilerFlavor -> String) -> CompilerFlavor -> String
forall a b. (a -> b) -> a -> b
$ Compiler -> CompilerFlavor
compilerFlavor (Compiler -> CompilerFlavor) -> Compiler -> CompilerFlavor
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
      , String
"compiler-id" String -> Json -> (String, Json)
.= String -> Json
JsonString (Compiler -> String
showCompilerId (Compiler -> String) -> Compiler -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
      , String
"path"        String -> Json -> (String, Json)
.= Json
path
      ]
      where
        path :: Json
path = Json
-> (ConfiguredProgram -> Json) -> Maybe ConfiguredProgram -> Json
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Json
JsonNull (String -> Json
JsonString (String -> Json)
-> (ConfiguredProgram -> String) -> ConfiguredProgram -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredProgram -> String
programPath)
               (Maybe ConfiguredProgram -> Json)
-> Maybe ConfiguredProgram -> Json
forall a b. (a -> b) -> a -> b
$ (CompilerFlavor -> Maybe Program
flavorToProgram (CompilerFlavor -> Maybe Program)
-> (Compiler -> CompilerFlavor) -> Compiler -> Maybe Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerFlavor
compilerFlavor (Compiler -> Maybe Program) -> Compiler -> Maybe Program
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
               Maybe Program
-> (Program -> Maybe ConfiguredProgram) -> Maybe ConfiguredProgram
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Program -> ProgramDb -> Maybe ConfiguredProgram)
-> ProgramDb -> Program -> Maybe ConfiguredProgram
forall a b c. (a -> b -> c) -> b -> a -> c
flip Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)

        flavorToProgram :: CompilerFlavor -> Maybe Program
        flavorToProgram :: CompilerFlavor -> Maybe Program
flavorToProgram CompilerFlavor
GHC   = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcProgram
        flavorToProgram CompilerFlavor
GHCJS = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcjsProgram
        flavorToProgram CompilerFlavor
UHC   = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
uhcProgram
        flavorToProgram CompilerFlavor
JHC   = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
jhcProgram
        flavorToProgram CompilerFlavor
_     = Maybe Program
forall a. Maybe a
Nothing

    mkComponentInfo :: (ComponentName, ComponentLocalBuildInfo) -> Json
mkComponentInfo (ComponentName
name, ComponentLocalBuildInfo
clbi) = [(String, Json)] -> Json
JsonObject
      [ String
"type"          String -> Json -> (String, Json)
.= String -> Json
JsonString String
compType
      , String
"name"          String -> Json -> (String, Json)
.= String -> Json
JsonString (ComponentName -> String
forall a. Pretty a => a -> String
prettyShow ComponentName
name)
      , String
"unit-id"       String -> Json -> (String, Json)
.= String -> Json
JsonString (UnitId -> String
forall a. Pretty a => a -> String
prettyShow (UnitId -> String) -> UnitId -> String
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)
      , String
"compiler-args" String -> Json -> (String, Json)
.= [Json] -> Json
JsonArray ((String -> Json) -> [String] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map String -> Json
JsonString ([String] -> [Json]) -> [String] -> [Json]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
getCompilerArgs BuildInfo
bi LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)
      , String
"modules"       String -> Json -> (String, Json)
.= [Json] -> Json
JsonArray ((ModuleName -> Json) -> [ModuleName] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Json
JsonString (String -> Json) -> (ModuleName -> String) -> ModuleName -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
forall a. Pretty a => a -> String
display) [ModuleName]
modules)
      , String
"src-files"     String -> Json -> (String, Json)
.= [Json] -> Json
JsonArray ((String -> Json) -> [String] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map String -> Json
JsonString [String]
sourceFiles)
      , String
"src-dirs"      String -> Json -> (String, Json)
.= [Json] -> Json
JsonArray ((String -> Json) -> [String] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map String -> Json
JsonString ([String] -> [Json]) -> [String] -> [Json]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
hsSourceDirs BuildInfo
bi)
      ]
      where
        bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
comp
        Just Component
comp = PackageDescription -> ComponentName -> Maybe Component
lookupComponent PackageDescription
pkg_descr ComponentName
name
        compType :: String
compType = case Component
comp of
          CLib Library
_   -> String
"lib"
          CExe Executable
_   -> String
"exe"
          CTest TestSuite
_  -> String
"test"
          CBench Benchmark
_ -> String
"bench"
          CFLib ForeignLib
_  -> String
"flib"
        modules :: [ModuleName]
modules = case Component
comp of
          CLib Library
lib -> Library -> [ModuleName]
explicitLibModules Library
lib
          CExe Executable
exe -> Executable -> [ModuleName]
exeModules Executable
exe
          Component
_        -> []
        sourceFiles :: [String]
sourceFiles = case Component
comp of
          CLib Library
_   -> []
          CExe Executable
exe -> [Executable -> String
modulePath Executable
exe]
          Component
_        -> []

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