digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-20 01:07:18 +03:00
Code Issues Projects Releases Wiki Activity

Added daml assistant exec command. (#543)

Browse Source 
* Added daml assistant exec command.

* Fix lint.

* Forward -h and --help as well.
This commit is contained in:
Fran 2019-04-16 17:24:54 +02:00 committed by GitHub
parent 40d77c3b9d
commit 463029a078
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
daml-assistant/src/DAML/Assistant.hs
View File

@ -16,6 +16,7 @@ import DAML.Assistant.Command
import DAML.Assistant.Install
import DAML.Assistant.Util
import System.FilePath
import System.Directory
import System.Process
import System.Exit
import Control.Exception.Safe
@ -37,13 +38,21 @@ main = do
Builtin (Install options) -> wrapErr "Installing the SDK." $ do
install options envDamlPath envProjectPath
Builtin (Exec cmd args) ->
wrapErr "Running executable in daml environment." $ do
path <- fromMaybe cmd <$> findExecutable cmd
exitWith =<< dispatch env path args
Dispatch SdkCommandInfo{..} cmdArgs ->
wrapErr ("Running " <> unwrapSdkCommandName sdkCommandName <> " command.") $ do
sdkPath <- required "Could not determine SDK path." envSdkPath
dispatchEnv <- getDispatchEnv env
let path = unwrapSdkPath sdkPath </> unwrapSdkCommandPath sdkCommandPath
args = unwrapSdkCommandArgs sdkCommandArgs ++ unwrapUserCommandArgs cmdArgs
process = (proc path args) { env = Just dispatchEnv }
exitCodeE <- tryIO $ withCreateProcess process (\ _ _ _ -> waitForProcess)
exitCode <- requiredE "Failed to spawn command subprocess." exitCodeE
exitWith exitCode
exitWith =<< dispatch env path args
dispatch :: Env -> FilePath -> [String] -> IO ExitCode
dispatch env path args = do
dispatchEnv <- getDispatchEnv env
requiredIO "Failed to spawn command subprocess." $
withCreateProcess (proc path args) { env = Just dispatchEnv }
(\ _ _ _ -> waitForProcess)

12
daml-assistant/src/DAML/Assistant/Command.hs
View File

@ -28,9 +28,9 @@ subcommand :: Text -> Text -> InfoMod Command -> Parser Command -> Mod CommandFi
subcommand name desc infoMod parser =
command (unpack name) (info parser (infoMod <> progDesc (unpack desc)))
builtin :: Text -> Text -> Parser BuiltinCommand -> Mod CommandFields Command
builtin name desc parser =
subcommand name desc mempty (Builtin <$> parser <**> helper)
builtin :: Text -> Text -> InfoMod Command -> Parser BuiltinCommand -> Mod CommandFields Command
builtin name desc mod parser =
subcommand name desc mod (Builtin <$> parser)
isHidden :: SdkCommandInfo -> Bool
isHidden = isNothing . sdkCommandDesc
@ -46,8 +46,10 @@ dispatch info = subcommand
commandParser :: [SdkCommandInfo] -> Parser Command
commandParser cmds | (hidden, visible) <- partition isHidden cmds = asum
[ subparser -- visible commands
$ builtin "version" "Display SDK version" (pure Version)
<> builtin "install" "Install SDK version" (Install <$> installParser)
$ builtin "version" "Display SDK version" mempty (pure Version <**> helper)
<> builtin "install" "Install SDK version" mempty (Install <$> installParser <**> helper)
<> builtin "exec" "Execute command with daml environment." forwardOptions
(Exec <$> strArgument (metavar "CMD") <*> many (strArgument (metavar "ARGS")))
<> foldMap dispatch visible
, subparser -- hidden commands
$ internal

1
daml-assistant/src/DAML/Assistant/Types.hs
View File

@ -50,6 +50,7 @@ data Env = Env
data BuiltinCommand
= Version
| Exec String [String]
| Install InstallOptions
deriving (Eq, Show)