Add support for --run

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
 

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

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."
+          ]

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