-
Notifications
You must be signed in to change notification settings - Fork 29
/
Copy pathStack.hs
202 lines (186 loc) · 9.86 KB
/
Stack.hs
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
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Stack2nix.External.Stack
( PackageRef(..), runPlan
) where
import Control.Lens ((%~))
import Control.Monad (when)
import Data.List (concat)
import qualified Data.Map.Strict as M
import Data.Maybe (fromJust)
import qualified Data.Set as Set (fromList,
union)
import Data.Text (pack, unpack)
import Distribution.Nixpkgs.Haskell.Derivation (Derivation,
configureFlags)
import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
import Options.Applicative
import Path (parseAbsFile)
import Stack.Build.Source (getGhcOptions, loadSourceMapFull)
import Stack.Build.Target (NeedTargets (..))
import Stack.Config
import Stack.Options.BuildParser
import Stack.Options.GlobalParser
import Stack.Options.Utils (GlobalOptsContext (..))
import Stack.Prelude hiding
(logDebug)
import Stack.Runners (loadCompilerVersion,
withBuildConfig)
import Stack.Types.BuildPlan (PackageLocation (..),
Repo (..))
import Stack.Types.Compiler (getGhcVersion)
import Stack.Types.Config
import Stack.Types.Config.Build (BuildCommand (..))
import Stack.Types.FlagName (toCabalFlagName)
import Stack.Types.Nix
import Stack.Types.Package (PackageSource (..),
lpLocation,
lpPackage,
packageFlags,
packageName,
packageVersion)
import Stack.Types.PackageIdentifier (PackageIdentifier (..),
PackageIdentifierRevision (..),
packageIdentifierString)
import Stack.Types.PackageName (PackageName, parsePackageName)
import Stack.Types.Runner
import Stack.Types.Version (Version)
import Stack2nix.External.Cabal2nix (cabal2nix)
import Stack2nix.Hackage (loadHackageDB)
import Stack2nix.Render (render)
import Stack2nix.Types (Args (..), Flags)
import Stack2nix.Util (ensureExecutable,
logDebug,
mapPool)
import System.Directory (canonicalizePath,
createDirectoryIfMissing,
getCurrentDirectory,
makeRelativeToCurrentDirectory)
import System.FilePath (makeRelative,
(</>))
import Text.PrettyPrint.HughesPJClass (Doc)
data PackageRef
= HackagePackage Flags PackageIdentifierRevision
| NonHackagePackage Flags PackageIdentifier (PackageLocation FilePath)
deriving (Eq, Show)
genNixFile :: Args -> Version -> FilePath -> Maybe String -> Maybe String -> DB.HackageDB -> PackageRef -> IO (Either Doc Derivation)
genNixFile args ghcVersion baseDir uri argRev hackageDB pkgRef = do
cwd <- getCurrentDirectory
case pkgRef of
NonHackagePackage _flags _ident PLArchive {} -> error "genNixFile: No support for archive package locations"
HackagePackage flags (PackageIdentifierRevision pkg _) ->
cabal2nix args ghcVersion ("cabal://" <> packageIdentifierString pkg) Nothing Nothing flags hackageDB
NonHackagePackage flags _ident (PLRepo repo) ->
cabal2nix args ghcVersion (unpack $ repoUrl repo) (Just $ repoCommit repo) (Just (repoSubdirs repo)) flags hackageDB
NonHackagePackage flags _ident (PLFilePath path) -> do
relPath <- makeRelativeToCurrentDirectory path
projRoot <- canonicalizePath $ cwd </> baseDir
let defDir = baseDir </> makeRelative projRoot path
cabal2nix args ghcVersion (fromMaybe defDir uri) (pack <$> argRev) (const relPath <$> uri) flags hackageDB
-- TODO: remove once we use flags, options
sourceMapToPackages :: Map PackageName PackageSource -> [PackageRef]
sourceMapToPackages = map sourceToPackage . M.elems
where
sourceToPackage :: PackageSource -> PackageRef
sourceToPackage (PSIndex _ flags _options pir) = HackagePackage (toCabalFlags flags) pir
sourceToPackage (PSFiles lp _) =
let pkg = lpPackage lp
ident = PackageIdentifier (packageName pkg) (packageVersion pkg)
in NonHackagePackage (toCabalFlags $ packageFlags pkg) ident (lpLocation lp)
toCabalFlags fs = [ (toCabalFlagName f0, enabled)
| (f0, enabled) <- M.toList fs ]
planAndGenerate
:: HasEnvConfig env
=> BuildOptsCLI
-> FilePath
-> Maybe String
-> Args
-> Version
-> RIO env ()
planAndGenerate boptsCli baseDir remoteUri args@Args {..} ghcVersion = do
(_targets, _mbp, _locals, _extraToBuild, sourceMap) <- loadSourceMapFull
NeedTargets
boptsCli
-- Stackage lists bin-package-db but it's in GHC 7.10's boot libraries
binPackageDb <- parsePackageName "bin-package-db"
let pkgs = sourceMapToPackages (M.delete binPackageDb sourceMap)
liftIO $ logDebug args $ "plan:\n" ++ show pkgs
hackageDB <- liftIO $ loadHackageDB Nothing argHackageSnapshot
buildConf <- envConfigBuildConfig <$> view envConfigL
drvs <- liftIO $ mapPool
argThreads
(\p ->
fmap (addGhcOptions buildConf p)
<$> genNixFile args ghcVersion baseDir remoteUri argRev hackageDB p
)
pkgs
let locals = map (\l -> show (packageName (lpPackage l))) _locals
liftIO . render drvs args locals $ nixVersion ghcVersion
-- | Add ghc-options declared in stack.yaml to the nix derivation for a package
-- by adding to the configureFlags attribute of the derivation
addGhcOptions :: BuildConfig -> PackageRef -> Derivation -> Derivation
addGhcOptions buildConf pkgRef drv =
drv & configureFlags %~ (Set.union stackGhcOptions)
where
stackGhcOptions :: Set String
stackGhcOptions =
Set.fromList . map (unpack . ("--ghc-option=" <>)) $ getGhcOptions
buildConf
buildOpts
pkgName
False
False
pkgName :: PackageName
pkgName = case pkgRef of
HackagePackage _ (PackageIdentifierRevision (PackageIdentifier n _) _) -> n
NonHackagePackage _ (PackageIdentifier n _) _ -> n
runPlan :: FilePath
-> Maybe String
-> Args
-> IO ()
runPlan baseDir remoteUri args@Args{..} = do
let stackRoot = "/tmp/s2n"
createDirectoryIfMissing True stackRoot
let globals = globalOpts baseDir stackRoot args
let stackFile = baseDir </> argStackYaml
ghcVersion <- getGhcVersionIO globals stackFile
when argEnsureExecutables $
ensureExecutable ("haskell.compiler.ghc" ++ nixVersion ghcVersion)
withBuildConfig globals $ planAndGenerate buildOpts baseDir remoteUri args ghcVersion
nixVersion :: Version -> String
nixVersion =
filter (/= '.') . show
getGhcVersionIO :: GlobalOpts -> FilePath -> IO Version
getGhcVersionIO go stackFile = do
cp <- canonicalizePath stackFile
fp <- parseAbsFile cp
lc <- withRunner LevelError True False ColorAuto Nothing False $ \runner ->
-- https://www.fpcomplete.com/blog/2017/07/the-rio-monad
runRIO runner $ loadConfig mempty Nothing (SYLOverride fp)
getGhcVersion <$> loadCompilerVersion go lc
globalOpts :: FilePath -> FilePath -> Args -> GlobalOpts
globalOpts currentDir stackRoot Args{..} =
go { globalReExecVersion = Just "1.5.1" -- TODO: obtain from stack lib if exposed
, globalConfigMonoid =
(globalConfigMonoid go)
{ configMonoidNixOpts = mempty
{ nixMonoidEnable = First (Just True)
}
}
, globalStackYaml = SYLOverride (currentDir </> argStackYaml)
, globalLogLevel = if argVerbose then LevelDebug else LevelInfo
}
where
pinfo = info (globalOptsParser currentDir OuterGlobalOpts (Just LevelError)) briefDesc
args = concat [ ["--stack-root", stackRoot]
, ["--jobs", show argThreads]
, ["--test" | argTest]
, ["--bench" | argBench]
, ["--haddock" | argHaddock]
, ["--no-install-ghc"]
]
go = globalOptsFromMonoid False ColorNever . fromJust . getParseResult $
execParserPure defaultPrefs pinfo args
buildOpts :: BuildOptsCLI
buildOpts = fromJust . getParseResult $ execParserPure defaultPrefs (info (buildOptsParser Build) briefDesc) ["--dry-run"]