module Distribution.Simple.Build.PathsModule (
generatePathsModule, pkgPathEnvVar
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.System
import Distribution.Simple.Compiler
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Pretty
import Distribution.Version
import System.FilePath ( pathSeparator )
generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generatePathsModule :: PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> String
generatePathsModule PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
let pragmas :: String
pragmas =
String
cpp_pragma
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
no_rebindable_syntax_pragma
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ffi_pragmas
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
warning_pragmas
cpp_pragma :: String
cpp_pragma
| Bool
supports_cpp = String
"{-# LANGUAGE CPP #-}\n"
| Bool
otherwise = String
""
no_rebindable_syntax_pragma :: String
no_rebindable_syntax_pragma
| Bool
supports_rebindable_syntax = String
"{-# LANGUAGE NoRebindableSyntax #-}\n"
| Bool
otherwise = String
""
ffi_pragmas :: String
ffi_pragmas
| Bool
absolute = String
""
| Bool
supports_language_pragma =
String
"{-# LANGUAGE ForeignFunctionInterface #-}\n"
| Bool
otherwise =
String
"{-# OPTIONS_GHC -fffi #-}\n"
warning_pragmas :: String
warning_pragmas =
String
"{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"
foreign_imports :: String
foreign_imports
| Bool
absolute = String
""
| Bool
otherwise =
String
"import Foreign\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Foreign.C\n"
reloc_imports :: String
reloc_imports
| Bool
reloc =
String
"import System.Environment (getExecutablePath)\n"
| Bool
otherwise = String
""
header :: String
header =
String
pragmasString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
paths_modulename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" version,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" getDataFileName, getSysconfDir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" ) where\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
foreign_importsString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import qualified Control.Exception as Exception\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Data.Version (Version(..))\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import System.Environment (getEnv)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
reloc_imports String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Prelude\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
(if Bool
supports_cpp
then
(String
"#if defined(VERSION_base)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#if MIN_VERSION_base(4,0,0)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n")
else
String
"catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"catchIO = Exception.catch\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"version :: Version"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nversion = Version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
branch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" []"
where branch :: [Int]
branch = Version -> [Int]
versionNumbers (Version -> [Int]) -> Version -> [Int]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg_descr
body :: String
body
| Bool
reloc =
String
"\n\nbindirrel :: FilePath\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"bindirrel = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_bindirreloc String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\ngetBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getBinDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"bindir" String
flat_bindirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"libdir" String
flat_libdirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDynLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"libdir" String
flat_dynlibdirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"datadir" String
flat_datadirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibexecDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"libexecdir" String
flat_libexecdirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getSysconfDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOrReloc String
"sysconfdir" String
flat_sysconfdirrelocString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName :: FilePath -> IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName name = do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" dir <- getDataDir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" return (dir `joinFileName` name)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
get_prefix_reloc_stuffString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
filename_stuff
| Bool
absolute =
String
"\nbindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nbindir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_bindir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nlibdir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_libdir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\ndynlibdir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_dynlibdir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\ndatadir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_datadir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nlibexecdir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_libexecdir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nsysconfdir = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_sysconfdir String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\ngetBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getBinDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"bindir" String
"return bindir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"libdir" String
"return libdir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDynLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"dynlibdir" String
"return dynlibdir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"datadir" String
"return datadir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibexecDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"libexecdir" String
"return libexecdir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getSysconfDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String -> String
mkGetEnvOr String
"sysconfdir" String
"return sysconfdir"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName :: FilePath -> IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName name = do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" dir <- getDataDir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" return (dir ++ "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
path_sepString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" ++ name)\n"
| Bool
otherwise =
String
"\nprefix, bindirrel :: FilePath" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nprefix = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
flat_prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nbindirrel = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error String
"PathsModule.generate") Maybe String
flat_bindirrel) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getBinDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getBinDir = getPrefixDirRel bindirrel\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> Maybe String -> String
forall a a. (Show a, Show a) => a -> Maybe a -> String
mkGetDir String
flat_libdir Maybe String
flat_libdirrelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDynLibDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDynLibDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> Maybe String -> String
forall a a. (Show a, Show a) => a -> Maybe a -> String
mkGetDir String
flat_dynlibdir Maybe String
flat_dynlibdirrelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
mkGetEnvOr String
"datadir"
(String -> Maybe String -> String
forall a a. (Show a, Show a) => a -> Maybe a -> String
mkGetDir String
flat_datadir Maybe String
flat_datadirrel)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibexecDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getLibexecDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> Maybe String -> String
forall a a. (Show a, Show a) => a -> Maybe a -> String
mkGetDir String
flat_libexecdir Maybe String
flat_libexecdirrelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getSysconfDir :: IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getSysconfDir = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> Maybe String -> String
forall a a. (Show a, Show a) => a -> Maybe a -> String
mkGetDir String
flat_sysconfdir Maybe String
flat_sysconfdirrelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName :: FilePath -> IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getDataFileName name = do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" dir <- getDataDir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" return (dir `joinFileName` name)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
get_prefix_stuffString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
filename_stuff
in String
headerString -> String -> String
forall a. [a] -> [a] -> [a]
++String
body
where
cid :: UnitId
cid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
InstallDirs {
prefix :: forall dir. InstallDirs dir -> dir
prefix = String
flat_prefix,
bindir :: forall dir. InstallDirs dir -> dir
bindir = String
flat_bindir,
libdir :: forall dir. InstallDirs dir -> dir
libdir = String
flat_libdir,
dynlibdir :: forall dir. InstallDirs dir -> dir
dynlibdir = String
flat_dynlibdir,
datadir :: forall dir. InstallDirs dir -> dir
datadir = String
flat_datadir,
libexecdir :: forall dir. InstallDirs dir -> dir
libexecdir = String
flat_libexecdir,
sysconfdir :: forall dir. InstallDirs dir -> dir
sysconfdir = String
flat_sysconfdir
} = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteInstallCommandDirs PackageDescription
pkg_descr LocalBuildInfo
lbi UnitId
cid CopyDest
NoCopyDest
InstallDirs {
bindir :: forall dir. InstallDirs dir -> dir
bindir = Maybe String
flat_bindirrel,
libdir :: forall dir. InstallDirs dir -> dir
libdir = Maybe String
flat_libdirrel,
dynlibdir :: forall dir. InstallDirs dir -> dir
dynlibdir = Maybe String
flat_dynlibdirrel,
datadir :: forall dir. InstallDirs dir -> dir
datadir = Maybe String
flat_datadirrel,
libexecdir :: forall dir. InstallDirs dir -> dir
libexecdir = Maybe String
flat_libexecdirrel,
sysconfdir :: forall dir. InstallDirs dir -> dir
sysconfdir = Maybe String
flat_sysconfdirrel
} = PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe String)
prefixRelativeComponentInstallDirs (PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg_descr) LocalBuildInfo
lbi UnitId
cid
flat_bindirreloc :: String
flat_bindirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_bindir
flat_libdirreloc :: String
flat_libdirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_libdir
flat_dynlibdirreloc :: String
flat_dynlibdirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_dynlibdir
flat_datadirreloc :: String
flat_datadirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_datadir
flat_libexecdirreloc :: String
flat_libexecdirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_libexecdir
flat_sysconfdirreloc :: String
flat_sysconfdirreloc = String -> String -> String
shortRelativePath String
flat_prefix String
flat_sysconfdir
mkGetDir :: a -> Maybe a -> String
mkGetDir a
_ (Just a
dirrel) = String
"getPrefixDirRel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
dirrel
mkGetDir a
dir Maybe a
Nothing = String
"return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
dir
mkGetEnvOrReloc :: String -> String -> String
mkGetEnvOrReloc String
var String
dirrel = String
"catchIO (getEnv \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
var'String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\")" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (\\_ -> getPrefixDirReloc \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirrel String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\")"
where var' :: String
var' = PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
var
mkGetEnvOr :: String -> String -> String
mkGetEnvOr String
var String
expr = String
"catchIO (getEnv \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
var'String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\")"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (\\_ -> "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
exprString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
where var' :: String
var' = PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
var
absolute :: Bool
absolute =
PackageDescription -> Bool
hasLibs PackageDescription
pkg_descr
Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
flat_bindirrel
Bool -> Bool -> Bool
|| Bool -> Bool
not (CompilerFlavor -> Bool
supportsRelocatableProgs (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)))
reloc :: Bool
reloc = LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi
supportsRelocatableProgs :: CompilerFlavor -> Bool
supportsRelocatableProgs CompilerFlavor
GHC = case OS
buildOS of
OS
Windows -> Bool
True
OS
_ -> Bool
False
supportsRelocatableProgs CompilerFlavor
GHCJS = case OS
buildOS of
OS
Windows -> Bool
True
OS
_ -> Bool
False
supportsRelocatableProgs CompilerFlavor
_ = Bool
False
paths_modulename :: ModuleName
paths_modulename = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg_descr
get_prefix_stuff :: String
get_prefix_stuff = Bool -> Arch -> String
get_prefix_win32 Bool
supports_cpp Arch
buildArch
path_sep :: String
path_sep = String -> String
forall a. Show a => a -> String
show [Char
pathSeparator]
supports_cpp :: Bool
supports_cpp = Bool
supports_language_pragma
supports_rebindable_syntax :: Bool
supports_rebindable_syntax= Version -> Bool
ghc_newer_than ([Int] -> Version
mkVersion [Int
7,Int
0,Int
1])
supports_language_pragma :: Bool
supports_language_pragma = Version -> Bool
ghc_newer_than ([Int] -> Version
mkVersion [Int
6,Int
6,Int
1])
ghc_newer_than :: Version -> Bool
ghc_newer_than Version
minVersion =
case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
Maybe Version
Nothing -> Bool
False
Just Version
version -> Version
version Version -> VersionRange -> Bool
`withinRange` Version -> VersionRange
orLaterVersion Version
minVersion
pkgPathEnvVar :: PackageDescription
-> String
-> String
pkgPathEnvVar :: PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
var =
PackageName -> String
showPkgName (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var
where
showPkgName :: PackageName -> String
showPkgName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (String -> String)
-> (PackageName -> String) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c = Char
c
get_prefix_reloc_stuff :: String
get_prefix_reloc_stuff :: String
get_prefix_reloc_stuff =
String
"getPrefixDirReloc :: FilePath -> IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getPrefixDirReloc dirRel = do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" exePath <- getExecutablePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" let (bindir,_) = splitFileName exePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"
get_prefix_win32 :: Bool -> Arch -> String
get_prefix_win32 :: Bool -> Arch -> String
get_prefix_win32 Bool
supports_cpp Arch
arch =
String
"getPrefixDirRel :: FilePath -> IO FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" where\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" ret <- c_GetModuleFileName nullPtr buf size\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" case ret of\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" 0 -> return (prefix `joinFileName` dirRel)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" _ | ret < size -> do\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" exePath <- peekCWString buf\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" let (bindir,_) = splitFileName exePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" | otherwise -> try_size (size * 2)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
(case Bool
supports_cpp of
Bool
False -> String
""
Bool
True -> String
"#if defined(i386_HOST_ARCH)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"# define WINDOWS_CCONV stdcall\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#elif defined(x86_64_HOST_ARCH)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"# define WINDOWS_CCONV ccall\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"# error Unknown mingw32 arch\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"foreign import " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cconv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" unsafe \"windows.h GetModuleFileNameW\"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
where cconv :: String
cconv = if Bool
supports_cpp
then String
"WINDOWS_CCONV"
else case Arch
arch of
Arch
I386 -> String
"stdcall"
Arch
X86_64 -> String
"ccall"
Arch
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"win32 supported only with I386, X86_64"
filename_stuff :: String
filename_stuff :: String
filename_stuff =
String
"minusFileName :: FilePath -> String -> FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"minusFileName dir \"\" = dir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"minusFileName dir \".\" = dir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"minusFileName dir suffix =\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"joinFileName :: String -> String -> FilePath\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"joinFileName \"\" fname = fname\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"joinFileName \".\" fname = fname\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"joinFileName dir \"\" = dir\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"joinFileName dir fname\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" | isPathSeparator (last dir) = dir++fname\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" | otherwise = dir++pathSeparator:fname\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"splitFileName :: FilePath -> (String, String)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"splitFileName p = (reverse (path2++drive), reverse fname)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" where\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (path,drive) = case p of\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (c:':':p') -> (reverse p',[':',c])\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" _ -> (reverse p ,\"\")\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (fname,path1) = break isPathSeparator path\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" path2 = case path1 of\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" [] -> \".\"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" [_] -> path1 -- don't remove the trailing slash if \n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" -- there is only one character\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (c:path') | isPathSeparator c -> path'\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" _ -> path1\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"pathSeparator :: Char\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
(case OS
buildOS of
OS
Windows -> String
"pathSeparator = '\\\\'\n"
OS
_ -> String
"pathSeparator = '/'\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"isPathSeparator :: Char -> Bool\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
(case OS
buildOS of
OS
Windows -> String
"isPathSeparator c = c == '/' || c == '\\\\'\n"
OS
_ -> String
"isPathSeparator c = c == '/'\n")