diff --git a/Cabal/Distribution/Simple/Build/PathsModule.hs b/Cabal/Distribution/Simple/Build/PathsModule.hs index 5e660e8d6..1ae603c94 100644 --- a/libraries/Cabal/Cabal/Distribution/Simple/Build/PathsModule.hs +++ b/libraries/Cabal/Cabal/Distribution/Simple/Build/PathsModule.hs @@ -37,6 +37,9 @@ import System.FilePath ( pathSeparator ) -- * Building Paths_.hs -- ------------------------------------------------------------ +splitPath :: FilePath -> [ String ] +splitPath = unintersperse pathSeparator + generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String generatePathsModule pkg_descr lbi clbi = let pragmas = @@ -78,12 +81,44 @@ generatePathsModule pkg_descr lbi clbi = "import System.Environment (getExecutablePath)\n" | otherwise = "" + dirs = [ (flat_libdir, "LibDir") + , (flat_dynlibdir, "DynLibDir") + , (flat_datadir, "DataDir") + , (flat_libexecdir, "LibexecDir") + , (flat_sysconfdir, "SysconfDir") ]; + + shouldEmitPath p + | (splitPath flat_prefix) `isPrefixOf` (splitPath flat_bindir) = True + | (splitPath flat_prefix) `isPrefixOf` (splitPath p) = False + | otherwise = True + + shouldEmitDataDir = shouldEmitPath flat_datadir + + nixEmitPathFn (path, name) = let + varName = toLower <$> name + fnName = "get"++name + in if shouldEmitPath path then + varName ++ " :: FilePath\n"++ + varName ++ " = " ++ show path ++ + "\n" ++ fnName ++ " :: IO FilePath" ++ + "\n" ++ fnName ++ " = " ++ mkGetEnvOr varName ("return " ++ varName)++"\n" + else "" + + absBody = intercalate "\n" $ nixEmitPathFn <$> dirs + + warnPragma = case filter (not . shouldEmitPath . fst) dirs of + [] -> "" + omittedDirs -> "{-# WARNING \"The functions: "++omittedFns++" Have been omitted by the Nix build system.\" #-}" + where omittedFns = intercalate ", " $ map snd omittedDirs + + importList = intercalate ", " $ ("get" ++) . snd <$> filter (shouldEmitPath . fst) dirs + header = pragmas++ - "module " ++ prettyShow paths_modulename ++ " (\n"++ - " version,\n"++ - " getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,\n"++ - " getDataFileName, getSysconfDir\n"++ + "module " ++ prettyShow paths_modulename ++ " " ++ warnPragma ++ " (\n"++ + " version, getBinDir,\n"++ + (if shouldEmitDataDir then " getDataFileName, \n" else "\n")++ + " " ++ importList ++"\n"++ " ) where\n"++ "\n"++ foreign_imports++ @@ -136,26 +171,18 @@ generatePathsModule pkg_descr lbi clbi = "\n"++ filename_stuff | absolute = - "\nbindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath\n"++ + "\nbindir :: FilePath\n"++ "\nbindir = " ++ show flat_bindir ++ - "\nlibdir = " ++ show flat_libdir ++ - "\ndynlibdir = " ++ show flat_dynlibdir ++ - "\ndatadir = " ++ show flat_datadir ++ - "\nlibexecdir = " ++ show flat_libexecdir ++ - "\nsysconfdir = " ++ show flat_sysconfdir ++ "\n"++ - "\ngetBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"++ + "\ngetBinDir :: IO FilePath\n"++ "getBinDir = "++mkGetEnvOr "bindir" "return bindir"++"\n"++ - "getLibDir = "++mkGetEnvOr "libdir" "return libdir"++"\n"++ - "getDynLibDir = "++mkGetEnvOr "dynlibdir" "return dynlibdir"++"\n"++ - "getDataDir = "++mkGetEnvOr "datadir" "return datadir"++"\n"++ - "getLibexecDir = "++mkGetEnvOr "libexecdir" "return libexecdir"++"\n"++ - "getSysconfDir = "++mkGetEnvOr "sysconfdir" "return sysconfdir"++"\n"++ - "\n"++ - "getDataFileName :: FilePath -> IO FilePath\n"++ - "getDataFileName name = do\n"++ - " dir <- getDataDir\n"++ - " return (dir ++ "++path_sep++" ++ name)\n" + absBody ++ "\n"++ + (if shouldEmitDataDir then + "getDataFileName :: FilePath -> IO FilePath\n"++ + "getDataFileName name = do\n"++ + " dir <- getDataDir\n"++ + " return (dir ++ "++path_sep++" ++ name)\n" + else "\n") | otherwise = "\nprefix, bindirrel :: FilePath" ++ "\nprefix = " ++ show flat_prefix ++