{-# LANGUAGE OverloadedStrings, PackageImports #-}

module HsDev.Tools.Ghc.System (
	BuildInfo(..), buildInfo,
	examineCompilerVersion,

	formatBuildPath, buildPath
	) where

import Control.Arrow
import qualified Data.Map as M
import Data.Maybe
import Data.Version (showVersion)
import Distribution.System (buildOS)
import Distribution.Text (display)
import qualified System.Info as Sys
import Text.Format

import "ghc" DynFlags (DynFlags)
import "ghc" PackageConfig as GHC
import "ghc" GHC (getSessionDynFlags)

import HsDev.Tools.Ghc.Compat as Compat
import HsDev.Tools.Ghc.Worker (GhcM)

data BuildInfo = BuildInfo {
	BuildInfo -> String
targetArch :: String,
	BuildInfo -> String
targetOS :: String,
	BuildInfo -> String
cabalOS :: String,
	BuildInfo -> String
compilerName :: String,
	BuildInfo -> String
compilerVersion :: String }

buildInfo :: DynFlags -> BuildInfo
buildInfo :: DynFlags -> BuildInfo
buildInfo = String -> String -> String -> String -> String -> BuildInfo
BuildInfo String
Sys.arch String
Sys.os (OS -> String
forall a. Pretty a => a -> String
display OS
buildOS) String
Sys.compilerName (String -> BuildInfo)
-> (DynFlags -> String) -> DynFlags -> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> String
examineCompilerVersion

examineCompilerVersion :: DynFlags -> String
examineCompilerVersion :: DynFlags -> String
examineCompilerVersion =
	Version -> String
showVersion (Version -> String) -> (DynFlags -> Version) -> DynFlags -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
Sys.compilerVersion (Maybe Version -> Version)
-> (DynFlags -> Maybe Version) -> DynFlags -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	String -> Map String Version -> Maybe Version
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
Sys.compilerName (Map String Version -> Maybe Version)
-> (DynFlags -> Map String Version) -> DynFlags -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	[(String, Version)] -> Map String Version
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Version)] -> Map String Version)
-> (DynFlags -> [(String, Version)])
-> DynFlags
-> Map String Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	(PackageConfig -> (String, Version))
-> [PackageConfig] -> [(String, Version)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageConfig -> String
GHC.packageNameString (PackageConfig -> String)
-> (PackageConfig -> Version) -> PackageConfig -> (String, Version)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
GHC.packageVersion) ([PackageConfig] -> [(String, Version)])
-> (DynFlags -> [PackageConfig]) -> DynFlags -> [(String, Version)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	[PackageConfig] -> Maybe [PackageConfig] -> [PackageConfig]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [PackageConfig] -> [PackageConfig])
-> (DynFlags -> Maybe [PackageConfig])
-> DynFlags
-> [PackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Maybe [PackageConfig]
Compat.pkgDatabase

-- | Can contain {arch}, {os}/{platform}, {compiler}, {version}
formatBuildPath :: String -> BuildInfo -> String
formatBuildPath :: String -> BuildInfo -> String
formatBuildPath String
f = String -> [FormatArg] -> String
forall r. FormatResult r => String -> [FormatArg] -> r
formats String
f ([FormatArg] -> String)
-> (BuildInfo -> [FormatArg]) -> BuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [FormatArg]
toArgs where
	toArgs :: BuildInfo -> [FormatArg]
toArgs BuildInfo
b = [
		String
"arch" String -> String -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% BuildInfo -> String
targetArch BuildInfo
b,
		String
"os" String -> String -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% BuildInfo -> String
targetOS BuildInfo
b,
		String
"os/cabal" String -> String -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% BuildInfo -> String
cabalOS BuildInfo
b,
		String
"compiler" String -> String -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% BuildInfo -> String
compilerName BuildInfo
b,
		String
"version" String -> String -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% BuildInfo -> String
compilerVersion BuildInfo
b]

buildPath :: String -> GhcM FilePath
buildPath :: String -> GhcM String
buildPath String
f = (DynFlags -> String)
-> MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
-> GhcM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> BuildInfo -> String
formatBuildPath String
f (BuildInfo -> String)
-> (DynFlags -> BuildInfo) -> DynFlags -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> BuildInfo
buildInfo) MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags