cuda-0.13.0.0: Setup.hs
-- Decouple from GHC's default language setting, so that it's easier
-- to maintain compatibility with old GHCs.
{-# LANGUAGE Haskell2010 #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
-- The MIN_VERSION_Cabal macro was introduced with Cabal-1.24 (??)
#ifndef MIN_VERSION_Cabal
#define MIN_VERSION_Cabal(major1,major2,minor) 0
#endif
import Distribution.PackageDescription hiding ( Flag )
import Distribution.Simple
import Distribution.Simple.BuildPaths
import Distribution.Simple.Command
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess hiding ( ppC2hs )
import Distribution.Simple.Program
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Find
import Distribution.Simple.Setup
import Distribution.Simple.Utils hiding ( isInfixOf )
import Distribution.System
import Distribution.Verbosity
#if MIN_VERSION_Cabal(1,25,0)
import Distribution.PackageDescription.PrettyPrint
import Distribution.Version
#endif
#if MIN_VERSION_Cabal(2,2,0)
import Distribution.PackageDescription.Parsec
#else
import Distribution.PackageDescription.Parse
#endif
#if MIN_VERSION_Cabal(3,8,0)
import Distribution.Simple.PackageDescription
#endif
#if MIN_VERSION_Cabal(3,14,0)
-- Note [Cabal 3.14]
--
-- If you change any path stuff, either test that the package still works with
-- Cabal 3.12 or stop declaring support for it in cuda.cabal. (If you do the
-- latter, also remove all of the other conditionals in this file.)
-- Note that supporting old versions of Cabal is useful for being able to run
-- e.g. Accelerate on old GPU clusters, which is nice.
import Distribution.Utils.Path (SymbolicPath, FileOrDir(File, Dir), Lib, Include, Pkg, CWD, makeSymbolicPath, interpretSymbolicPath, makeRelativePathEx)
import qualified Distribution.Types.LocalBuildConfig as LBC
#else
#endif
import Control.Exception
import Control.Monad
import Data.Char (isDigit)
import Data.Function
import Data.List
import Data.Maybe
import Data.String (fromString)
import System.Directory
import System.Environment
import System.FilePath
import System.IO.Error
import Text.Printf
import Prelude
-- Configuration
-- -------------
customBuildInfoFilePath :: FilePath
customBuildInfoFilePath = "cuda" <.> "buildinfo"
generatedBuildInfoFilePath :: FilePath
generatedBuildInfoFilePath = customBuildInfoFilePath <.> "generated"
defaultCUDAInstallPath :: Platform -> FilePath
defaultCUDAInstallPath _ = "/usr/local/cuda" -- windows?
-- Build setup
-- -----------
main :: IO ()
main = defaultMainWithHooks customHooks
where
-- Be careful changing flags/paths stuff here; see Note [Cabal 3.14].
readHook get_verbosity a flags = do
getHookedBuildInfo (flagToMaybe (workingDirFlag flags)) (fromFlag (get_verbosity flags))
preprocessors = hookedPreProcessors simpleUserHooks
-- Our readHook implementation uses our getHookedBuildInfo. We can't rely on
-- cabal's autoconfUserHooks since they don't handle user overwrites to
-- buildinfo like we do.
--
customHooks =
simpleUserHooks
{ preBuild = preBuildHook -- not using 'readHook' here because 'build' takes; extra args
, preClean = readHook cleanVerbosity
, preCopy = readHook copyVerbosity
, preInst = readHook installVerbosity
, preHscolour = readHook hscolourVerbosity
, preHaddock = readHook haddockVerbosity
, preReg = readHook regVerbosity
, preUnreg = readHook regVerbosity
, postConf = postConfHook
, hookedPreProcessors = (fromString "chs", ppC2hs) : filter (\x -> fst x /= fromString "chs") preprocessors
}
-- The hook just loads the HookedBuildInfo generated by postConfHook,
-- unless there is user-provided info that overwrites it.
--
preBuildHook :: Args -> BuildFlags -> IO HookedBuildInfo
preBuildHook _ flags = getHookedBuildInfo cwd verbosity
where cwd = flagToMaybe (workingDirFlag flags)
verbosity = fromFlag (buildVerbosity flags)
-- The hook scans system in search for CUDA Toolkit. If the toolkit is not
-- found, an error is raised. Otherwise the toolkit location is used to
-- create a `cuda.buildinfo.generated` file with all the resulting flags.
--
postConfHook :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postConfHook args flags pkg_descr lbi = do
let
cwd = flagToMaybe (workingDirFlag flags)
verbosity = fromFlagOrDefault normal (configVerbosity flags)
profile = fromFlagOrDefault False (configProfLib flags)
currentPlatform = hostPlatform lbi
compilerId_ = compilerId (compiler lbi)
--
generateAndStoreBuildInfo
cwd
verbosity
profile
currentPlatform
compilerId_
(configExtraLibDirs flags)
(configExtraIncludeDirs flags)
generatedBuildInfoFilePath
validateLinker verbosity currentPlatform $ withPrograms lbi
--
actualBuildInfoToUse <- getHookedBuildInfo cwd verbosity
let pkg_descr' = updatePackageDescription actualBuildInfoToUse pkg_descr
postConf simpleUserHooks args flags pkg_descr' lbi
escBackslash :: FilePath -> FilePath
escBackslash [] = []
escBackslash ('\\':fs) = '\\' : '\\' : escBackslash fs
escBackslash (f:fs) = f : escBackslash fs
-- Generates build info with flags needed for CUDA Toolkit to be properly
-- visible to underlying build tools.
--
libraryBuildInfo
:: Maybe CWDPath
-> Verbosity
-> Bool
-> FilePath
-> Platform
-> Version
-> [ExtraLibsPath]
-> [ExtraIncludesPath]
-> IO HookedBuildInfo
libraryBuildInfo cwd verbosity profile installPath platform@(Platform arch os) ghcVersion extraLibs extraIncludes = do
let
-- Be careful changing flags/paths stuff here; see Note [Cabal 3.14].
libraryPaths = map makeSymbolicPath (cudaLibraryPaths platform installPath) ++ extraLibs
includePaths = makeSymbolicPath (cudaIncludePath platform installPath) : extraIncludes
takeFirstExisting paths = do
existing <- filterM (doesDirectoryExist . interpretSymbolicPath cwd) libraryPaths
case existing of
(p0:_) -> return p0
_ -> die' verbosity $ "Could not find path: " ++ show paths
-- This can only be defined once, so take the first path which exists
canonicalLibraryPath <- interpretSymbolicPath cwd <$> takeFirstExisting libraryPaths
let
-- OS-specific escaping for -D path defines
escDefPath | os == Windows = escBackslash
| otherwise = id
-- options for GHC
extraLibDirs' = libraryPaths
ccOptions' = [ "-DCUDA_INSTALL_PATH=\"" ++ escDefPath installPath ++ "\""
, "-DCUDA_LIBRARY_PATH=\"" ++ escDefPath canonicalLibraryPath ++ "\""
] ++ map (("-I" ++) . interpretSymbolicPath cwd) includePaths
ldOptions' = map (("-L" ++) . interpretSymbolicPath cwd) libraryPaths
ghcOptions = map ("-optc"++) ccOptions'
++ map ("-optl"++) ldOptions'
++ if os /= Windows && not profile
then map (("-optl-Wl,-rpath," ++) . interpretSymbolicPath cwd) extraLibDirs'
else []
extraLibs' = cudaLibraries platform
frameworks' = [ makeRelativePathEx "CUDA" | os == OSX ]
frameworkDirs' = [ makeSymbolicPath "/Library/Frameworks" | os == OSX ]
-- options or c2hs
archFlag = case arch of
I386 -> "-m32"
X86_64 -> "-m64"
_ -> ""
emptyCase = ["-DUSE_EMPTY_CASE" | versionBranch ghcVersion >= [7,8]]
blocksExtension = [ "-U__BLOCKS__" | os == OSX ]
c2hsOptions = unwords $ map ("--cppopts="++) ("-E" : archFlag : emptyCase ++ blocksExtension)
c2hsExtraOptions = ("x-extra-c2hs-options", c2hsOptions)
addSystemSpecificOptions :: BuildInfo -> IO BuildInfo
addSystemSpecificOptions bi =
case os of
_ -> return bi
extraGHCiLibs' <- cudaGHCiLibraries platform installPath extraLibs'
buildInfo' <- addSystemSpecificOptions $ emptyBuildInfo
{ ccOptions = ccOptions'
, ldOptions = ldOptions'
, extraLibs = extraLibs'
, extraGHCiLibs = extraGHCiLibs'
, extraLibDirs = extraLibDirs'
, frameworks = frameworks'
, extraFrameworkDirs = frameworkDirs'
#if MIN_VERSION_Cabal(3,0,0)
, options = PerCompilerFlavor (if os /= Windows then ghcOptions else []) []
#else
, options = [(GHC, ghcOptions) | os /= Windows]
#endif
, customFieldsBI = [c2hsExtraOptions]
}
return (Just buildInfo', [])
-- Return the location of the include directory relative to the base CUDA
-- installation.
--
cudaIncludePath :: Platform -> FilePath -> FilePath
cudaIncludePath _ installPath = installPath </> "include"
-- Return the potential locations of the libraries relative to the base CUDA installation.
--
cudaLibraryPaths :: Platform -> FilePath -> [FilePath]
cudaLibraryPaths (Platform arch os) installPath = [ installPath </> path | path <- libpaths ]
where
libpaths =
case (os, arch) of
(Windows, I386) -> ["lib/Win32"]
(Windows, X86_64) -> ["lib/x64"]
(OSX, _) -> ["lib"] -- MacOS does not distinguish 32- vs. 64-bit paths
(_, X86_64) -> ["lib64", "lib"] -- prefer lib64 for 64-bit systems
#if MIN_VERSION_Cabal(2,4,0)
(_, AArch64) -> ["lib64", "lib"]
#endif
_ -> ["lib"] -- otherwise
-- On Windows and OSX we use different libraries depending on whether we are
-- linking statically (executables) or dynamically (ghci).
--
cudaLibraries :: Platform -> [String]
cudaLibraries (Platform _ os) =
case os of
OSX -> ["cudadevrt", "cudart_static"]
_ -> ["cuda"]
cudaGHCiLibraries
:: Platform
-> FilePath
-> [String]
-> IO [String]
cudaGHCiLibraries platform@(Platform _ os) installPath libraries =
case os of
Windows -> cudaGhciLibrariesWindows platform installPath libraries
OSX -> return ["cuda"]
_ -> return []
-- Windows compatibility function.
--
-- The function is used to populate the extraGHCiLibs list on Windows
-- platform. It takes libraries directory and .lib filenames and returns
-- their corresponding dll filename. (Both filenames are stripped from
-- extensions)
--
-- Eg: "C:\cuda\toolkit\lib\x64" -> ["cudart", "cuda"] -> ["cudart64_65", "ncuda"]
--
cudaGhciLibrariesWindows
:: Platform
-> FilePath
-> [FilePath]
-> IO [FilePath]
cudaGhciLibrariesWindows platform installPath libraries = do
candidates <- mapM (importLibraryToDLLFileName platform)
[ libPath </> lib <.> "lib" | libPath <- cudaLibraryPaths platform installPath
, lib <- libraries ]
return [ dropExtension dll | Just dll <- candidates ]
-- Windows compatibility function.
--
-- CUDA toolkit uses different names for import libraries and their
-- respective DLLs. For example, on 32-bit architecture and version 7.0 of
-- toolkit, `cudart.lib` imports functions from `cudart32_70`.
--
-- The ghci linker fails to resolve this. Therefore, it needs to be given
-- the DLL filenames as `extra-ghci-libraries` option.
--
-- This function takes *a path to* import library and returns name of
-- corresponding DLL.
--
-- Eg: "C:/CUDA/Toolkit/Win32/cudart.lib" -> "cudart32_70.dll"
--
-- Internally it assumes that 'nm' tool is present in PATH. This should be
-- always true, as 'nm' is distributed along with GHC.
--
-- The function is meant to be used on Windows. Other platforms may or may
-- not work.
--
importLibraryToDLLFileName :: Platform -> FilePath -> IO (Maybe FilePath)
importLibraryToDLLFileName platform importLibPath = do
-- Sample output nm generates on cudart.lib
--
-- nvcuda.dll:
-- 00000000 i .idata$2
-- 00000000 i .idata$4
-- 00000000 i .idata$5
-- 00000000 i .idata$6
-- 009c9d1b a @comp.id
-- 00000000 I __IMPORT_DESCRIPTOR_nvcuda
-- U __NULL_IMPORT_DESCRIPTOR
-- U nvcuda_NULL_THUNK_DATA
--
nmOutput <- getProgramInvocationOutput normal (simpleProgramInvocation "nm" [importLibPath])
#if MIN_VERSION_Cabal(2,3,0)
return $ find (isInfixOf ("" <.> dllExtension platform)) (lines nmOutput)
#else
return $ find (isInfixOf ("" <.> dllExtension)) (lines nmOutput)
#endif
-- Slightly modified version of `words` from base - it takes predicate saying on
-- which characters split.
--
splitOn :: (Char -> Bool) -> String -> [String]
splitOn p s =
case dropWhile p s of
[] -> []
s' -> let (w, s'') = break p s'
in w : splitOn p s''
-- Tries to obtain the version `ld`. Throws an exception if failed.
--
getLdVersion :: Verbosity -> FilePath -> IO (Maybe [Int])
getLdVersion verbosity ldPath = do
-- Version string format is like `GNU ld (GNU Binutils) 2.25.1`
-- or `GNU ld (GNU Binutils) 2.20.51.20100613`
ldVersionString <- getProgramInvocationOutput normal (simpleProgramInvocation ldPath ["-v"])
let versionText = last $ words ldVersionString -- takes e. g. "2.25.1"
versionParts = splitOn (== '.') versionText
versionParsed = Just $ map read versionParts
-- last and read above may throw and message would be not understandable
-- for user, so we'll intercept exception and rethrow it with more useful
-- message.
handleError :: SomeException -> IO (Maybe [Int])
handleError e = do
warn verbosity $ printf "cannot parse ld version string: `%s`. Parsing exception: `%s`" ldVersionString (show e)
return Nothing
evaluate versionParsed `catch` handleError
-- On Windows GHC package comes with two copies of ld.exe.
--
-- 1. ProgramDb knows about the first one: ghcpath\mingw\bin\ld.exe
-- 2. This function returns the other one: ghcpath\mingw\x86_64-w64-mingw32\bin\ld.exe
--
-- The second one is the one that does actual linking and code generation.
-- See: https://github.com/tmcdonell/cuda/issues/31#issuecomment-149181376
--
-- The function is meant to be used only on 64-bit GHC distributions.
--
getRealLdPath :: Verbosity -> ProgramDb -> IO (Maybe FilePath)
getRealLdPath verbosity programDb =
-- TODO: This should ideally work `programFindVersion ldProgram` but for some
-- reason it does not. The issue should be investigated at some time.
--
case lookupProgram ghcProgram programDb of
Nothing -> return Nothing
Just configuredGhc -> do
let ghcPath = locationPath $ programLocation configuredGhc
presumedLdPath = (takeDirectory . takeDirectory) ghcPath </> "mingw" </> "x86_64-w64-mingw32" </> "bin" </> "ld.exe"
info verbosity $ "Presuming ld location" ++ presumedLdPath
presumedLdExists <- doesFileExist presumedLdPath
return $ if presumedLdExists
then Just presumedLdPath
else Nothing
-- On Windows platform the binutils linker targeting x64 is bugged and cannot
-- properly link with import libraries generated by MS compiler (like the CUDA ones).
-- The programs would correctly compile and crash as soon as the first FFI call is made.
--
-- Therefore we fail configure process if the linker is too old and provide user
-- with guidelines on how to fix the problem.
--
validateLinker :: Verbosity -> Platform -> ProgramDb -> IO ()
validateLinker verbosity (Platform arch os) db =
when (arch == X86_64 && os == Windows) $ do
maybeLdPath <- getRealLdPath verbosity db
case maybeLdPath of
Nothing -> warn verbosity $ "Cannot find ld.exe to check if it is new enough. If generated executables crash when making calls to CUDA, please see " ++ windowsHelpPage
Just ldPath -> do
debug verbosity $ "Checking if ld.exe at " ++ ldPath ++ " is new enough"
maybeVersion <- getLdVersion verbosity ldPath
case maybeVersion of
Nothing -> warn verbosity $ "Unknown ld.exe version. If generated executables crash when making calls to CUDA, please see " ++ windowsHelpPage
Just ldVersion -> do
debug verbosity $ "Found ld.exe version: " ++ show ldVersion
when (ldVersion < [2,25,1]) $ die' verbosity $ windowsLinkerBugMsg ldPath
windowsHelpPage :: String
windowsHelpPage = "https://github.com/tmcdonell/cuda/blob/master/cuda/WINDOWS.md"
windowsLinkerBugMsg :: FilePath -> String
windowsLinkerBugMsg ldPath = printf (unlines msg) windowsHelpPage ldPath
where
msg =
[ "********************************************************************************"
, ""
, "The installed version of `ld.exe` has version < 2.25.1. This version has known bug on Windows x64 architecture, making it unable to correctly link programs using CUDA. The fix is available and MSys2 released fixed version of `ld.exe` as part of their binutils package (version 2.25.1)."
, ""
, "To fix this issue, replace the `ld.exe` in your GHC installation with the correct binary. See the following page for details:"
, ""
, " %s"
, ""
, "The full path to the outdated `ld.exe` detected in your installation:"
, ""
, "> %s"
, ""
, "Please download a recent version of binutils `ld.exe`, from, e.g.:"
, ""
, " http://repo.msys2.org/mingw/x86_64/mingw-w64-x86_64-binutils-2.25.1-1-any.pkg.tar.xz"
, ""
, "********************************************************************************"
]
-- Runs CUDA detection procedure and stores .buildinfo to a file.
--
generateAndStoreBuildInfo
:: Maybe CWDPath
-> Verbosity
-> Bool
-> Platform
-> CompilerId
-> [ExtraLibsPath]
-> [ExtraIncludesPath]
-> FilePath
-> IO ()
generateAndStoreBuildInfo cwd verbosity profile platform (CompilerId _ghcFlavor ghcVersion) extraLibs extraIncludes path = do
installPath <- findCUDAInstallPath verbosity platform
hbi <- libraryBuildInfo cwd verbosity profile installPath platform ghcVersion extraLibs extraIncludes
storeHookedBuildInfo verbosity path hbi
storeHookedBuildInfo
:: Verbosity
-> FilePath
-> HookedBuildInfo
-> IO ()
storeHookedBuildInfo verbosity path hbi = do
notice verbosity $ "Storing parameters to " ++ path
writeHookedBuildInfo path hbi
-- Try to locate CUDA installation by checking (in order):
--
-- 1. CUDA_PATH environment variable
-- 2. Looking for `nvcc` in `PATH`
-- 3. Checking /usr/local/cuda
-- 4. CUDA_PATH_Vx_y environment variable, for recent CUDA toolkit versions x.y
--
-- In case of failure, calls die with the pretty long message from below.
--
findCUDAInstallPath
:: Verbosity
-> Platform
-> IO FilePath
findCUDAInstallPath verbosity platform = do
result <- findFirstValidLocation verbosity platform =<< candidateCUDAInstallPaths verbosity platform
case result of
Just installPath -> do
notice verbosity $ printf "Found CUDA toolkit at: %s (set CUDA_PATH to override this)" installPath
return installPath
Nothing -> die' verbosity cudaNotFoundMsg
cudaNotFoundMsg :: String
cudaNotFoundMsg = unlines
[ "********************************************************************************"
, ""
, "The configuration process failed to locate your CUDA installation. Ensure that you have installed both the developer driver and toolkit, available from:"
, ""
, "> http://developer.nvidia.com/cuda-downloads"
, ""
, "and make sure that `nvcc` is available in your PATH, or set the CUDA_PATH environment variable appropriately. Check the above output log and run the command directly to ensure it can be located."
, ""
, "If you have a non-standard installation, you can add additional search paths using --extra-include-dirs and --extra-lib-dirs. Note that 64-bit Linux flavours often require both `lib64` and `lib` library paths, in that order."
, ""
, "********************************************************************************"
]
-- Function iterates over action yielding possible locations, evaluating them
-- and returning the first valid one. Returns Nothing if no location matches.
--
findFirstValidLocation
:: Verbosity
-> Platform
-> [(IO FilePath, String)]
-> IO (Maybe FilePath)
findFirstValidLocation verbosity platform = go
where
go :: [(IO FilePath, String)] -> IO (Maybe FilePath)
go [] = return Nothing
go (x:xs) = do
let (path,desc) = x
info verbosity $ printf "checking for %s" desc
found <- validateIOLocation verbosity platform path
if found
then fmap Just $ canonicalizePath =<< path
else go xs
-- Evaluates IO to obtain the path, handling any possible exceptions.
-- If path is evaluable and points to valid CUDA toolkit returns True.
--
validateIOLocation
:: Verbosity
-> Platform
-> IO FilePath
-> IO Bool
validateIOLocation verbosity platform iopath =
let handler :: IOError -> IO Bool
handler err = do
info verbosity (show err)
return False
in
(iopath >>= validateLocation verbosity platform) `catch` handler
-- Checks whether given location looks like a valid CUDA toolkit directory
--
validateLocation
:: Verbosity
-> Platform
-> FilePath
-> IO Bool
validateLocation verbosity platform path = do
-- TODO: Ideally this should check for e.g. cuda.lib and whether it exports
-- relevant symbols. This should be achievable with some `nm` trickery
--
let cudaHeader = cudaIncludePath platform path </> "cuda.h"
--
exists <- doesFileExist cudaHeader
info verbosity $
if exists
then printf "Path accepted: %s\n" path
else printf "Path rejected: %s\nDoes not exist: %s\n" path cudaHeader
return exists
-- Returns pairs of (action yielding candidate path, String description of that location)
--
candidateCUDAInstallPaths
:: Verbosity
-> Platform
-> IO [(IO FilePath, String)]
candidateCUDAInstallPaths verbosity platform = do
let defaults =
[ (getEnv "CUDA_PATH", "environment variable CUDA_PATH")
, (findInPath, "nvcc compiler executable in PATH")
, (return defaultPath, printf "default install location (%s)" defaultPath)
]
verVars <- versionedVars
return $ defaults ++ verVars
where
findInPath :: IO FilePath
findInPath = do
nvccPath <- findProgramLocationOrError verbosity "nvcc"
-- The obtained path is likely TOOLKIT/bin/nvcc. We want to extract the
-- TOOLKIT part
return (takeDirectory $ takeDirectory nvccPath)
defaultPath :: FilePath
defaultPath = defaultCUDAInstallPath platform
versionedVars :: IO [(IO FilePath, String)]
versionedVars = do
pairs <- getEnvironment
let sorted = sort (mapMaybe (\(k, v) -> (,k,v) <$> parseCudaPathVerVar k) pairs)
return [(return v, "environment variable " ++ k) | (_, k, v) <- sorted]
parseCudaPathVerVar :: String -> Maybe (Int, Int)
parseCudaPathVerVar var
| ("CUDA_PATH_V", s1) <- splitAt 11 var
, (n1, '_':n2) <- span isDigit s1, not (null n1)
, all isDigit n2, not (null n2)
= Just (read n1, read n2)
| otherwise
= Nothing
-- NOTE: this function throws an exception when there is no `nvcc` in PATH.
-- The exception contains a meaningful message.
--
findProgramLocationOrError
:: Verbosity
-> String
-> IO FilePath
findProgramLocationOrError verbosity execName = do
location <- findProgram verbosity execName
case location of
Just path -> return path
Nothing -> ioError $ mkIOError doesNotExistErrorType ("not found: " ++ execName) Nothing Nothing
findProgram
:: Verbosity
-> FilePath
-> IO (Maybe FilePath)
findProgram verbosity prog = do
result <- findProgramOnSearchPath verbosity defaultProgramSearchPath prog
#if MIN_VERSION_Cabal(1,25,0)
return (fmap fst result)
#else
$( case withinRange cabalVersion (orLaterVersion (Version [1,24] [])) of
True -> [| return (fmap fst result) |]
False -> [| return result |]
)
#endif
-- Reads user-provided `cuda.buildinfo` if present, otherwise loads `cuda.buildinfo.generated`
-- Outputs message informing about the other possibility.
-- Calls die when neither of the files is available.
-- (generated one should be always present, as it is created in the post-conf step)
--
getHookedBuildInfo
:: Maybe CWDPath
-> Verbosity
-> IO HookedBuildInfo
getHookedBuildInfo cwd verbosity = do
doesCustomBuildInfoExists <- doesFileExist (customBuildInfoFilePath)
if doesCustomBuildInfoExists
then do
notice verbosity $ printf "The user-provided buildinfo from file %s will be used. To use default settings, delete this file.\n" customBuildInfoFilePath
readHookedBuildInfoWithCWD verbosity cwd (makeSymbolicPath customBuildInfoFilePath)
else do
doesGeneratedBuildInfoExists <- doesFileExist generatedBuildInfoFilePath
if doesGeneratedBuildInfoExists
then do
notice verbosity $ printf "Using build information from '%s'.\n" generatedBuildInfoFilePath
notice verbosity $ printf "Provide a '%s' file to override this behaviour.\n" customBuildInfoFilePath
readHookedBuildInfoWithCWD verbosity cwd (makeSymbolicPath generatedBuildInfoFilePath)
else
die' verbosity $ printf "Unexpected failure. Neither the default %s nor custom %s exist.\n" generatedBuildInfoFilePath customBuildInfoFilePath
-- Replicate the default C2HS preprocessor hook here, and inject a value for
-- extra-c2hs-options, if it was present in the buildinfo file
--
-- Everything below copied from Distribution.Simple.PreProcess
--
#if MIN_VERSION_Cabal(1,25,0)
ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs bi lbi _clbi
#else
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppC2hs bi lbi
#endif
= PreProcessor {
platformIndependent = False,
#if MIN_VERSION_Cabal(3,8,0)
ppOrdering = unsorted,
#endif
runPreProcessor = \(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity ->
runDbProgram verbosity c2hsProgram (withPrograms lbi) . filter (not . null) $
maybe [] words (lookup "x-extra-c2hs-options" (customFieldsBI bi))
++ ["--include=" ++ outBaseDir]
++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]
++ ["--output-dir=" ++ outBaseDir,
"--output=" ++ outRelativeFile,
inBaseDir </> inRelativeFile]
}
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
getCppOptions bi lbi
= hcDefines (compiler lbi)
++ ["-I" ++ interpretSymbolicPath (lbiCWD lbi) dir | dir <- includeDirs bi]
++ [opt | opt@('-':c:_) <- ccOptions bi, c `elem` "DIU"]
hcDefines :: Compiler -> [String]
hcDefines comp =
case compilerFlavor comp of
GHC -> ["-D__GLASGOW_HASKELL__=" ++ versionInt version]
JHC -> ["-D__JHC__=" ++ versionInt version]
NHC -> ["-D__NHC__=" ++ versionInt version]
Hugs -> ["-D__HUGS__"]
_ -> []
where version = compilerVersion comp
-- TODO: move this into the compiler abstraction
-- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all the other
-- compilers. Check if that's really what they want.
versionInt :: Version -> String
versionInt v =
case versionBranch v of
[] -> "1"
[n] -> show n
n1:n2:_ -> printf "%d%02d" n1 n2
#if MIN_VERSION_Cabal(1,25,0)
versionBranch :: Version -> [Int]
versionBranch = versionNumbers
#endif
#if !MIN_VERSION_Cabal(2,0,0)
die' :: Verbosity -> String -> IO a
die' _ = die
#endif
-- Compatibility across Cabal 3.14 symbolic paths.
-- If we want to drop pre-Cabal-3.14 compatibility at some point, this should all be merged in above.
lbiCWD :: LocalBuildInfo -> Maybe CWDPath
#if MIN_VERSION_Cabal(3,14,0)
type ExtraLibsPath = SymbolicPath Pkg ('Dir Lib)
type ExtraIncludesPath = SymbolicPath Pkg ('Dir Include)
type CWDPath = SymbolicPath CWD ('Dir Pkg)
regVerbosity :: RegisterFlags -> Flag Verbosity
regVerbosity = setupVerbosity . registerCommonFlags
workingDirFlag :: HasCommonFlags flags => flags -> Flag CWDPath
workingDirFlag = setupWorkingDir . getCommonFlags
lbiCWD = flagToMaybe . setupWorkingDir . configCommonFlags . LBC.configFlags . LBC.packageBuildDescr . localBuildDescr
-- makeSymbolicPath is an actual useful function in Cabal 3.14
-- makeRelativePathEx is an actual useful function in Cabal 3.14
-- interpretSymbolicPath is an actual useful function in Cabal 3.14
class HasCommonFlags flags where getCommonFlags :: flags -> CommonSetupFlags
instance HasCommonFlags BuildFlags where getCommonFlags = buildCommonFlags
instance HasCommonFlags CleanFlags where getCommonFlags = cleanCommonFlags
instance HasCommonFlags ConfigFlags where getCommonFlags = configCommonFlags
instance HasCommonFlags CopyFlags where getCommonFlags = copyCommonFlags
instance HasCommonFlags InstallFlags where getCommonFlags = installCommonFlags
instance HasCommonFlags HscolourFlags where getCommonFlags = hscolourCommonFlags
instance HasCommonFlags HaddockFlags where getCommonFlags = haddockCommonFlags
instance HasCommonFlags RegisterFlags where getCommonFlags = registerCommonFlags
readHookedBuildInfoWithCWD :: Verbosity -> Maybe CWDPath -> SymbolicPath Pkg 'File -> IO HookedBuildInfo
readHookedBuildInfoWithCWD = readHookedBuildInfo
#else
type ExtraLibsPath = FilePath
type ExtraIncludesPath = FilePath
type CWDPath = ()
-- regVerbosity is still present as an actual field in Cabal 3.12
workingDirFlag :: flags -> Flag CWDPath
workingDirFlag _ = NoFlag
lbiCWD _ = Nothing
makeSymbolicPath :: FilePath -> FilePath
makeSymbolicPath = id
makeRelativePathEx :: FilePath -> FilePath
makeRelativePathEx = id
interpretSymbolicPath :: Maybe CWDPath -> FilePath -> FilePath
interpretSymbolicPath _ = id
readHookedBuildInfoWithCWD :: Verbosity -> Maybe CWDPath -> FilePath -> IO HookedBuildInfo
readHookedBuildInfoWithCWD verb _ path = readHookedBuildInfo verb path
#endif