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
|
{-# LANGUAGE GADTs #-}
module CabalHelper.Compiletime.CompPrograms where
import Data.List
import Data.Maybe
import System.Directory
import System.FilePath
import System.IO.Temp
import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.Cabal (getCabalVerbosity)
import Symlink (createSymbolicLink)
import Distribution.Simple.GHC as GHC (configure)
import qualified Distribution.Simple.Program as ProgDb
( lookupProgram, lookupKnownProgram, programPath
, configureProgram, userMaybeSpecifyPath
, ghcProgram, ghcPkgProgram, haddockProgram )
import qualified Distribution.Simple.Program.Db as ProgDb
-- | Determine ghc-pkg/haddock path from ghc path
guessCompProgramPaths :: Verbose => Programs -> IO Programs
guessCompProgramPaths progs = do
let v = getCabalVerbosity
getMaybeProg' = getMaybeProg progs
progdb =
ProgDb.userMaybeSpecifyPath "ghc" (getMaybeProg' ghcProgram) $
ProgDb.userMaybeSpecifyPath "ghc-pkg" (getMaybeProg' ghcPkgProgram) $
ProgDb.userMaybeSpecifyPath "haddock" (getMaybeProg' haddockProgram) $
ProgDb.defaultProgramDb
(_compiler, _mplatform, progdb1) <- GHC.configure v Nothing Nothing progdb
let Just haddockKnownProgram = ProgDb.lookupKnownProgram "haddock" progdb1
progdb2 <- ProgDb.configureProgram v haddockKnownProgram progdb1
let getProg p = ProgDb.programPath <$> ProgDb.lookupProgram p progdb2
return progs
{ ghcProgram =
fromMaybe (ghcProgram progs) $ getProg ProgDb.ghcProgram
, ghcPkgProgram =
fromMaybe (ghcPkgProgram progs) $ getProg ProgDb.ghcPkgProgram
, haddockProgram =
fromMaybe (haddockProgram progs) $ getProg ProgDb.haddockProgram
}
getMaybeProg :: Programs -> (Programs -> FilePath) -> Maybe FilePath
getMaybeProg progs fn
| fn progs == fn defaultPrograms = Nothing
| otherwise = Just (fn progs)
patchBuildToolProgs :: SProjType pt -> Programs -> IO Programs
patchBuildToolProgs (SCabal _) progs = return progs
{ cabalUnitArgs = concat
[ maybeToList (("--with-ghc="++) <$> getMaybeProg progs ghcProgram)
, maybeToList (("--with-ghc-pkg="++) <$> getMaybeProg progs ghcPkgProgram)
, maybeToList (("--with-haddock="++) <$> getMaybeProg progs haddockProgram)
] ++ cabalUnitArgs progs
}
patchBuildToolProgs SStack progs
-- optimization; if none of the program paths are non-default we don't
-- even have to add anything to PATH.
| ghcProgram progs == "ghc"
, ghcPkgProgram progs == "ghc-pkg"
, haddockProgram progs == "haddock"
= return progs
-- optimization; if all paths are unqualified and have the same version
-- postfix Stack's default behaviour works for us.
| [ghc] <- splitPath (ghcProgram progs)
, [ghcPkg] <- splitPath (ghcPkgProgram progs)
, [haddock] <- splitPath (haddockProgram progs)
, Just ver <- stripPrefix "ghc-" ghc
, Just ver == stripPrefix "ghc-pkg-" ghcPkg
, Just ver == stripPrefix "haddock-" haddock
= return progs
patchBuildToolProgs SStack progs = do
-- otherwise fall back to creating a symlink farm
--
-- This is of course all quite horrible and we would much prefer just
-- being able to pass executable paths straight through to stack but
-- currently there is no option to let us do that.
withSystemTempDirectory "cabal-helper-symlinks" $ \bindir -> do
createProgSymlink bindir $ ghcProgram progs
createProgSymlink bindir $ ghcPkgProgram progs
createProgSymlink bindir $ haddockProgram progs
return $ progs
{ stackEnv =
[("PATH", EnvPrepend $ bindir ++ [searchPathSeparator])] ++
stackEnv progs
}
createProgSymlink :: FilePath -> FilePath -> IO ()
createProgSymlink bindir target
| [exe] <- splitPath target = do
Just exe_path <- findExecutable exe
createSymbolicLink exe_path (bindir </> takeFileName target)
| otherwise = do
cwd <- getCurrentDirectory
createSymbolicLink (cwd </> target) (bindir </> takeFileName target)
|
