Merge pull request #89 from f-o-a-m/non-zero-exits

throw an exception at top level in case of left
f-o-a-m · Dec 14, 2018 · c4fca1b · c4fca1b
2 parents 028cc1c + 4edd7e1
commit c4fca1b
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 19 deletions.
diff --git a/src/Chanterelle/Compile.purs b/src/Chanterelle/Compile.purs
@@ -1,16 +1,17 @@
 module Chanterelle.Compile (compileProject) where
 
 import Prelude
-import Chanterelle.Project (loadProject)
+
 import Chanterelle.Internal.Codegen (generatePS) as Chanterelle
 import Chanterelle.Internal.Compile (compile) as Chanterelle
 import Chanterelle.Internal.Logging (logCompileError)
 import Chanterelle.Internal.Types.Compile (CompileError(..), runCompileM)
+import Chanterelle.Project (loadProject)
 import Control.Monad.Aff (launchAff)
 import Control.Monad.Aff.Console (CONSOLE)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Exception (message)
+import Control.Monad.Eff.Exception (EXCEPTION, message, throw)
 import Control.Monad.Error.Class (try)
 import Data.Either (Either(..))
 import Node.FS (FS)
@@ -19,17 +20,21 @@ import Node.Process as P
 
 compileProject
   :: forall e.
-     Eff (console :: CONSOLE, fs :: FS, process :: PROCESS | e) Unit
+     Eff (console :: CONSOLE, fs :: FS, process :: PROCESS, exception :: EXCEPTION | e) Unit
 compileProject = do
     root <- liftEff P.cwd
     void $ launchAff $ do
       proj <- try $ loadProject root
       case proj of
-        Left err -> logCompileError $ MalformedProjectError (message err)
+        Left err -> do
+          logCompileError $ MalformedProjectError (message err)
+          liftEff $ throw "LoadProject Error"
         Right project -> do
           eres <- flip runCompileM project $ do
             _ <- Chanterelle.compile
             Chanterelle.generatePS
           case eres of
             Right _ -> pure unit
-            Left err -> logCompileError err
+            Left err -> do
+              logCompileError err
+              liftEff $ throw "Compile Error"
diff --git a/src/Chanterelle/Deploy.purs b/src/Chanterelle/Deploy.purs
@@ -15,7 +15,8 @@ import Chanterelle.Internal.Utils (makeDeployConfigWithProvider, makeProvider)
 import Control.Monad.Aff (launchAff, throwError)
 import Control.Monad.Aff.Console (CONSOLE)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Exception (error)
+import Control.Monad.Eff.Exception (EXCEPTION, error, throw)
+import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
 import Control.Monad.Except (runExceptT)
 import Data.Either (Either(..))
 import Network.Ethereum.Web3 (ETH, Provider)
@@ -27,11 +28,14 @@ deploy
      String
   -> Int
   -> DeployM eff a
-  -> Eff (console :: CONSOLE, eth :: ETH, fs :: FS | eff) Unit
-deploy url tout deployScript = 
+  -> Eff (console :: CONSOLE, eth :: ETH, fs :: FS, exception :: EXCEPTION | eff) Unit
+deploy url tout deployScript =
   runExceptT (makeProvider url) >>= case _ of
-    Left err -> logDeployError err
-    Right provider -> deployWithProvider provider tout deployScript
+    Left err -> do
+      logDeployError err
+      throw "DeployM error"
+    Right provider ->  unsafeCoerceEff $
+      deployWithProvider provider tout deployScript
 
 -- | Run an arbitrary deployment script in the DeployM monad against a specified Provider
 deployWithProvider
@@ -43,9 +47,11 @@ deployWithProvider
 deployWithProvider provider tout deployScript = void <<< launchAff $ do
   edeployConfig <- runExceptT $ makeDeployConfigWithProvider provider tout
   case edeployConfig of
-    Left err -> logDeployError err *> throwError (error "Error in building DeployConfig!")
+    Left err -> do
+      logDeployError err
+      throwError (error "Error in building DeployConfig!")
     Right deployConfig -> do
       eDeployResult <- runDeployM deployScript deployConfig
       case eDeployResult of
         Left err -> logDeployError err *> throwError (error "Error during deployment!")
-        Right a -> pure a
+        Right a -> pure a
diff --git a/src/Chanterelle/Genesis.purs b/src/Chanterelle/Genesis.purs
@@ -7,12 +7,12 @@ import Chanterelle.Internal.Logging (LogLevel(..), log, logGenesisGenerationErro
 import Chanterelle.Internal.Types.Genesis (GenesisGenerationError(MalformedProjectErrorG))
 import Chanterelle.Internal.Utils.Json (jsonStringifyWithSpaces)
 import Chanterelle.Project (loadProject)
-import Control.Monad.Aff (launchAff)
+import Control.Monad.Aff (error, launchAff, throwError)
 import Control.Monad.Aff.Class (liftAff)
 import Control.Monad.Aff.Console (CONSOLE)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Exception (message)
+import Control.Monad.Eff.Exception (EXCEPTION, message)
 import Control.Monad.Error.Class (try)
 import Data.Argonaut as A
 import Data.Either (Either(..))
@@ -25,16 +25,27 @@ import Node.Process (PROCESS)
 import Node.Process as P
 import Prelude (Unit, bind, show, void, ($), (<<<), (<>), (>>=))
 
-runGenesisGenerator :: forall e. FilePath -> FilePath -> Eff (console :: CONSOLE, fs :: FS, process :: PROCESS, eth :: ETH | e) Unit
+runGenesisGenerator
+  :: forall e.
+     FilePath
+  -> FilePath
+  -> Eff (console :: CONSOLE, fs :: FS, process :: PROCESS, eth :: ETH, exception :: EXCEPTION | e) Unit
 runGenesisGenerator genesisIn genesisOut = do
     root <- liftEff P.cwd
     void <<< launchAff $
       (try $ loadProject root) >>= case _ of
-        Left err -> liftAff <<< logGenesisGenerationError $ MalformedProjectErrorG (message err)
-        Right project -> (liftAff $ generateGenesis project genesisIn) >>= case _ of
+        Left err -> liftAff $ do
+          _ <- logGenesisGenerationError $ MalformedProjectErrorG (message err)
+          throwError $ error "LoadProject Error"
+        Right project -> liftAff $
+          generateGenesis project genesisIn >>= case _ of
             Right gb -> do
                 let strungGb = jsonStringifyWithSpaces 4 (A.encodeJson gb)
                 try (FS.writeTextFile UTF8 genesisOut strungGb) >>= case _ of
-                    Left err -> log Error $ "Couldn't write genesis block to " <> show genesisOut <> ": " <> show err
+                    Left err -> do
+                      _ <- log Error $ "Couldn't write genesis block to " <> show genesisOut <> ": " <> show err
+                      throwError $ error "WriteGenesis Error"
                     Right _  -> log Info $ "Successfully wrote generated genesis block to " <> show genesisOut
-            Left err -> liftAff $ logGenesisGenerationError err
+            Left err -> do
+              _ <- logGenesisGenerationError err
+              throwError $ error "GenerateGenesis Error"