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
mkBuildInfo
:: PackageDescription
-> LocalBuildInfo
-> BuildFlags
-> [TargetInfo]
-> Json
mkBuildInfo :: PackageDescription
-> LocalBuildInfo -> BuildFlags -> [TargetInfo] -> Json
mkBuildInfo pkg_descr :: PackageDescription
pkg_descr lbi :: LocalBuildInfo
lbi _flags :: BuildFlags
_flags targetsToBuild :: [TargetInfo]
targetsToBuild = Json
info
where
targetToNameAndLBI :: TargetInfo -> (ComponentName, ComponentLocalBuildInfo)
targetToNameAndLBI target :: 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)
k :: String
k .= :: String -> Json -> (String, Json)
.= v :: Json
v = (String
k, Json
v)
info :: Json
info = [(String, Json)] -> Json
JsonObject
[ "cabal-version" String -> Json -> (String, Json)
.= String -> Json
JsonString (Version -> String
forall a. Pretty a => a -> String
display Version
cabalVersion)
, "compiler" String -> Json -> (String, Json)
.= Json
mkCompilerInfo
, "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
[ "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)
, "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)
, "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 GHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcProgram
flavorToProgram GHCJS = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
ghcjsProgram
flavorToProgram UHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
uhcProgram
flavorToProgram JHC = Program -> Maybe Program
forall a. a -> Maybe a
Just Program
jhcProgram
flavorToProgram _ = Maybe Program
forall a. Maybe a
Nothing
mkComponentInfo :: (ComponentName, ComponentLocalBuildInfo) -> Json
mkComponentInfo (name :: ComponentName
name, clbi :: ComponentLocalBuildInfo
clbi) = [(String, Json)] -> Json
JsonObject
[ "type" String -> Json -> (String, Json)
.= String -> Json
JsonString String
compType
, "name" String -> Json -> (String, Json)
.= String -> Json
JsonString (ComponentName -> String
forall a. Pretty a => a -> String
prettyShow ComponentName
name)
, "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)
, "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)
, "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)
, "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)
, "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 comp :: Component
comp = PackageDescription -> ComponentName -> Maybe Component
lookupComponent PackageDescription
pkg_descr ComponentName
name
compType :: String
compType = case Component
comp of
CLib _ -> "lib"
CExe _ -> "exe"
CTest _ -> "test"
CBench _ -> "bench"
CFLib _ -> "flib"
modules :: [ModuleName]
modules = case Component
comp of
CLib lib :: Library
lib -> Library -> [ModuleName]
explicitLibModules Library
lib
CExe exe :: Executable
exe -> Executable -> [ModuleName]
exeModules Executable
exe
_ -> []
sourceFiles :: [String]
sourceFiles = case Component
comp of
CLib _ -> []
CExe exe :: Executable
exe -> [Executable -> String
modulePath Executable
exe]
_ -> []
getCompilerArgs
:: BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> [String]
getCompilerArgs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
getCompilerArgs bi :: BuildInfo
bi lbi :: LocalBuildInfo
lbi clbi :: ComponentLocalBuildInfo
clbi =
case Compiler -> CompilerFlavor
compilerFlavor (Compiler -> CompilerFlavor) -> Compiler -> CompilerFlavor
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
GHC -> [String]
ghc
GHCJS -> [String]
ghc
c :: CompilerFlavor
c -> String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ "ShowBuildInfo.getCompilerArgs: Don't know how to get "String -> String -> String
forall a. [a] -> [a] -> [a]
++
"build arguments for compiler "String -> String -> String
forall a. [a] -> [a] -> [a]
++CompilerFlavor -> String
forall a. Show a => a -> String
show CompilerFlavor
c
where
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)