Commit f1e949d4 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Move Paths_pkgname and cabal_macros.h generation into their own modules

parent 7ea70262
......@@ -62,6 +62,8 @@ Library
Distribution.ReadE,
Distribution.Simple,
Distribution.Simple.Build,
Distribution.Simple.Build.Macros,
Distribution.Simple.Build.PathsModule,
Distribution.Simple.BuildPaths,
Distribution.Simple.Command,
Distribution.Simple.Compiler,
......
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Build
-- Copyright : Isaac Jones 2003-2005
-- Copyright : Isaac Jones 2003-2005,
-- Ross Paterson 2006,
-- Duncan Coutts 2007-2008
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
......@@ -16,10 +18,6 @@
-- we'd like to kill off and replace with something better (doing our own
-- dependency analysis properly).
--
-- Half the module is dedicated to generating the @Paths_@/pkgname/ module.
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their version number and find any installed data files
-- at runtime. This code should probably be split off into another module.
{- Copyright (c) 2003-2005, Isaac Jones
All rights reserved.
......@@ -53,52 +51,53 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.Build (
build, makefile, initialBuildSteps
build,
makefile,
initialBuildSteps,
writeAutogenFiles,
) where
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.Build.Macros as Build.Macros
import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
import Distribution.Package
( Package(..) )
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..),
Executable(..), Library(..) )
import Distribution.Package
( PackageIdentifier, Package(..), packageName, packageVersion )
( PackageDescription(..), BuildInfo(..)
, Executable(..), Library(..), hasLibs )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Setup ( CopyDest(..), BuildFlags(..),
MakefileFlags(..), fromFlag )
import Distribution.Simple.PreProcess ( preprocessSources, PPSuffixHandler )
import Distribution.Simple.Setup
( BuildFlags(..), MakefileFlags(..), fromFlag )
import Distribution.Simple.PreProcess
( preprocessSources, PPSuffixHandler )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..),
InstallDirs(..), absoluteInstallDirs,
prefixRelativeInstallDirs )
( LocalBuildInfo(compiler, buildDir) )
import Distribution.Simple.BuildPaths
( autogenModulesDir, autogenModuleName,
cppHeaderName )
import Distribution.Simple.Configure
( localBuildInfoFile )
( autogenModulesDir, autogenModuleName, cppHeaderName )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, die, setupMessage, writeUTF8File )
import Distribution.System
import Distribution.Version ( Version(versionBranch) )
( createDirectoryIfMissingVerbose, die, setupMessage, rewriteFile )
import System.FilePath ( (</>), (<.>), pathSeparator )
import Data.Maybe ( maybeToList, fromJust, isNothing )
import Control.Monad ( unless, when )
import System.Directory ( getModificationTime, doesFileExist )
import Text.Printf ( printf, PrintfType, HPrintfType,
PrintfArg, IsChar )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import Distribution.PackageDescription (hasLibs)
import Distribution.Verbosity
( Verbosity )
import Distribution.Text
( display )
import Data.Maybe
( maybeToList )
import Control.Monad
( unless, when )
import System.FilePath
( (</>), (<.>) )
-- -----------------------------------------------------------------------------
-- |Build the libraries and executables in this package.
......@@ -142,7 +141,7 @@ initialBuildSteps :: FilePath -- ^"dist" prefix
-> Verbosity -- ^The verbosity to use
-> [ PPSuffixHandler ] -- ^preprocessors to run before compiling
-> IO ()
initialBuildSteps distPref pkg_descr lbi verbosity suffixes = do
initialBuildSteps _distPref pkg_descr lbi verbosity suffixes = do
-- check that there's something to build
let buildInfos =
map libBuildInfo (maybeToList (library pkg_descr)) ++
......@@ -153,244 +152,22 @@ initialBuildSteps distPref pkg_descr lbi verbosity suffixes = do
createDirectoryIfMissingVerbose verbosity True (buildDir lbi)
-- construct and write the Paths_<pkg>.hs file
createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
buildPathsModule distPref pkg_descr lbi
buildCPPHeader distPref pkg_descr lbi
writeAutogenFiles verbosity pkg_descr lbi
preprocessSources pkg_descr lbi False verbosity suffixes
-- ------------------------------------------------------------
-- * Building cabal_macros.h
-- ------------------------------------------------------------
buildCPPHeader :: FilePath -> PackageDescription -> LocalBuildInfo -> IO ()
buildCPPHeader distPref _pkg_descr lbi =
let
cpp_header_filepath = autogenModulesDir lbi </> cppHeaderName
preface = "/* DO NOT EDIT: This file is automatically generated by Cabal */"
version_macro :: PackageIdentifier -> String
version_macro pkgid =
printf ("#define MIN_VERSION_%s(major1,major2,minor) \\\n" ++
" (major1) < %d || \\\n" ++
" (major1) == %d && (major2) < %d || \\\n" ++
" (major1) == %d && (major2) == %d && (minor) <= %d")
(display (packageName pkgid)) major1
major1 major2
major1 major2 minor
where
vs = versionBranch (packageVersion pkgid)
(major1:major2:minor:_) = vs ++ repeat 0
contents = unlines (preface : map version_macro (packageDeps lbi))
in do
btime <- getModificationTime (localBuildInfoFile distPref)
exists <- doesFileExist cpp_header_filepath
ptime <- if exists
then getModificationTime cpp_header_filepath
else return btime
if btime >= ptime
then writeFile cpp_header_filepath contents
else return ()
-- ------------------------------------------------------------
-- * Building Paths_<pkg>.hs
-- ------------------------------------------------------------
buildPathsModule :: FilePath -> PackageDescription -> LocalBuildInfo -> IO ()
buildPathsModule distPref pkg_descr lbi =
let pragmas
| absolute || isHugs = ""
| otherwise =
"{-# LANGUAGE ForeignFunctionInterface #-}\n" ++
"{-# OPTIONS_GHC -fffi #-}\n"++
"{-# OPTIONS_JHC -fffi #-}\n"
foreign_imports
| absolute = ""
| isHugs = "import System.Environment\n"
| otherwise =
"import Foreign\n"++
"import Foreign.C\n"
header =
pragmas++
"module " ++ display paths_modulename ++ " (\n"++
" version,\n"++
" getBinDir, getLibDir, getDataDir, getLibexecDir,\n"++
" getDataFileName\n"++
" ) where\n"++
"\n"++
foreign_imports++
"import Data.Version (Version(..))\n"++
"import System.Environment (getEnv)"++
"\n"++
"\nversion :: Version"++
"\nversion = " ++ show (packageVersion pkg_descr)++
"\n"
body
| absolute =
"\nbindir, libdir, datadir, libexecdir :: FilePath\n"++
"\nbindir = " ++ show flat_bindir ++
"\nlibdir = " ++ show flat_libdir ++
"\ndatadir = " ++ show flat_datadir ++
"\nlibexecdir = " ++ show flat_libexecdir ++
"\n"++
"\ngetBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath\n"++
"getBinDir = "++mkGetEnvOr "bindir" "return bindir"++"\n"++
"getLibDir = "++mkGetEnvOr "libdir" "return libdir"++"\n"++
"getDataDir = "++mkGetEnvOr "datadir" "return datadir"++"\n"++
"getLibexecDir = "++mkGetEnvOr "libexecdir" "return libexecdir"++"\n"++
"\n"++
"getDataFileName :: FilePath -> IO FilePath\n"++
"getDataFileName name = do\n"++
" dir <- getDataDir\n"++
" return (dir ++ "++path_sep++" ++ name)\n"
| otherwise =
"\nprefix, bindirrel :: FilePath" ++
"\nprefix = " ++ show flat_prefix ++
"\nbindirrel = " ++ show (fromJust flat_bindirrel) ++
"\n\n"++
"getBinDir :: IO FilePath\n"++
"getBinDir = getPrefixDirRel bindirrel\n\n"++
"getLibDir :: IO FilePath\n"++
"getLibDir = "++mkGetDir flat_libdir flat_libdirrel++"\n\n"++
"getDataDir :: IO FilePath\n"++
"getDataDir = "++ mkGetEnvOr "datadir"
(mkGetDir flat_datadir flat_datadirrel)++"\n\n"++
"getLibexecDir :: IO FilePath\n"++
"getLibexecDir = "++mkGetDir flat_libexecdir flat_libexecdirrel++"\n\n"++
"getDataFileName :: FilePath -> IO FilePath\n"++
"getDataFileName name = do\n"++
" dir <- getDataDir\n"++
" return (dir `joinFileName` name)\n"++
"\n"++
get_prefix_stuff++
"\n"++
filename_stuff
in do btime <- getModificationTime (localBuildInfoFile distPref)
exists <- doesFileExist paths_filepath
ptime <- if exists
then getModificationTime paths_filepath
else return btime
if btime >= ptime
then writeUTF8File paths_filepath (header++body)
else return ()
where
InstallDirs {
prefix = flat_prefix,
bindir = flat_bindir,
libdir = flat_libdir,
datadir = flat_datadir,
libexecdir = flat_libexecdir
} = absoluteInstallDirs pkg_descr lbi NoCopyDest
InstallDirs {
bindir = flat_bindirrel,
libdir = flat_libdirrel,
datadir = flat_datadirrel,
libexecdir = flat_libexecdirrel,
progdir = flat_progdirrel
} = prefixRelativeInstallDirs pkg_descr lbi
mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel
mkGetDir dir Nothing = "return " ++ show dir
mkGetEnvOr var expr = "catch (getEnv \""++var'++"\")"++
" (\\_ -> "++expr++")"
where var' = display (packageName pkg_descr) ++ "_" ++ var
-- In several cases we cannot make relocatable installations
absolute =
hasLibs pkg_descr -- we can only make progs relocatable
|| isNothing flat_bindirrel -- if the bin dir is an absolute path
|| not (supportsRelocatableProgs (compilerFlavor (compiler lbi)))
supportsRelocatableProgs Hugs = True
supportsRelocatableProgs GHC = case buildOS of
Windows -> True
_ -> False
supportsRelocatableProgs _ = False
paths_modulename = autogenModuleName pkg_descr
paths_filename = ModuleName.toFilePath paths_modulename <.> "hs"
paths_filepath = autogenModulesDir lbi </> paths_filename
isHugs = compilerFlavor (compiler lbi) == Hugs
get_prefix_stuff
| isHugs = "progdirrel :: String\n"++
"progdirrel = "++show (fromJust flat_progdirrel)++"\n\n"++
get_prefix_hugs
| otherwise = get_prefix_win32
path_sep = show [pathSeparator]
get_prefix_win32 :: String
get_prefix_win32 =
"getPrefixDirRel :: FilePath -> IO FilePath\n"++
"getPrefixDirRel dirRel = do \n"++
" let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
" buf <- mallocArray len\n"++
" ret <- getModuleFileName nullPtr buf len\n"++
" if ret == 0 \n"++
" then do free buf;\n"++
" return (prefix `joinFileName` dirRel)\n"++
" else do exePath <- peekCString buf\n"++
" free buf\n"++
" let (bindir,_) = splitFileName exePath\n"++
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
"\n"++
"foreign import stdcall unsafe \"windows.h GetModuleFileNameA\"\n"++
" getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"
-- | Generate and write out the Paths_<pkg>.hs and cabal_macros.h files
--
writeAutogenFiles :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> IO ()
writeAutogenFiles verbosity pkg lbi = do
createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
get_prefix_hugs :: String
get_prefix_hugs =
"getPrefixDirRel :: FilePath -> IO FilePath\n"++
"getPrefixDirRel dirRel = do\n"++
" mainPath <- getProgName\n"++
" let (progPath,_) = splitFileName mainPath\n"++
" let (progdir,_) = splitFileName progPath\n"++
" return ((progdir `minusFileName` progdirrel) `joinFileName` dirRel)\n"
let pathsModulePath = autogenModulesDir lbi
</> ModuleName.toFilePath (autogenModuleName pkg) <.> "hs"
rewriteFile pathsModulePath (Build.PathsModule.generate pkg lbi)
filename_stuff :: String
filename_stuff =
"minusFileName :: FilePath -> String -> FilePath\n"++
"minusFileName dir \"\" = dir\n"++
"minusFileName dir \".\" = dir\n"++
"minusFileName dir suffix =\n"++
" minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))\n"++
"\n"++
"joinFileName :: String -> String -> FilePath\n"++
"joinFileName \"\" fname = fname\n"++
"joinFileName \".\" fname = fname\n"++
"joinFileName dir \"\" = dir\n"++
"joinFileName dir fname\n"++
" | isPathSeparator (last dir) = dir++fname\n"++
" | otherwise = dir++pathSeparator:fname\n"++
"\n"++
"splitFileName :: FilePath -> (String, String)\n"++
"splitFileName p = (reverse (path2++drive), reverse fname)\n"++
" where\n"++
" (path,drive) = case p of\n"++
" (c:':':p') -> (reverse p',[':',c])\n"++
" _ -> (reverse p ,\"\")\n"++
" (fname,path1) = break isPathSeparator path\n"++
" path2 = case path1 of\n"++
" [] -> \".\"\n"++
" [_] -> path1 -- don't remove the trailing slash if \n"++
" -- there is only one character\n"++
" (c:path') | isPathSeparator c -> path'\n"++
" _ -> path1\n"++
"\n"++
"pathSeparator :: Char\n"++
(case buildOS of
Windows -> "pathSeparator = '\\\\'\n"
_ -> "pathSeparator = '/'\n") ++
"\n"++
"isPathSeparator :: Char -> Bool\n"++
(case buildOS of
Windows -> "isPathSeparator c = c == '/' || c == '\\\\'\n"
_ -> "isPathSeparator c = c == '/'\n")
let cppHeaderPath = autogenModulesDir lbi </> cppHeaderName
rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi)
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Build.Macros
-- Copyright : Simon Marlow 2008
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Generate cabal_macros.h - CPP macros for package version testing
--
-- When using CPP you get
--
-- > MIN_VERSION_<package>(A,B,C)
--
-- for each /package/ in @build-depends@, which is true if the version of
-- /package/ in use is @>= A.B.C@, using the normal ordering on version
-- numbers.
--
module Distribution.Simple.Build.Macros (
generate
) where
import Distribution.Package
( PackageIdentifier(PackageIdentifier) )
import Distribution.Version
( Version(versionBranch) )
import Distribution.PackageDescription
( PackageDescription )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(packageDeps) )
import Distribution.Text
( display )
-- ------------------------------------------------------------
-- * Generate cabal_macros.h
-- ------------------------------------------------------------
generate :: PackageDescription -> LocalBuildInfo -> String
generate _pkg_descr lbi = concat $
"/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" :
[ concat
["/* package ",display pkgid," */\n"
,"#define MIN_VERSION_",display name,"(major1,major2,minor) \\\n"
," (major1) < ",major1," || \\\n"
," (major1) == ",major1," && (major2) < ",major2," || \\\n"
," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor
,"\n\n"
]
| pkgid@(PackageIdentifier name version) <- packageDeps lbi
, let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
]
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Build.Macros
-- Copyright : Isaac Jones 2003-2005,
-- Ross Paterson 2006,
-- Duncan Coutts 2007-2008
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Generating the Paths_pkgname module.
--
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their version number and find any installed data files
-- at runtime. This code should probably be split off into another module.
--
module Distribution.Simple.Build.PathsModule (
generate
) where
import Distribution.System
( OS(Windows), buildOS )
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.Package
( packageName, packageVersion )
import Distribution.PackageDescription
( PackageDescription(..), hasLibs )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), InstallDirs(..)
, absoluteInstallDirs, prefixRelativeInstallDirs )
import Distribution.Simple.Setup ( CopyDest(NoCopyDest) )
import Distribution.Simple.BuildPaths
( autogenModuleName )
import Distribution.Text
( display )
import System.FilePath
( pathSeparator )
import Data.Maybe
( fromJust, isNothing )
-- ------------------------------------------------------------
-- * Building Paths_<pkg>.hs
-- ------------------------------------------------------------
generate :: PackageDescription -> LocalBuildInfo -> String
generate pkg_descr lbi =
let pragmas
| absolute || isHugs = ""
| otherwise =
"{-# LANGUAGE ForeignFunctionInterface #-}\n" ++
"{-# OPTIONS_GHC -fffi #-}\n"++
"{-# OPTIONS_JHC -fffi #-}\n"
foreign_imports
| absolute = ""
| isHugs = "import System.Environment\n"
| otherwise =
"import Foreign\n"++
"import Foreign.C\n"
header =
pragmas++
"module " ++ display paths_modulename ++ " (\n"++
" version,\n"++
" getBinDir, getLibDir, getDataDir, getLibexecDir,\n"++
" getDataFileName\n"++
" ) where\n"++
"\n"++
foreign_imports++
"import Data.Version (Version(..))\n"++
"import System.Environment (getEnv)"++
"\n"++
"\nversion :: Version"++
"\nversion = " ++ show (packageVersion pkg_descr)++
"\n"
body
| absolute =
"\nbindir, libdir, datadir, libexecdir :: FilePath\n"++
"\nbindir = " ++ show flat_bindir ++
"\nlibdir = " ++ show flat_libdir ++
"\ndatadir = " ++ show flat_datadir ++
"\nlibexecdir = " ++ show flat_libexecdir ++
"\n"++
"\ngetBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath\n"++
"getBinDir = "++mkGetEnvOr "bindir" "return bindir"++"\n"++
"getLibDir = "++mkGetEnvOr "libdir" "return libdir"++"\n"++
"getDataDir = "++mkGetEnvOr "datadir" "return datadir"++"\n"++
"getLibexecDir = "++mkGetEnvOr "libexecdir" "return libexecdir"++"\n"++
"\n"++
"getDataFileName :: FilePath -> IO FilePath\n"++
"getDataFileName name = do\n"++
" dir <- getDataDir\n"++
" return (dir ++ "++path_sep++" ++ name)\n"
| otherwise =
"\nprefix, bindirrel :: FilePath" ++
"\nprefix = " ++ show flat_prefix ++
"\nbindirrel = " ++ show (fromJust flat_bindirrel) ++
"\n\n"++
"getBinDir :: IO FilePath\n"++
"getBinDir = getPrefixDirRel bindirrel\n\n"++
"getLibDir :: IO FilePath\n"++
"getLibDir = "++mkGetDir flat_libdir flat_libdirrel++"\n\n"++
"getDataDir :: IO FilePath\n"++
"getDataDir = "++ mkGetEnvOr "datadir"
(mkGetDir flat_datadir flat_datadirrel)++"\n\n"++
"getLibexecDir :: IO FilePath\n"++
"getLibexecDir = "++mkGetDir flat_libexecdir flat_libexecdirrel++"\n\n"++
"getDataFileName :: FilePath -> IO FilePath\n"++
"getDataFileName name = do\n"++
" dir <- getDataDir\n"++
" return (dir `joinFileName` name)\n"++
"\n"++
get_prefix_stuff++
"\n"++
filename_stuff
in header++body
where
InstallDirs {
prefix = flat_prefix,
bindir = flat_bindir,
libdir = flat_libdir,
datadir = flat_datadir,
libexecdir = flat_libexecdir
} = absoluteInstallDirs pkg_descr lbi NoCopyDest
InstallDirs {
bindir = flat_bindirrel,
libdir = flat_libdirrel,
datadir = flat_datadirrel,
libexecdir = flat_libexecdirrel,
progdir = flat_progdirrel
} = prefixRelativeInstallDirs pkg_descr lbi
mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel
mkGetDir dir Nothing = "return " ++ show dir
mkGetEnvOr var expr = "catch (getEnv \""++var'++"\")"++
" (\\_ -> "++expr++")"
where var' = display (packageName pkg_descr) ++ "_" ++ var
-- In several cases we cannot make relocatable installations
absolute =
hasLibs pkg_descr -- we can only make progs relocatable
|| isNothing flat_bindirrel -- if the bin dir is an absolute path
|| not (supportsRelocatableProgs (compilerFlavor (compiler lbi)))
supportsRelocatableProgs Hugs = True
supportsRelocatableProgs GHC = case buildOS of
Windows -> True
_ -> False
supportsRelocatableProgs _ = False
paths_modulename = autogenModuleName pkg_descr
isHugs = compilerFlavor (compiler lbi) == Hugs
get_prefix_stuff
| isHugs = "progdirrel :: String\n"++
"progdirrel = "++show (fromJust flat_progdirrel)++"\n\n"++
get_prefix_hugs
| otherwise = get_prefix_win32
path_sep = show [pathSeparator]
get_prefix_win32 :: String
get_prefix_win32 =
"getPrefixDirRel :: FilePath -> IO FilePath\n"++
"getPrefixDirRel dirRel = do \n"++
" let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
" buf <- mallocArray len\n"++
" ret <- getModuleFileName nullPtr buf len\n"++
" if ret == 0 \n"++
" then do free buf;\n"++
" return (prefix `joinFileName` dirRel)\n"++
" else do exePath <- peekCString buf\n"++
</