{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Distribution.Simple.Toolkit (
userHooksWithBuildInfo
, simpleUserHooksWithBuildInfo
, defaultMainWithBuildInfo
, packageDescriptionQ
, packageDescriptionTypedQ
, localBuildInfoQ
, localBuildInfoTypedQ
, getComponentInstallDirs
, getComponentBuildInfo
, getGHCLibDir
, runLBIProgram
, getLBIProgramOutput
, getGHCPackageDBFlags
, cmakeProgram
, makeProgram
, ninjaProgram
) where
import Data.Binary
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.Map as Map
import Data.List (intercalate)
import Distribution.Text
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup
#if !MIN_VERSION_Cabal(2,0,0)
import qualified Distribution.Simple.InstallDirs as InstallDirs
#endif
import Distribution.System
import Distribution.PackageDescription
import Distribution.Verbosity
import DynFlags
import Language.Haskell.TH.Syntax
import System.IO.Unsafe
userHooksWithBuildInfo :: UserHooks -> UserHooks
userHooksWithBuildInfo h =
h
{ postConf =
\args flags pkg_descr lbi -> do
encodeFile ".pkg_descr.buildinfo" pkg_descr
encodeFile ".lbi.buildinfo" lbi
postConf h args flags pkg_descr lbi
}
simpleUserHooksWithBuildInfo :: UserHooks
simpleUserHooksWithBuildInfo = userHooksWithBuildInfo simpleUserHooks
defaultMainWithBuildInfo :: IO ()
defaultMainWithBuildInfo = defaultMainWithHooks simpleUserHooksWithBuildInfo
syringe :: FilePath -> Q Type -> Q Exp
syringe p t = do
addDependentFile p
buf <- runIO $ LBS.readFile p
[|unsafePerformIO $ do
bs <-
BS.unsafePackAddressLen
$(lift $ LBS.length buf)
$(pure $ LitE $ StringPrimL $ LBS.unpack buf)
pure ((decode $ LBS.fromStrict bs) :: $(t))|]
packageDescriptionQ :: Q Exp
packageDescriptionQ = syringe ".pkg_descr.buildinfo" [t|PackageDescription|]
packageDescriptionTypedQ :: Q (TExp PackageDescription)
packageDescriptionTypedQ = unsafeTExpCoerce packageDescriptionQ
localBuildInfoQ :: Q Exp
localBuildInfoQ = syringe ".lbi.buildinfo" [t|LocalBuildInfo|]
localBuildInfoTypedQ :: Q (TExp LocalBuildInfo)
localBuildInfoTypedQ = unsafeTExpCoerce localBuildInfoQ
#if !MIN_VERSION_Cabal(2,0,0)
absoluteComponentInstallDirs
:: PackageDescription -> LocalBuildInfo
-> UnitId
-> CopyDest
-> InstallDirs FilePath
absoluteComponentInstallDirs pkg lbi uid copydest =
InstallDirs.absoluteInstallDirs
(packageId pkg)
uid
(Distribution.Simple.compilerInfo (compiler lbi))
copydest
(hostPlatform lbi)
(installDirTemplates lbi)
#endif
#if MIN_VERSION_Cabal(3,0,0)
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
getComponentLocalBuildInfo lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just [clbi] -> clbi
Just clbis ->
error $ "internal error: the component name " ++ show cname
++ "is ambiguous. Refers to: "
++ intercalate ", " (fmap (display . componentUnitId) clbis)
Nothing ->
error $ "internal error: there is no configuration data "
++ "for component " ++ show cname
#endif
getComponentInstallDirs ::
PackageDescription
-> LocalBuildInfo
-> ComponentName
-> InstallDirs FilePath
getComponentInstallDirs pkg_descr lbi k =
absoluteComponentInstallDirs
pkg_descr
lbi
(componentUnitId $ getComponentLocalBuildInfo lbi k)
NoCopyDest
getComponentBuildInfo :: PackageDescription -> ComponentName -> BuildInfo
getComponentBuildInfo pkg_descr k =
componentBuildInfo $ getComponent pkg_descr k
getGHCLibDir :: LocalBuildInfo -> FilePath
getGHCLibDir lbi = compilerProperties (compiler lbi) Map.! "LibDir"
runLBIProgram :: LocalBuildInfo -> Program -> [ProgArg] -> IO ()
runLBIProgram lbi prog =
runDbProgram
(fromFlagOrDefault normal $ configVerbosity $ configFlags lbi)
prog
(withPrograms lbi)
getLBIProgramOutput :: LocalBuildInfo -> Program -> [ProgArg] -> IO String
getLBIProgramOutput lbi prog =
getDbProgramOutput
(fromFlagOrDefault normal $ configVerbosity $ configFlags lbi)
prog
(withPrograms lbi)
#if MIN_VERSION_Cabal(2,0,0)
getGHCPackageDBFlags :: LocalBuildInfo -> [PackageDBFlag]
getGHCPackageDBFlags lbi =
reverse $
case withPackageDB lbi of
(GlobalPackageDB:UserPackageDB:dbs)
| all isSpecific dbs -> fmap single dbs
(GlobalPackageDB:dbs)
| all isSpecific dbs -> NoUserPackageDB : fmap single dbs
dbs -> ClearPackageDBs : fmap single dbs
where
single (SpecificPackageDB db) = PackageDB $ PkgConfFile db
single GlobalPackageDB = PackageDB GlobalPkgConf
single UserPackageDB = PackageDB UserPkgConf
isSpecific (SpecificPackageDB _) = True
isSpecific _ = False
#else
getGHCPackageDBFlags :: LocalBuildInfo -> [PkgConfRef]
getGHCPackageDBFlags = reverse . fmap toPkgConfRef . withPackageDB
where
toPkgConfRef (SpecificPackageDB db) = PkgConfFile db
toPkgConfRef GlobalPackageDB = GlobalPkgConf
toPkgConfRef UserPackageDB = UserPkgConf
#endif
endOfFirstLineVersion :: Verbosity -> FilePath -> IO (Maybe Version)
endOfFirstLineVersion =
findProgramVersion "--version" $ last . words . head . lines
cmakeProgram :: Program
cmakeProgram =
(simpleProgram "cmake") {programFindVersion = endOfFirstLineVersion}
makeProgram :: Program
makeProgram =
(simpleProgram $
case buildOS of
Windows -> "mingw32-make"
_ -> "make")
{programFindVersion = endOfFirstLineVersion}
ninjaProgram :: Program
ninjaProgram =
(simpleProgram "ninja")
{programFindVersion = findProgramVersion "--version" id}