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