Optparser (#95)

* improve CLI

* update progDesc

* nicer doc

* update bower

* purescript-optparse#v0.1.0

.gitignore

@@ -12,4 +12,4 @@
 /deploy.js
 /compile.js
 /docs/_build/
-chanterelle.js
+/chanterelle.js

bower.json

@@ -14,6 +14,7 @@
     "purescript-errors": "^4.0.0",
     "purescript-node-process": "^6.0.0",
     "purescript-debug": "^4.0.0",
+    "purescript-optparse": "f-o-a-m/purescript-optparse#v0.1.0",
     "purescript-mkdirp": "joshuahhh/purescript-mkdirp#48ecb4039d5fe3be82d0e82c3a9f2338d1af82d2",
     "purescript-logging": "^3.0.0",
     "purescript-validation": "^4.0.0",

src/Chanterelle.purs

@@ -1,46 +1,116 @@
-module Chanterelle
-  ( compileMain
-  , deployMain
-  ) where
+module Chanterelle where
 
 import Prelude
 
-import Chanterelle.Compile (compileProject)
 import Chanterelle.Deploy (deploy)
-import Chanterelle.Internal.Logging (setLogLevel, readLogLevel)
-import Chanterelle.Internal.Types.Deploy (DeployM)
-import Effect (Effect)
+import Chanterelle.Internal.Codegen (generatePS) as Chanterelle
+import Chanterelle.Internal.Compile (compile) as Chanterelle
+import Chanterelle.Internal.Genesis (generateGenesis)
+import Chanterelle.Internal.Logging (LogLevel(..), log, logCompileError, logGenesisGenerationError, readLogLevel, setLogLevel)
+import Chanterelle.Internal.Types (DeployM, runCompileM)
+import Chanterelle.Internal.Types.Project (ChanterelleProject)
+import Chanterelle.Internal.Utils (jsonStringifyWithSpaces)
+import Chanterelle.Project (loadProject)
+import Control.Monad.Error.Class (try)
+import Data.Argonaut as A
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
-import Node.Yargs.Applicative (yarg, runY)
-import Node.Yargs.Setup (usage, defaultVersion, defaultHelp, example)
-
-compileMain
-  :: Effect Unit
-compileMain =
-    let setup = usage "$0 --log-level <level>"
-             <> example "$0 --log-level debug" "Run the compile phase with the given log level."
-             <> defaultVersion
-             <> defaultHelp
-    in runY setup $ go <$> yarg "log-level" [] Nothing (Left "info") false
-  where
-    go level = do
-      setLogLevel $ readLogLevel level
-      compileProject
-
-deployMain
-  :: forall a.
-     DeployM a
-  -> Effect Unit
-deployMain deployScript =
-    let setup = usage "$0 --log-level <level> --node-url <url> --timeout <seconds>"
-             <> example "$0 --log-level debug" "Run the deployment script with the given log level, node url, and timeout"
-             <> defaultVersion
-             <> defaultHelp
-    in runY setup $ go <$> yarg "log-level" [] Nothing (Left "info") false
-                       <*> yarg "node-url" [] Nothing (Left "http://localhost:8545") false
-                       <*> yarg "timeout" [] Nothing (Left 60) false
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Node.Encoding (Encoding(..))
+import Node.FS.Aff (writeTextFile)
+import Node.Path (resolve)
+import Node.Process (cwd)
+
+
+data SelectCLI a b = SelectCLI a 
+data SelectPS a b = SelectPS b
+instance showSelectDeployM :: Show (SelectPS a (DeployM Unit)) where show (SelectPS _ ) = "<DeployM Unit>"
+instance showSelectDeployPath :: Show a => Show (SelectCLI a b) where show (SelectCLI a ) = show a
+
+type ArgsCLI = Args' SelectCLI
+type Args = Args' SelectPS
+data Args' s = Args' CommonOpts (Command s)
+derive instance genericArgs :: Generic (Args' s) _
+instance showArgs :: Show (DeployOptions s) => Show (Args' s) where show = genericShow
+
+type DirPath = String
+data CommonOpts = CommonOpts
+  { optVerbosity :: String
+  , rootPath :: DirPath
+  }
+derive instance genericCommonOpts :: Generic CommonOpts _
+instance showCommonOpts :: Show CommonOpts where show = genericShow
+
+
+data Command s
+  = Build
+  | Compile
+  | Codegen
+  | Genesis GenesisOptions
+  | Deploy (DeployOptions s)
+derive instance genericCommand :: Generic (Command s) _
+instance showCommand :: Show (DeployOptions s) => Show (Command s) where show = genericShow
+
+traverseArgs :: forall a b f. Applicative f => (DeployOptions a -> f (DeployOptions b)) -> Args' a -> f (Args' b)
+traverseArgs f (Args' o cmd) = Args' o <$> case cmd of
+  Build -> pure Build
+  Compile -> pure Compile
+  Codegen -> pure Codegen
+  Genesis opts -> pure $ Genesis opts
+  Deploy dopts -> Deploy <$> f dopts
+
+data GenesisOptions = GenesisOptions
+  { input :: String
+  , output :: String
+  }
+derive instance genericGenesisOptions :: Generic GenesisOptions _
+instance showGenesisOptions :: Show GenesisOptions where show = genericShow
+
+type DeployOptionsCLI = DeployOptions SelectCLI
+
+data DeployOptions s = DeployOptions
+  { nodeURL :: String
+  , timeout :: Int
+  , script :: s String (DeployM Unit)
+  }
+derive instance genericDeployOptions :: Generic (DeployOptions s) _
+instance showDeployOptions :: Show (DeployOptions SelectPS)  where show = genericShow
+
+chanterelle :: Args -> Aff Unit
+chanterelle (Args' (CommonOpts{ optVerbosity, rootPath }) cmd) = do
+  ourCwd <- liftEffect cwd
+  liftEffect $ setLogLevel (readLogLevel optVerbosity)
+  resolvedRoot <- liftEffect $ resolve [ourCwd] rootPath
+  projE <- try $ loadProject resolvedRoot
+  case projE of
+    Left err -> log Error ("Couldn't parse chanterelle.json: " <> show err)
+    Right project -> do
+      log Info "Loaded chanterelle.json successfully!"
+      runCommand project cmd
+
+runCommand :: ChanterelleProject -> Command SelectPS -> Aff Unit
+runCommand project = case _ of
+    Build -> doCompile *> doCodegen
+    Compile -> doCompile
+    Codegen -> doCodegen
+    Genesis opts -> doGenesis opts
+    Deploy opts -> doDeploy opts
   where
-    go level nodeUrl timeout = do
-      setLogLevel $ readLogLevel level
-      deploy nodeUrl timeout deployScript
+    doDeploy (DeployOptions {nodeURL, timeout, script: SelectPS s}) = do
+      deploy nodeURL timeout s
+    doClassicBuild = doCompile *> doCodegen
+    doCompile = runCompileM Chanterelle.compile project >>= case _ of
+      Left err -> logCompileError err
+      Right _ -> pure unit
+    doCodegen = runCompileM Chanterelle.generatePS project >>= case _ of
+      Left err -> logCompileError err
+      Right _ -> pure unit
+    doGenesis (GenesisOptions {input,output}) = generateGenesis project input >>= case _ of
+      Left err -> logGenesisGenerationError err
+      Right gb -> do
+        let strungGb = jsonStringifyWithSpaces 4 (A.encodeJson gb)
+        try (writeTextFile UTF8 output strungGb) >>= case _ of
+          Left err -> log Error $ "Couldn't write genesis block to " <> show output <> ": " <> show err
+          Right _  -> log Info $ "Successfully wrote generated genesis block to " <> show output

src/Chanterelle/Deploy.purs

@@ -12,36 +12,32 @@ import Chanterelle.Internal.Types (runDeployM) as Exports
 import Chanterelle.Internal.Types.Deploy ((??)) as Exports
 import Chanterelle.Internal.Types.Deploy (DeployM, runDeployM)
 import Chanterelle.Internal.Utils (makeDeployConfigWithProvider, makeProvider)
-import Effect.Aff (launchAff, throwError)
-import Effect (Effect)
-import Effect.Exception (error, throw)
 import Control.Monad.Except (runExceptT)
 import Data.Either (Either(..))
+import Effect.Aff (Aff, throwError)
+import Effect.Class (liftEffect)
+import Effect.Exception (error, throw)
 import Network.Ethereum.Web3 (Provider)
 
 -- | Run an arbitrary deployment script in the DeployM monad
 deploy
-  :: forall a.
-     String
+  :: String
   -> Int
-  -> DeployM a
-  -> Effect Unit
+  -> DeployM ~> Aff
 deploy url tout deployScript = 
   runExceptT (makeProvider url) >>= case _ of
     Left err -> do
       logDeployError err
-      throw "DeployM error"
+      liftEffect $ throw "DeployM error"
     Right provider -> do
       deployWithProvider provider tout deployScript
 
 -- | Run an arbitrary deployment script in the DeployM monad against a specified Provider
 deployWithProvider
-  :: forall a.
-     Provider
+  :: Provider
   -> Int
-  -> DeployM a
-  -> Effect Unit
-deployWithProvider provider tout deployScript = void <<< launchAff $ do
+  -> DeployM ~> Aff
+deployWithProvider provider tout deployScript = do
   edeployConfig <- runExceptT $ makeDeployConfigWithProvider provider tout
   case edeployConfig of
     Left err -> do

src/ChanterelleMain.js

@@ -0,0 +1,5 @@
+exports.loadDeployMFromScriptPath = function (filePath) {
+  return function () {
+    return require(filePath).deploy;
+  };
+};