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.PackageDescription (PackageDescription(..),
BuildInfo(..), Executable(..), withExe,
Library(..), withLib, libModules)
import Distribution.Package
( Package(..) )
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion )
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.BuildPaths (autogenModulesDir)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, readUTF8File, writeUTF8File
, die, setupMessage, intercalate
, findFileWithExtension, findFileWithExtension', dotToSep )
import Distribution.Simple.Program (Program(..), ConfiguredProgram(..),
lookupProgram, programPath,
rawSystemProgramConf, rawSystemProgram,
greencardProgram, cpphsProgram, hsc2hsProgram,
c2hsProgram, happyProgram, alexProgram,
haddockProgram, ghcProgram)
import Distribution.Version (Version(..))
import Distribution.Verbosity
import Distribution.Text
( display )
import Control.Monad (when, unless, join)
import Data.Maybe (fromMaybe)
import System.Directory (getModificationTime)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
takeDirectory, normalise)
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 pkg_descr]
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
(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
-> String
-> Verbosity
-> [String]
-> [(String, PreProcessor)]
-> IO ()
preprocessModule searchLoc buildLoc forSDist modu verbosity builtinSuffixes handlers = do
psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc (dotToSep modu)
case psrcFiles of
Nothing -> do
bsrcFiles <- findFileWithExtension builtinSuffixes searchLoc (dotToSep modu)
case bsrcFiles of
Nothing -> die ("can't find source for " ++ 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] (dotToSep 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 -> do
contents <- readUTF8File inFile
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 [])
++ ["-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 ->
rawSystemProgramConf verbosity cpphsProgram (withPrograms lbi) $
("-O" ++ outFile) : inFile
: "--noline" : "--strip"
: extraArgs
}
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 = pp
where pp = standardPP lbi hsc2hsProgram flags
flags = case fmap versionTags . join . fmap programVersion
. lookupProgram hsc2hsProgram . withPrograms $ lbi of
Just ["ghc"] ->
let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
in [ "--cc=" ++ programPath ghcProg
, "--ld=" ++ programPath ghcProg ]
++ [ "--cflag=-optc" ++ opt | opt <- ccOptions bi
++ cppOptions bi ]
++ [ "--cflag=" ++ opt | pkg <- packageDeps lbi
, opt <- ["-package"
,display pkg] ]
++ [ "--cflag=-I" ++ dir | dir <- includeDirs bi]
++ [ "--lflag=-optl" ++ opt | opt <- getLdOptions bi ]
_ -> [ "--cflag=" ++ opt | opt <- hcDefines (compiler lbi) ]
++ [ "--cflag=" ++ opt | opt <- ccOptions bi ]
++ [ "--cflag=-I" ++ dir | dir <- includeDirs bi ]
++ [ "--lflag=" ++ opt | opt <- getLdOptions bi ]
getLdOptions :: BuildInfo -> [String]
getLdOptions bi = map ("-L" ++) (extraLibDirs bi)
++ map ("-l" ++) (extraLibs bi)
++ ldOptions bi
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 <- 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
versionInt :: Version -> String
versionInt (Version { versionBranch = [] }) = "1"
versionInt (Version { versionBranch = [n] }) = show n
versionInt (Version { versionBranch = n1:n2:_ })
= show n1 ++ take 2 ('0' : show n2)
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 ->
rawSystemProgramConf verbosity prog (withPrograms lbi)
(args ++ ["-o", outFile, inFile])
}
ppSuffixes :: [ PPSuffixHandler ] -> [String]
ppSuffixes = map fst
knownSuffixHandlers :: [ PPSuffixHandler ]
knownSuffixHandlers =
[ ("gc", ppGreenCard)
, ("chs", ppC2hs)
, ("hsc", ppHsc2hs)
, ("x", ppAlex)
, ("y", ppHappy)
, ("ly", ppHappy)
, ("cpphs", ppCpp)
]