module Distribution.Simple.Build.PathsModule.Z (render, Z(..)) where
import Distribution.ZinzaPrelude
data Z
= Z {zPackageName :: PackageName,
zVersionDigits :: String,
zSupportsCpp :: Bool,
zSupportsNoRebindableSyntax :: Bool,
zAbsolute :: Bool,
zRelocatable :: Bool,
zIsWindows :: Bool,
zIsI386 :: Bool,
zIsX8664 :: Bool,
zPrefix :: FilePath,
zBindir :: FilePath,
zLibdir :: FilePath,
zDynlibdir :: FilePath,
zDatadir :: FilePath,
zLibexecdir :: FilePath,
zSysconfdir :: FilePath,
zNot :: (Bool -> Bool),
zManglePkgName :: (PackageName -> String)}
deriving Generic
render :: Z -> String
render z_root = execWriter $ do
if (zSupportsCpp z_root)
then do
tell "{-# LANGUAGE CPP #-}\n"
return ()
else do
return ()
if (zSupportsNoRebindableSyntax z_root)
then do
tell "{-# LANGUAGE NoRebindableSyntax #-}\n"
return ()
else do
return ()
if (zNot z_root (zAbsolute z_root))
then do
tell "{-# LANGUAGE ForeignFunctionInterface #-}\n"
return ()
else do
return ()
tell "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"
tell "{-# OPTIONS_GHC -w #-}\n"
tell "module Paths_"
tell (zManglePkgName z_root (zPackageName z_root))
tell " (\n"
tell " version,\n"
tell " getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,\n"
tell " getDataFileName, getSysconfDir\n"
tell " ) where\n"
tell "\n"
if (zNot z_root (zAbsolute z_root))
then do
tell "import Foreign\n"
tell "import Foreign.C\n"
return ()
else do
return ()
tell "\n"
tell "import qualified Control.Exception as Exception\n"
tell "import qualified Data.List as List\n"
tell "import Data.Version (Version(..))\n"
tell "import System.Environment (getEnv)\n"
tell "import Prelude\n"
tell "\n"
if (zRelocatable z_root)
then do
tell "import System.Environment (getExecutablePath)\n"
return ()
else do
return ()
tell "\n"
if (zSupportsCpp z_root)
then do
tell "#if defined(VERSION_base)\n"
tell "\n"
tell "#if MIN_VERSION_base(4,0,0)\n"
tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"
tell "#else\n"
tell "catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a\n"
tell "#endif\n"
tell "\n"
tell "#else\n"
tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"
tell "#endif\n"
tell "catchIO = Exception.catch\n"
return ()
else do
tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"
tell "catchIO = Exception.catch\n"
return ()
tell "\n"
tell "version :: Version\n"
tell "version = Version "
tell (zVersionDigits z_root)
tell " []\n"
tell "\n"
tell "getDataFileName :: FilePath -> IO FilePath\n"
tell "getDataFileName name = do\n"
tell " dir <- getDataDir\n"
tell " return (dir `joinFileName` name)\n"
tell "\n"
tell "getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"
tell "\n"
tell "\n"
if (zRelocatable z_root)
then do
tell "\n"
tell "getPrefixDirReloc :: FilePath -> IO FilePath\n"
tell "getPrefixDirReloc dirRel = do\n"
tell " exePath <- getExecutablePath\n"
tell " let (dir,_) = splitFileName exePath\n"
tell " return ((dir `minusFileName` "
tell (zBindir z_root)
tell ") `joinFileName` dirRel)\n"
tell "\n"
tell "getBinDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_bindir\") (\\_ -> getPrefixDirReloc $ "
tell (zBindir z_root)
tell ")\n"
tell "getLibDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_libdir\") (\\_ -> getPrefixDirReloc $ "
tell (zLibdir z_root)
tell ")\n"
tell "getDynLibDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_dynlibdir\") (\\_ -> getPrefixDirReloc $ "
tell (zDynlibdir z_root)
tell ")\n"
tell "getDataDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_datadir\") (\\_ -> getPrefixDirReloc $ "
tell (zDatadir z_root)
tell ")\n"
tell "getLibexecDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_libexecdir\") (\\_ -> getPrefixDirReloc $ "
tell (zLibexecdir z_root)
tell ")\n"
tell "getSysconfDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_sysconfdir\") (\\_ -> getPrefixDirReloc $ "
tell (zSysconfdir z_root)
tell ")\n"
tell "\n"
return ()
else do
if (zAbsolute z_root)
then do
tell "\n"
tell "bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath\n"
tell "bindir = "
tell (zBindir z_root)
tell "\n"
tell "libdir = "
tell (zLibdir z_root)
tell "\n"
tell "dynlibdir = "
tell (zDynlibdir z_root)
tell "\n"
tell "datadir = "
tell (zDatadir z_root)
tell "\n"
tell "libexecdir = "
tell (zLibexecdir z_root)
tell "\n"
tell "sysconfdir = "
tell (zSysconfdir z_root)
tell "\n"
tell "\n"
tell "getBinDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_bindir\") (\\_ -> return bindir)\n"
tell "getLibDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_libdir\") (\\_ -> return libdir)\n"
tell "getDynLibDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_dynlibdir\") (\\_ -> return dynlibdir)\n"
tell "getDataDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_datadir\") (\\_ -> return datadir)\n"
tell "getLibexecDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_libexecdir\") (\\_ -> return libexecdir)\n"
tell "getSysconfDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_sysconfdir\") (\\_ -> return sysconfdir)\n"
tell "\n"
return ()
else do
if (zIsWindows z_root)
then do
tell "\n"
tell "prefix :: FilePath\n"
tell "prefix = "
tell (zPrefix z_root)
tell "\n"
tell "\n"
tell "getBinDir = getPrefixDirRel $ "
tell (zBindir z_root)
tell "\n"
tell "getLibDir = "
tell (zLibdir z_root)
tell "\n"
tell "getDynLibDir = "
tell (zDynlibdir z_root)
tell "\n"
tell "getDataDir = catchIO (getEnv \""
tell (zManglePkgName z_root (zPackageName z_root))
tell "_datadir\") (\\_ -> "
tell (zDatadir z_root)
tell ")\n"
tell "getLibexecDir = "
tell (zLibexecdir z_root)
tell "\n"
tell "getSysconfDir = "
tell (zSysconfdir z_root)
tell "\n"
tell "\n"
tell "getPrefixDirRel :: FilePath -> IO FilePath\n"
tell "getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n"
tell " where\n"
tell " try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n"
tell " ret <- c_GetModuleFileName nullPtr buf size\n"
tell " case ret of\n"
tell " 0 -> return (prefix `joinFileName` dirRel)\n"
tell " _ | ret < size -> do\n"
tell " exePath <- peekCWString buf\n"
tell " let (bindir,_) = splitFileName exePath\n"
tell " return ((bindir `minusFileName` "
tell (zBindir z_root)
tell ") `joinFileName` dirRel)\n"
tell " | otherwise -> try_size (size * 2)\n"
tell "\n"
if (zIsI386 z_root)
then do
tell "foreign import stdcall unsafe \"windows.h GetModuleFileNameW\"\n"
tell " c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
return ()
else do
if (zIsX8664 z_root)
then do
tell "foreign import ccall unsafe \"windows.h GetModuleFileNameW\"\n"
tell " c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
return ()
else do
tell "-- win32 supported only with I386, X86_64\n"
tell "c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
tell "c_GetModuleFileName = _\n"
return ()
return ()
tell "\n"
return ()
else do
tell "\n"
tell "notRelocAbsoluteOrWindows :: ()\n"
tell "notRelocAbsoluteOrWindows = _\n"
tell "\n"
return ()
return ()
return ()
tell "\n"
tell "\n"
if (zNot z_root (zAbsolute z_root))
then do
tell "minusFileName :: FilePath -> String -> FilePath\n"
tell "minusFileName dir \"\" = dir\n"
tell "minusFileName dir \".\" = dir\n"
tell "minusFileName dir suffix =\n"
tell " minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))\n"
tell "\n"
tell "splitFileName :: FilePath -> (String, String)\n"
tell "splitFileName p = (reverse (path2++drive), reverse fname)\n"
tell " where\n"
tell " (path,drive) = case p of\n"
tell " (c:':':p') -> (reverse p',[':',c])\n"
tell " _ -> (reverse p ,\"\")\n"
tell " (fname,path1) = break isPathSeparator path\n"
tell " path2 = case path1 of\n"
tell " [] -> \".\"\n"
tell " [_] -> path1 -- don't remove the trailing slash if\n"
tell " -- there is only one character\n"
tell " (c:path') | isPathSeparator c -> path'\n"
tell " _ -> path1\n"
return ()
else do
return ()
tell "\n"
tell "joinFileName :: String -> String -> FilePath\n"
tell "joinFileName \"\" fname = fname\n"
tell "joinFileName \".\" fname = fname\n"
tell "joinFileName dir \"\" = dir\n"
tell "joinFileName dir fname\n"
tell " | isPathSeparator (List.last dir) = dir ++ fname\n"
tell " | otherwise = dir ++ pathSeparator : fname\n"
tell "\n"
tell "pathSeparator :: Char\n"
if (zIsWindows z_root)
then do
tell "pathSeparator = '\\\\'\n"
return ()
else do
tell "pathSeparator = '/'\n"
return ()
tell "\n"
tell "isPathSeparator :: Char -> Bool\n"
if (zIsWindows z_root)
then do
tell "isPathSeparator c = c == '/' || c == '\\\\'\n"
return ()
else do
tell "isPathSeparator c = c == '/'\n"
return ()