A stable replacement for nix run in haskell
nix
cli
fix: work with remotes by not writing our own expressions
+52
-52
+49
-52
app/Main.hs
+49
-52
app/Main.hs
···
1
1
module Main (main) where
2
2
3
+
import Data.Attoparsec.Text (IResult (..), parse)
4
+
import Data.Map.Strict qualified as Map
3
5
import Data.Text (strip)
6
+
import Nix.Derivation (parseDerivation)
7
+
import Nix.Derivation qualified as DRV
4
8
import Options.Applicative
5
9
import Options.Applicative qualified as OA
6
10
import System.Environment (withArgs)
11
+
import System.FilePath ((</>))
7
12
import System.IO (hPutStrLn)
8
13
import System.Posix (executeFile)
9
14
import System.Process (readProcess)
···
154
159
nixCommonArgs :: BuildOptions -> [Text]
155
160
nixCommonArgs BuildOptions {..} =
156
161
concat
157
-
[ concatMap (\i -> ["-I", i]) buildIncludePaths,
162
+
[ concatMap (\(n, v) -> ["--arg", n, v]) buildArgs,
163
+
concatMap (\(n, v) -> ["--argstr", n, v]) buildArgStrs,
164
+
concatMap (\i -> ["-I", i]) buildIncludePaths,
158
165
concatMap (\(n, v) -> ["--option", n, v]) buildOptions,
159
166
replicate buildVerbose "--verbose",
160
167
replicate buildQuiet "--quiet",
···
165
172
nixBuildArgs opts@(BuildOptions {..}) =
166
173
nixCommonArgs opts
167
174
++ concat
168
-
[ concatMap (\(n, v) -> ["--arg", n, v]) buildArgs,
169
-
concatMap (\(n, v) -> ["--argstr", n, v]) buildArgStrs,
170
-
["--repair" | buildRepair],
175
+
[ ["--repair" | buildRepair],
171
176
["--no-build-output" | buildNoBuildOutput],
172
177
maybe [] (\j -> ["-j", j]) buildMaxJobs,
173
178
maybe [] (\c -> ["--cores", show c]) buildCores,
···
193
198
(_, Just p) -> Just p
194
199
(Nothing, Nothing) -> Nothing
195
200
196
-
getExeExprFromFile :: Text -> Maybe Text -> [(Text, Text)] -> [(Text, Text)] -> Text
197
-
getExeExprFromFile file attr args argstrs =
198
-
unlines
199
-
[ "let",
200
-
" lib = import <nixpkgs/lib>;",
201
-
" drv = import (" <> file <> ");",
202
-
" drvResolved = if builtins.isFunction drv then drv " <> argsBlock <> " else drv;",
203
-
"in lib.getExe drvResolved" <> attrSub
204
-
]
205
-
where
206
-
attrSub = maybe "" ("." <>) attr
207
-
argNix = unwords . fmap (\(n, v) -> n <> " = " <> v <> ";") $ args
208
-
argstrNix = unwords . fmap (\(n, v) -> n <> " = " <> "\"" <> v <> "\"" <> ";") $ argstrs
209
-
argsBlock = "{" <> (unwords [argNix, argstrNix]) <> " }"
201
+
readProcessText :: FilePath -> [Text] -> Text -> IO Text
202
+
readProcessText cmd args input = toText <$> readProcess cmd (map toString args) (toString input)
210
203
211
-
getExeExprFromExpr :: Text -> Maybe Text -> Text
212
-
getExeExprFromExpr expr attr =
213
-
unlines
214
-
[ "let",
215
-
" lib = import <nixpkgs/lib>;",
216
-
" drv = (" <> expr <> ");",
217
-
"in lib.getExe drv" <> attrSub
218
-
]
204
+
getAttrOf :: Text -> BuildOptions -> Text -> IO Text
205
+
getAttrOf output opts exprOrFile = do
206
+
strip
207
+
<$> readProcessText
208
+
"nix-instantiate"
209
+
(args ++ nixCommonArgs opts)
210
+
""
219
211
where
220
-
attrSub = maybe "" ("." <>) attr
212
+
attr = (maybe "" (<> ".") (getAttr opts)) <> output
213
+
args =
214
+
[exprOrFile, "--eval", "--raw", "-A", attr]
215
+
++ ["-E" | buildExpr opts /= Nothing]
216
+
++ if buildReadonlyMode opts then ["--readonly-mode"] else ["--read-write-mode"]
221
217
222
-
readProcessText :: FilePath -> [Text] -> Text -> IO Text
223
-
readProcessText cmd args input = toText <$> readProcess cmd (map toString args) (toString input)
218
+
mainProgram :: BuildOptions -> Text -> IO Text
219
+
mainProgram = getAttrOf "meta.mainProgram"
224
220
225
-
executeFileText :: Text -> Bool -> [Text] -> Maybe [(String, String)] -> IO a
226
-
executeFileText binPath search args env =
227
-
executeFile (toString binPath) search (map toString args) env
221
+
binOutputOrOut :: BuildOptions -> Text -> IO FilePath
222
+
binOutputOrOut opts exprOrFile = do
223
+
drvPath <- toString . strip <$> readProcessText "nix-instantiate" (args ++ nixCommonArgs opts) ""
224
+
drvText <- (decodeUtf8 <$> readFileBS drvPath) :: IO Text
225
+
let outputs = case parse parseDerivation drvText of
226
+
Fail _ _ err -> error $ "Failed to parse derivation: " <> toText err
227
+
Partial _ -> error "Failed to parse derivation: incomplete input"
228
+
Done _ drv -> DRV.outputs drv
229
+
let outputPath = case (flip find ["bin", "out"] $ \out -> Map.member out outputs) of
230
+
Just out -> DRV.path (outputs Map.! out)
231
+
Nothing -> error "Derivation has no 'out' or 'bin' output"
232
+
pure $ outputPath
233
+
where
234
+
args =
235
+
[exprOrFile, "--no-gc-warning"]
236
+
++ maybe [] (("-A" :) . one) (getAttr opts)
237
+
++ ["-E" | buildExpr opts /= Nothing]
238
+
++ if buildReadonlyMode opts then ["--readonly-mode"] else ["--read-write-mode"]
228
239
229
240
main :: IO ()
230
241
main = do
···
242
253
243
254
case buildExpr opts of
244
255
Just exprText -> do
256
+
binPath <- toString <$> mainProgram opts exprText
257
+
outPath <- binOutputOrOut opts exprText
245
258
let attr = buildAttrs opts
246
-
let expr = getExeExprFromExpr exprText attr
247
-
binPath <-
248
-
readProcessText
249
-
"nix-instantiate"
250
-
( ["--eval", "--raw", "-E", expr]
251
-
++ nixCommonArgs opts
252
-
++ if (buildReadonlyMode opts) then ["--readonly-mode"] else ["--read-write-mode"]
253
-
)
254
-
""
255
259
let attrArgs = maybe [] (("-A" :) . one) attr
256
260
void $
257
261
readProcessText
258
262
"nix-build"
259
263
(["--no-out-link", "-E", exprText] ++ attrArgs ++ nixBuildArgs opts)
260
264
""
261
-
executeFileText (strip binPath) False passthrough Nothing
265
+
executeFile (outPath </> "bin" </> binPath) False (map toString passthrough) Nothing
262
266
Nothing -> do
263
267
let file = getFile opts
268
+
binPath <- toString <$> mainProgram opts file
269
+
outPath <- binOutputOrOut opts file
264
270
let attr = getAttr opts
265
-
let expr = getExeExprFromFile file attr (buildArgs opts) (buildArgStrs opts)
266
-
binPath <-
267
-
readProcessText
268
-
"nix-instantiate"
269
-
( ["--eval", "--raw", "-E", expr]
270
-
++ nixCommonArgs opts
271
-
++ if (buildReadonlyMode opts) then ["--readonly-mode"] else ["--read-write-mode"]
272
-
)
273
-
""
274
271
let attrArgs = maybe [] (("-A" :) . one) attr
275
272
void $
276
273
readProcessText
277
274
"nix-build"
278
275
(["--no-out-link", file] ++ attrArgs ++ nixBuildArgs opts)
279
276
""
280
-
executeFileText (strip binPath) False passthrough Nothing
277
+
executeFile (outPath </> "bin" </> binPath) False (map toString passthrough) Nothing