A stable replacement for nix run in haskell

fix: work with remotes by not writing our own expressions

Changed files
+52 -52
app
+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
+3
package.yaml
··· 25 25 - (Relude as Prelude) 26 26 - "" 27 27 - hercules-ci-optparse-applicative ^>= 0.19.0.0 28 + - nix-derivation ^>= 1.1.3 29 + - attoparsec ^>= 0.14.4 28 30 - process 29 31 - unix 32 + - filepath 30 33 language: GHC2024 31 34 default-extensions: 32 35 - ApplicativeDo