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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Coolbal.Target.Executable where
import Control.DeepSeq (deepseq)
import Data.Binary
import Data.List (intercalate)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic)
import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
import System.Exit (die, exitWith)
import System.FilePath ((</>), makeRelative)
import System.IO.Error (catchIOError)
import System.IO.Temp
import Coolbal.Options (Flags)
import Coolbal.DataVersionTag
import Coolbal.EnvBinary
import Coolbal.Log
import Coolbal.MakeParse
import Coolbal.Process
import Coolbal.Target.Class
import Coolbal.Target.Utils
data ExeTarget = ExeTarget
{ etName :: String
-- ^ Target name, and name of output executable file
, etPkgDbDir :: FilePath
-- ^ Absolute path to the package.db directory
, etDeps :: [String]
-- ^ Package identifiers of dependencies (for -package-id flags)
, etLanguage :: String
-- ^ Haskell language (e.g. Haskell2010)
, etMain :: FilePath
-- ^ Main file
, etSrcDirs :: [FilePath]
-- ^ Source directories
, etFlags :: [String]
-- ^ User-specified compiler flags
, etModGraph :: Map [String] [[String]]
-- ^ Dependency graph of other modules in the target
, etModules :: [[String]]
-- ^ List of other modules in the target
, etProjDir :: FilePath
-- ^ Project root directory (absolute path)
, etBuildDir :: FilePath
-- ^ Build directory (absolute path)
, etBinDir :: FilePath
-- ^ Binary target directory (absolute path)
, etBinFile :: FilePath
-- ^ Target executable file path (absolute path)
, etBaseFlags :: [String]
-- ^ Base flags for GHC (excluding --make, module/file list, -c/-o)
}
deriving (Show)
data ExeTargetStore' mods = ExeTargetStore
{ _etsVersionTag :: DataVersionTag 1
, etsName :: String
-- ^ Target name, and name of output executable file
, etsPkgDbDir :: FilePath
-- ^ Absolute path to the package.db directory
, etsDeps :: [String]
-- ^ Package identifiers of dependencies (for -package-id flags)
, etsLanguage :: String
-- ^ Haskell language (e.g. Haskell2010)
, etsMain :: FilePath
-- ^ Main file
, etsSrcDirs :: [FilePath]
-- ^ Source directories
, etsFlags :: [String]
-- ^ User-specified compiler flags
, etsModules :: mods
-- ^ Dependency graph of other modules in the target
}
type ExeTargetStorePre = ExeTargetStore' [[String]]
type ExeTargetStore = ExeTargetStore' (Map [String] [[String]])
deriving instance Generic ExeTargetStore
instance Binary ExeTargetStore
instance EnvBinary RestoreEnv ExeTarget where
envget renv = elaborateExeTarget renv <$> get
envput = put . unelabExeTarget
elaborateExeTargetWithEBS :: ExeBuildSetup -> ExeTargetStore -> ExeTarget
elaborateExeTargetWithEBS ebs tg = ExeTarget
{ etName = etsName tg
, etPkgDbDir = etsPkgDbDir tg
, etDeps = etsDeps tg
, etLanguage = etsLanguage tg
, etMain = etsMain tg
, etSrcDirs = etsSrcDirs tg
, etFlags = etsFlags tg
, etModGraph = etsModules tg
, etModules = Map.keys (etsModules tg)
, etProjDir = ebsProjDir ebs
, etBuildDir = ebsBuildDir ebs
, etBinDir = ebsBinDir ebs
, etBinFile = ebsBinFile ebs
, etBaseFlags = ebsBaseFlags ebs
}
elaborateExeTarget :: RestoreEnv -> ExeTargetStore -> ExeTarget
elaborateExeTarget RestoreEnv{reProjDir=projdir} tg =
let ebs = exeBuildSetup projdir (tg { etsModules = Map.keys (etsModules tg) })
in elaborateExeTargetWithEBS ebs tg
unelabExeTarget :: ExeTarget -> ExeTargetStore
unelabExeTarget tg = ExeTargetStore
{ _etsVersionTag = DataVersionTag
, etsName = etName tg
, etsPkgDbDir = etPkgDbDir tg
, etsDeps = etDeps tg
, etsLanguage = etLanguage tg
, etsMain = etMain tg
, etsSrcDirs = etSrcDirs tg
, etsFlags = etFlags tg
, etsModules = etModGraph tg
}
instance IsTarget ExeTarget where
targetName = etName
targetPrefix _ = "exe"
targetCheckOld projdir tg = do
mbinTm <- maybeModificationTime (projdir </> "dist-coolbal/bin" </> escapeFileName (etName tg))
case mbinTm of
Just binTm -> do
anyNewerThan binTm (findFile' (etSrcDirs tg) (etMain tg)
: [findSourceFile' (etSrcDirs tg) m | m <- etModules tg])
Nothing ->
return True
targetBuild flags tg = do
createDirectoryIfMissing True (etBinDir tg)
-- To build only a single module instead of the whole executable: remove etMain and add only the right module of etModules; add -c; remove -o.
runCommand flags "ghc" (concat
[["--make"]
,etBaseFlags tg
,[etMain tg]
,map (intercalate ".") (etModules tg)
,["-o", etBinFile tg]])
>>= checkExitCode
targetExecute flags tg = Just $ \args -> do
let filename = escapeFileName (etName tg)
runCommand flags (etProjDir tg </> "dist-coolbal/bin" </> filename) args
>>= exitWith
targetRemoveBuildArtifacts projdir tg =
removeDirectoryRecursive
(projdir </> "dist-coolbal/build"
</> escapeFileName (targetNameQualifiedFilename tg))
`catchIOError` (\_ -> return ())
data ExeBuildSetup = ExeBuildSetup
{ ebsProjDir :: FilePath
, ebsBuildDir :: FilePath
, ebsBinDir :: FilePath
, ebsBinFile :: FilePath
, ebsBaseFlags :: [String]
}
exeBuildSetup :: FilePath -> ExeTargetStorePre -> ExeBuildSetup
exeBuildSetup projdir tg =
let buildDir = projdir </> "dist-coolbal/build"
</> escapeFileName (buildQualifiedName "exe" (etsName tg))
binDir = projdir </> "dist-coolbal/bin"
in ExeBuildSetup
{ ebsProjDir = projdir
, ebsBuildDir = buildDir
, ebsBinDir = binDir
, ebsBinFile = binDir </> escapeFileName (etsName tg)
, ebsBaseFlags = concat
[["-static"]
,concat [[flag, buildDir]
| flag <- ["-outputdir", "-odir", "-hidir", "-stubdir"]]
,["-i" ++ dir | dir <- etsSrcDirs tg]
,["-hide-all-packages", "-Wmissing-home-modules", "-no-user-package-db"]
,["-package-db", etsPkgDbDir tg]
,concat [["-package-id", dep] | dep <- etsDeps tg]
,["-X" ++ etsLanguage tg]
,etsFlags tg]
}
exeDepGraph :: Flags -> ExeTargetStorePre -> ExeBuildSetup -> IO (Map [String] [[String]])
exeDepGraph flags tg ebs = do
output <- withSystemTempDirectory "coolbal-make" $ \tmpdir -> do
let fname = tmpdir </> "Makefile"
runCommand flags "ghc" (concat
[ebsBaseFlags ebs
,[etsMain tg]
,map (intercalate ".") (etsModules tg)
,["-M", "-dep-suffix", "", "-dep-makefile", fname]])
>>= checkExitCode
output <- readFile fname
output `deepseq` return output
case parseGHCmake (ebsProjDir ebs) (makeRelative (ebsProjDir ebs) (ebsBuildDir ebs)) output of
Left err -> die err
Right m -> logVerbose flags "depgraph:graph" (show m) >> return m
|
