1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
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_<pkg>.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 ++
|