module Distribution.Simple.PreProcess (preprocessSources, knownSuffixHandlers,
ppSuffixes, PPSuffixHandler, PreProcessor(..),
mkSimplePreProcessor, runSimplePreProcessor,
ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
ppHappy, ppAlex, ppUnlit
)
where
import Distribution.Simple.PreProcess.Unlit (unlit)
import Distribution.Package
( Package(..), PackageName(..) )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..), withExe
, Library(..), withLib, libModules )
import qualified Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo_(..) )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion )
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, die, setupMessage, intercalate, copyFileVerbose
, findFileWithExtension, findFileWithExtension' )
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), lookupProgram, programPath
, rawSystemProgramConf, rawSystemProgram
, greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram
, happyProgram, alexProgram, haddockProgram, ghcProgram, gccProgram )
import Distribution.System
( OS(OSX, Windows), buildOS )
import Distribution.Version (Version(..))
import Distribution.Verbosity
import Distribution.Text
( display )
import Control.Monad (when, unless)
import Data.Maybe (fromMaybe)
import Data.List (nub)
import System.Directory (getModificationTime, doesFileExist)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
takeDirectory, normalise, replaceExtension)
data PreProcessor = PreProcessor {
platformIndependent :: Bool,
runPreProcessor :: (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()
}
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath) -> Verbosity -> IO ()
mkSimplePreProcessor simplePP
(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity = simplePP inFile outFile verbosity
where inFile = normalise (inBaseDir </> inRelativeFile)
outFile = normalise (outBaseDir </> outRelativeFile)
runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity
-> IO ()
runSimplePreProcessor pp inFile outFile verbosity =
runPreProcessor pp (".", inFile) (".", outFile) verbosity
type PPSuffixHandler
= (String, BuildInfo -> LocalBuildInfo -> PreProcessor)
preprocessSources :: PackageDescription
-> LocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessSources pkg_descr lbi forSDist verbosity handlers = do
withLib pkg_descr $ \ lib -> do
setupMessage verbosity "Preprocessing library" (packageId pkg_descr)
let bi = libBuildInfo lib
let biHandlers = localHandlers bi
sequence_ [ preprocessModule (hsSourceDirs bi ++ [autogenModulesDir lbi]) (buildDir lbi) forSDist
modu verbosity builtinSuffixes biHandlers
| modu <- libModules lib ]
unless (null (executables pkg_descr)) $
setupMessage verbosity "Preprocessing executables for" (packageId pkg_descr)
withExe pkg_descr $ \ theExe -> do
let bi = buildInfo theExe
let biHandlers = localHandlers bi
let exeDir = buildDir lbi </> exeName theExe </> exeName theExe ++ "-tmp"
sequence_ [ preprocessModule (hsSourceDirs bi ++ [autogenModulesDir lbi]) exeDir forSDist
modu verbosity builtinSuffixes biHandlers
| modu <- otherModules bi]
preprocessModule (hsSourceDirs bi) exeDir forSDist
(ModuleName.simple (dropExtensions (modulePath theExe)))
verbosity builtinSuffixes biHandlers
where hc = compilerFlavor (compiler lbi)
builtinSuffixes
| hc == NHC = ["hs", "lhs", "gc"]
| otherwise = ["hs", "lhs"]
localHandlers bi = [(ext, h bi lbi) | (ext, h) <- handlers]
preprocessModule
:: [FilePath]
-> FilePath
-> Bool
-> ModuleName
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessModule searchLoc buildLoc forSDist modu verbosity builtinSuffixes handlers = do
psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc
(ModuleName.toFilePath modu)
case psrcFiles of
Nothing -> do
bsrcFiles <- findFileWithExtension builtinSuffixes searchLoc
(ModuleName.toFilePath modu)
case bsrcFiles of
Nothing -> die $ "can't find source for " ++ display modu
++ " in " ++ intercalate ", " searchLoc
_ -> return ()
Just (psrcLoc, psrcRelFile) -> do
let (srcStem, ext) = splitExtension psrcRelFile
psrcFile = psrcLoc </> psrcRelFile
pp = fromMaybe (error "Internal error in preProcess module: Just expected")
(lookup (tailNotNull ext) handlers)
when (not forSDist || forSDist && platformIndependent pp) $ do
ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc]
(ModuleName.toFilePath modu)
recomp <- case ppsrcFiles of
Nothing -> return True
Just ppsrcFile -> do
btime <- getModificationTime ppsrcFile
ptime <- getModificationTime psrcFile
return (btime < ptime)
when recomp $ do
let destDir = buildLoc </> dirName srcStem
createDirectoryIfMissingVerbose verbosity True destDir
runPreProcessor pp
(psrcLoc, psrcRelFile)
(buildLoc, srcStem <.> "hs") verbosity
where dirName = takeDirectory
tailNotNull [] = []
tailNotNull x = tail x
ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppGreenCard _ lbi
= PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemProgramConf verbosity greencardProgram (withPrograms lbi)
(["-tffi", "-o" ++ outFile, inFile])
}
ppUnlit :: PreProcessor
ppUnlit =
PreProcessor {
platformIndependent = True,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity ->
withUTF8FileContents inFile $ \contents ->
either (writeUTF8File outFile) die (unlit inFile contents)
}
ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpp = ppCpp' []
ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpp' extraArgs bi lbi =
case compilerFlavor (compiler lbi) of
GHC -> ppGhcCpp (cppArgs ++ extraArgs) bi lbi
_ -> ppCpphs (cppArgs ++ extraArgs) bi lbi
where cppArgs = sysDefines ++ cppOptions bi ++ getCppOptions bi lbi
sysDefines =
["-D" ++ os ++ "_" ++ loc ++ "_OS" | loc <- locations] ++
["-D" ++ arch ++ "_" ++ loc ++ "_ARCH" | loc <- locations]
locations = ["BUILD", "HOST"]
ppGhcCpp :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppGhcCpp extraArgs _bi lbi =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemProgram verbosity ghcProg $
["-E", "-cpp"]
++ (if ghcVersion >= Version [6,6] [] then ["-x", "hs"] else [])
++ (if use_optP_P lbi then ["-optP-P"] else [])
++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
++ ["-o", outFile, inFile]
++ extraArgs
}
where Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
Just ghcVersion = programVersion ghcProg
ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpphs extraArgs _bi lbi =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemProgram verbosity cpphsProg $
("-O" ++ outFile) : inFile
: "--noline" : "--strip"
: (if cpphsVersion >= Version [1,6] []
then ["--include="++ (autogenModulesDir lbi </> cppHeaderName)]
else [])
++ extraArgs
}
where Just cpphsProg = lookupProgram cpphsProgram (withPrograms lbi)
Just cpphsVersion = programVersion cpphsProg
use_optP_P :: LocalBuildInfo -> Bool
use_optP_P lbi
= case lookupProgram haddockProgram (withPrograms lbi) of
Just (ConfiguredProgram { programVersion = Just version })
| version >= Version [0,8] [] -> False
_ -> True
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi = standardPP lbi hsc2hsProgram $
[ "--cc=" ++ programPath gccProg
, "--ld=" ++ programPath gccProg ]
++ [ "--cflag=" ++ opt | opt <- programArgs gccProg ]
++ [ "--lflag=" ++ opt | opt <- programArgs gccProg ]
++ [ what ++ "=-F" ++ opt
| isOSX
, opt <- nub (concatMap Installed.frameworkDirs pkgs)
, what <- ["--cflag", "--lflag"] ]
++ [ "--lflag=" ++ arg
| isOSX
, opt <- PD.frameworks bi ++ concatMap Installed.frameworks pkgs
, arg <- ["-framework", opt] ]
++ [ "--cflag=" ++ opt | opt <- hcDefines (compiler lbi) ]
++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs bi ]
++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi
++ PD.cppOptions bi ]
++ [ "--lflag=-L" ++ opt | opt <- PD.extraLibDirs bi ]
++ [ "--lflag=-Wl,-R," ++ opt | isELF
, opt <- PD.extraLibDirs bi ]
++ [ "--lflag=-l" ++ opt | opt <- PD.extraLibs bi ]
++ [ "--lflag=" ++ opt | opt <- PD.ldOptions bi ]
++ [ "--cflag=" ++ opt
| pkg <- pkgs
, opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ]
++ [ opt | opt <- Installed.ccOptions pkg ] ]
++ [ "--lflag=" ++ opt
| pkg <- pkgs
, opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ]
++ [ "-Wl,-R," ++ opt | isELF
, opt <- Installed.libraryDirs pkg ]
++ [ "-l" ++ opt | opt <- Installed.extraLibraries pkg ]
++ [ opt | opt <- Installed.ldOptions pkg ] ]
where
pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
Just gccProg = lookupProgram gccProgram (withPrograms lbi)
isOSX = case buildOS of OSX -> True; _ -> False
isELF = case buildOS of OSX -> False; Windows -> False; _ -> True;
packageHacks = case compilerFlavor (compiler lbi) of
GHC -> hackRtsPackage
_ -> id
hackRtsPackage index =
case PackageIndex.lookupPackageName index (PackageName "rts") of
[(_, [rts])]
-> PackageIndex.insert rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppC2hs bi lbi
= PreProcessor {
platformIndependent = False,
runPreProcessor = \(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity ->
rawSystemProgramConf verbosity c2hsProgram (withPrograms lbi) $
["--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" ++ dir | dir <- PD.includeDirs bi]
++ [opt | opt@('-':c:_) <- PD.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
versionInt :: Version -> String
versionInt (Version { versionBranch = [] }) = "1"
versionInt (Version { versionBranch = [n] }) = show n
versionInt (Version { versionBranch = n1:n2:_ })
=
let s1 = show n1
s2 = show n2
middle = case s2 of
_ : _ : _ -> ""
_ -> "0"
in s1 ++ middle ++ s2
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi = pp { platformIndependent = True }
where pp = standardPP lbi happyProgram (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-agc"]
hcFlags _ = []
ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppAlex _ lbi = pp { platformIndependent = True }
where pp = standardPP lbi alexProgram (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-g"]
hcFlags _ = []
standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
standardPP lbi prog args =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
do rawSystemProgramConf verbosity prog (withPrograms lbi)
(args ++ ["-o", outFile, inFile])
let inBoot = replaceExtension inFile "hs-boot"
outBoot = replaceExtension outFile "hs-boot"
exists <- doesFileExist inBoot
when exists $ copyFileVerbose verbosity inBoot outBoot
}
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes = map fst
knownSuffixHandlers :: [ PPSuffixHandler ]
knownSuffixHandlers =
[ ("gc", ppGreenCard)
, ("chs", ppC2hs)
, ("hsc", ppHsc2hs)
, ("x", ppAlex)
, ("y", ppHappy)
, ("ly", ppHappy)
, ("cpphs", ppCpp)
]