From 412bbfdc620fce89cf066a34b517d31874964a34 Mon Sep 17 00:00:00 2001 From: Jonas Carpay Date: Sun, 7 May 2023 11:24:10 +0900 Subject: [PATCH] Add support for --run --- purenix.cabal | 3 +++ src/PureNix/Main.hs | 49 ++++----------------------------------- src/PureNix/Main/Build.hs | 48 ++++++++++++++++++++++++++++++++++++++ src/PureNix/Main/Run.hs | 46 ++++++++++++++++++++++++++++++++++++ 4 files changed, 102 insertions(+), 44 deletions(-) create mode 100644 src/PureNix/Main/Build.hs create mode 100644 src/PureNix/Main/Run.hs diff --git a/purenix.cabal b/purenix.cabal index c07ae22..fa70ea7 100644 --- a/purenix.cabal +++ b/purenix.cabal @@ -39,6 +39,8 @@ library PureNix.Expr PureNix.Identifiers PureNix.Main + PureNix.Main.Build + PureNix.Main.Run PureNix.Prelude PureNix.Print @@ -51,6 +53,7 @@ library , microlens-platform , mtl , pretty-simple + , process , purescript ^>=0.15 , text diff --git a/src/PureNix/Main.hs b/src/PureNix/Main.hs index d393d8b..1f5e22d 100644 --- a/src/PureNix/Main.hs +++ b/src/PureNix/Main.hs @@ -1,48 +1,9 @@ -{-# LANGUAGE NoImplicitPrelude #-} +module PureNix.Main (defaultMain) where -module PureNix.Main where - -import qualified Data.Aeson as Aeson -import Data.Aeson.Types (parseEither) -import Data.Foldable (toList) -import Data.List (intercalate) -import qualified Data.Text.Lazy.IO as TL -import qualified Language.PureScript.CoreFn as P -import Language.PureScript.CoreFn.FromJSON (moduleFromJSON) -import PureNix.Convert (ModuleInfo (ModuleInfo), convert) -import PureNix.Prelude -import PureNix.Print (renderExpr) -import qualified System.Directory as Dir -import qualified System.Exit as Sys -import System.FilePath (()) -import qualified System.FilePath as FP -import System.IO +import qualified PureNix.Main.Build as Build +import qualified PureNix.Main.Run as Run defaultMain :: IO () defaultMain = do - let workdir = "." - let moduleRoot = workdir "output" - moduleDirs <- filter (not . FP.isExtensionOf "json") <$> Dir.listDirectory moduleRoot - forM_ moduleDirs $ \rel -> do - let dir = moduleRoot rel - let file = dir "corefn.json" - value <- Aeson.eitherDecodeFileStrict file >>= either Sys.die pure - (_version, module') <- either Sys.die pure $ parseEither moduleFromJSON value - let (nix, ModuleInfo usesFFI interpolations) = convert module' - TL.writeFile (dir "default.nix") (renderExpr nix) - let modulePath = P.modulePath module' - foreignSrc = workdir FP.replaceExtension modulePath "nix" - foreignTrg = dir "foreign.nix" - hasForeign <- Dir.doesFileExist foreignSrc - case (hasForeign, usesFFI) of - (True, True) -> Dir.copyFile foreignSrc foreignTrg - (True, False) -> hPutStrLn stderr $ "Warning: " <> modulePath <> " has an FFI file, but does not use FFI!" - (False, True) -> hPutStrLn stderr $ "Warning: " <> modulePath <> " calls foreign functions, but has no associated FFI file!" - (False, False) -> pure () - unless (null interpolations) $ do - hPutStrLn stderr $ - unlines - [ "Warning: " <> modulePath <> " appears to perform Nix string interpolation in the following locations:", - " " <> intercalate ", " (show <$> toList interpolations), - "Nix string interpolations are currently not officially supported and may cause unexpected behavior." - ] + Build.build + Run.getRunArg >>= mapM_ Run.run diff --git a/src/PureNix/Main/Build.hs b/src/PureNix/Main/Build.hs new file mode 100644 index 0000000..b3262a1 --- /dev/null +++ b/src/PureNix/Main/Build.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module PureNix.Main.Build where + +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (parseEither) +import Data.Foldable (toList) +import Data.List (intercalate) +import qualified Data.Text.Lazy.IO as TL +import qualified Language.PureScript.CoreFn as P +import Language.PureScript.CoreFn.FromJSON (moduleFromJSON) +import PureNix.Convert (ModuleInfo (ModuleInfo), convert) +import PureNix.Prelude +import PureNix.Print (renderExpr) +import qualified System.Directory as Dir +import qualified System.Exit as Sys +import System.FilePath (()) +import qualified System.FilePath as FP +import System.IO + +build :: IO () +build = do + let workdir = "." + let moduleRoot = workdir "output" + moduleDirs <- filter (not . FP.isExtensionOf "json") <$> Dir.listDirectory moduleRoot + forM_ moduleDirs $ \rel -> do + let dir = moduleRoot rel + let file = dir "corefn.json" + value <- Aeson.eitherDecodeFileStrict file >>= either Sys.die pure + (_version, module') <- either Sys.die pure $ parseEither moduleFromJSON value + let (nix, ModuleInfo usesFFI interpolations) = convert module' + TL.writeFile (dir "default.nix") (renderExpr nix) + let modulePath = P.modulePath module' + foreignSrc = workdir FP.replaceExtension modulePath "nix" + foreignTrg = dir "foreign.nix" + hasForeign <- Dir.doesFileExist foreignSrc + case (hasForeign, usesFFI) of + (True, True) -> Dir.copyFile foreignSrc foreignTrg + (True, False) -> hPutStrLn stderr $ "Warning: " <> modulePath <> " has an FFI file, but does not use FFI!" + (False, True) -> hPutStrLn stderr $ "Warning: " <> modulePath <> " calls foreign functions, but has no associated FFI file!" + (False, False) -> pure () + unless (null interpolations) $ do + hPutStrLn stderr $ + unlines + [ "Warning: " <> modulePath <> " appears to perform Nix string interpolation in the following locations:", + " " <> intercalate ", " (show <$> toList interpolations), + "Nix string interpolations are currently not officially supported and may cause unexpected behavior." + ] diff --git a/src/PureNix/Main/Run.hs b/src/PureNix/Main/Run.hs new file mode 100644 index 0000000..c74c025 --- /dev/null +++ b/src/PureNix/Main/Run.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Avoid lambda using `infix`" #-} + +module PureNix.Main.Run (getRunArg, run) where + +import Control.Monad +import Data.Char (isLower, isUpper) +import qualified System.Environment as Env +import qualified System.Exit as Sys +import System.Process (proc, readCreateProcessWithExitCode) + +data QualifiedFunction = QualifiedFunction + { _moduleName :: String, + _functionName :: String + } + +parseQualifiedFunction :: String -> Maybe QualifiedFunction +parseQualifiedFunction [] = Nothing +parseQualifiedFunction (c : cs) + | isUpper c = go [c] cs + | otherwise = Nothing + where + go prefix ('.' : t@(a : _)) + | isLower a = pure $ QualifiedFunction (reverse prefix) t + go prefix (a : as) = go (a : prefix) as + go _ [] = Nothing + +getRunArg :: IO (Maybe QualifiedFunction) +getRunArg = do + args <- Env.getArgs + case args of + ["--run", arg] -> case parseQualifiedFunction arg of + Nothing -> Sys.die "Parse error, argument to --run does not appear to be a valid qualified function name" + Just qf -> pure (Just qf) + _ -> pure Nothing + +run :: QualifiedFunction -> IO Sys.ExitCode +run (QualifiedFunction modName funcName) = do + putStrLn "Running test..." + (code, stdout, stderr) <- readCreateProcessWithExitCode (proc "nix-instantiate" ["--eval", "-E", show nixCommand]) "" + unless (null stdout) $ putStrLn $ "stdout: " <> stdout + unless (null stderr) $ putStrLn $ "stderr: " <> stderr + pure code + where + nixCommand = "(import ./output/" <> modName <> ")." <> funcName