    -- |
    -- 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 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
    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
    import Distribution.Utils.Path

    -- | 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
    $ (SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [String])
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> a -> b
    $ BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    bi)
          ]
          where
            bi :: BuildInfo
    bi = Component -> BuildInfo
    componentBuildInfo Component
    comp
            comp :: Component
    comp = Component -> Maybe Component -> Component
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Component
    forall a. HasCallStack => String -> a
    error (String -> Component) -> String -> Component
    forall a b. (a -> b) -> a -> b
    $ String
    "mkBuildInfo: no component " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ComponentName -> String
    forall a. Pretty a => a -> String
    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 :: 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)