mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Refactor daml start options, add true/false to yes/no/auto flags. (#12169)
* Refactor daml start & add true/false to yesNoAuto. - Refactor the way we pass arguments to daml start. We were relying on positional arguments with newtypes, but this is super cumbersome. I changed it to a RecordWildCards-style approach, where we don't need quite so many newtypes, and no more positional arguments. - "--start-navigator" flag had some custom logic to accept "true" and "false". I don't see why we can't just accept "true" and "false" anywhere we use the "yes/no/auto" flags, so I just changed that and got rid of the custom logic. - The way "auto" was handled for this flag was incorrect, since "auto" is supposed to be equivalent the default, i.e. not passing any flag. I changed it so auto is equivalent to not passing an argument. (I.e. it looks in daml.yaml for the start-navigator option). changelog_begin changelog_end * dont pass in shutdownStdinClose to runStart
This commit is contained in:
parent
1ed02369eb
commit
8b05a533ce
@ -61,20 +61,9 @@ data Command
|
||||
| Init { targetFolderM :: Maybe FilePath }
|
||||
| ListTemplates
|
||||
| Start
|
||||
{ sandboxPortM :: Maybe SandboxPortSpec
|
||||
, openBrowser :: OpenBrowser
|
||||
, startNavigator :: Maybe StartNavigator
|
||||
, navigatorPort :: NavigatorPort
|
||||
, jsonApiCfg :: JsonApiConfig
|
||||
, onStartM :: Maybe String
|
||||
, waitForSignal :: WaitForSignal
|
||||
, sandboxOptions :: SandboxOptions
|
||||
, navigatorOptions :: NavigatorOptions
|
||||
, jsonApiOptions :: JsonApiOptions
|
||||
, scriptOptions :: ScriptOptions
|
||||
, shutdownStdinClose :: Bool
|
||||
, sandboxClassic :: SandboxClassic
|
||||
}
|
||||
{ startOptions :: StartOptions
|
||||
, shutdownStdinClose :: Bool
|
||||
}
|
||||
| Deploy { flags :: LedgerFlags }
|
||||
| LedgerListParties { flags :: LedgerFlags, json :: JsonFlag }
|
||||
| LedgerAllocateParties { flags :: LedgerFlags, parties :: [String] }
|
||||
@ -166,37 +155,21 @@ commandParser = subparser $ fold
|
||||
initCmd = Init
|
||||
<$> optional (argument str (metavar "TARGET_PATH" <> help "Project folder to initialize."))
|
||||
|
||||
startCmd = Start
|
||||
<$> optional (option (maybeReader (toSandboxPortSpec <=< readMaybe)) (long "sandbox-port" <> metavar "PORT_NUM" <> help "Port number for the sandbox"))
|
||||
<*> (OpenBrowser <$> flagYesNoAuto "open-browser" True "Open the browser after navigator" idm)
|
||||
<*> optional navigatorFlag
|
||||
<*> navigatorPortOption
|
||||
<*> jsonApiCfg
|
||||
<*> optional (option str (long "on-start" <> metavar "COMMAND" <> help "Command to run once sandbox and navigator are running."))
|
||||
<*> (WaitForSignal <$> flagYesNoAuto "wait-for-signal" True "Wait for Ctrl+C or interrupt after starting servers." idm)
|
||||
<*> (SandboxOptions <$> many (strOption (long "sandbox-option" <> metavar "SANDBOX_OPTION" <> help "Pass option to sandbox")))
|
||||
<*> (NavigatorOptions <$> many (strOption (long "navigator-option" <> metavar "NAVIGATOR_OPTION" <> help "Pass option to navigator")))
|
||||
<*> (JsonApiOptions <$> many (strOption (long "json-api-option" <> metavar "JSON_API_OPTION" <> help "Pass option to HTTP JSON API")))
|
||||
<*> (ScriptOptions <$> many (strOption (long "script-option" <> metavar "SCRIPT_OPTION" <> help "Pass option to Daml script interpreter")))
|
||||
<*> stdinCloseOpt
|
||||
<*> (SandboxClassic <$> switch (long "sandbox-classic" <> help "Deprecated. Run with Sandbox Classic."))
|
||||
|
||||
navigatorFlag =
|
||||
-- We do not use flagYesNoAuto here since that doesn’t allow us to differentiate
|
||||
-- if the flag was passed explicitly or not.
|
||||
StartNavigator <$>
|
||||
option reader (long "start-navigator" <> help helpText <> completeWith ["true", "false"] <> idm)
|
||||
where
|
||||
reader = eitherReader $ \case
|
||||
-- We allow for both yes and true since we want a boolean in daml.yaml
|
||||
"true" -> Right True
|
||||
"yes" -> Right True
|
||||
"false" -> Right False
|
||||
"no" -> Right False
|
||||
"auto" -> Right True
|
||||
s -> Left ("Expected \"yes\", \"true\", \"no\", \"false\" or \"auto\" but got " <> show s)
|
||||
-- To make things less confusing, we do not mention yes, no and auto here.
|
||||
helpText = "Start navigator as part of daml start. Can be set to true or false. Defaults to true."
|
||||
startCmd = do
|
||||
sandboxPortM <- optional (option (maybeReader (toSandboxPortSpec <=< readMaybe)) (long "sandbox-port" <> metavar "PORT_NUM" <> help "Port number for the sandbox"))
|
||||
shouldOpenBrowser <- flagYesNoAuto "open-browser" True "Open the browser after navigator" idm
|
||||
shouldStartNavigator <- flagYesNoAuto' "start-navigator" "Start navigator as part of daml start. Can be set to true or false. Defaults to true." idm
|
||||
navigatorPort <- navigatorPortOption
|
||||
jsonApiConfig <- jsonApiCfg
|
||||
onStartM <- optional (option str (long "on-start" <> metavar "COMMAND" <> help "Command to run once sandbox and navigator are running."))
|
||||
shouldWaitForSignal <- flagYesNoAuto "wait-for-signal" True "Wait for Ctrl+C or interrupt after starting servers." idm
|
||||
sandboxOptions <- many (strOption (long "sandbox-option" <> metavar "SANDBOX_OPTION" <> help "Pass option to sandbox"))
|
||||
navigatorOptions <- many (strOption (long "navigator-option" <> metavar "NAVIGATOR_OPTION" <> help "Pass option to navigator"))
|
||||
jsonApiOptions <- many (strOption (long "json-api-option" <> metavar "JSON_API_OPTION" <> help "Pass option to HTTP JSON API"))
|
||||
scriptOptions <- many (strOption (long "script-option" <> metavar "SCRIPT_OPTION" <> help "Pass option to Daml script interpreter"))
|
||||
shutdownStdinClose <- stdinCloseOpt
|
||||
sandboxClassic <- SandboxClassic <$> switch (long "sandbox-classic" <> help "Deprecated. Run with Sandbox Classic.")
|
||||
pure $ Start StartOptions{..} shutdownStdinClose
|
||||
|
||||
navigatorPortOption = NavigatorPort <$> option auto
|
||||
(long "navigator-port"
|
||||
@ -475,19 +448,7 @@ runCommand = \case
|
||||
ListTemplates -> runListTemplates
|
||||
Start {..} ->
|
||||
(if shutdownStdinClose then withCloseOnStdin else id) $
|
||||
runStart
|
||||
sandboxPortM
|
||||
startNavigator
|
||||
navigatorPort
|
||||
jsonApiCfg
|
||||
openBrowser
|
||||
onStartM
|
||||
waitForSignal
|
||||
sandboxOptions
|
||||
navigatorOptions
|
||||
jsonApiOptions
|
||||
scriptOptions
|
||||
sandboxClassic
|
||||
runStart startOptions
|
||||
Deploy {..} -> runDeploy flags
|
||||
LedgerListParties {..} -> runLedgerListParties flags json
|
||||
PackagesList {..} -> runLedgerListPackages0 flags
|
||||
|
@ -8,19 +8,13 @@ module DA.Daml.Helper.Start
|
||||
, withSandbox
|
||||
, withNavigator
|
||||
|
||||
, StartOptions(..)
|
||||
, NavigatorPort(..)
|
||||
, SandboxPort(..)
|
||||
, SandboxPortSpec(..)
|
||||
, toSandboxPortSpec
|
||||
, JsonApiPort(..)
|
||||
, JsonApiConfig(..)
|
||||
, OpenBrowser(..)
|
||||
, StartNavigator(..)
|
||||
, WaitForSignal(..)
|
||||
, SandboxOptions(..)
|
||||
, NavigatorOptions(..)
|
||||
, JsonApiOptions(..)
|
||||
, ScriptOptions(..)
|
||||
, SandboxClassic(..)
|
||||
) where
|
||||
|
||||
@ -46,6 +40,8 @@ import Web.Browser
|
||||
import qualified Web.JWT as JWT
|
||||
import Data.Aeson
|
||||
|
||||
import Options.Applicative.Extended (YesNoAuto, determineAutoM)
|
||||
|
||||
import DA.Daml.Helper.Codegen
|
||||
import DA.Daml.Helper.Ledger
|
||||
import DA.Daml.Helper.Util
|
||||
@ -153,23 +149,10 @@ withJsonApi (SandboxPort sandboxPort) (JsonApiPort jsonApiPort) extraArgs a = do
|
||||
waitForHttpServer (putStr "." *> threadDelay 500000) ("http://localhost:" <> show jsonApiPort <> "/v1/query") headers
|
||||
a ph
|
||||
|
||||
-- | Whether `daml start` should open a browser automatically.
|
||||
newtype OpenBrowser = OpenBrowser Bool
|
||||
|
||||
-- | Whether `daml start` should start the navigator automatically.
|
||||
newtype StartNavigator = StartNavigator Bool
|
||||
|
||||
data JsonApiConfig = JsonApiConfig
|
||||
{ mbJsonApiPort :: Maybe JsonApiPort -- If Nothing, don’t start the JSON API
|
||||
}
|
||||
|
||||
-- | Whether `daml start` should wait for Ctrl+C or interrupt after starting servers.
|
||||
newtype WaitForSignal = WaitForSignal Bool
|
||||
|
||||
newtype SandboxOptions = SandboxOptions [String]
|
||||
newtype NavigatorOptions = NavigatorOptions [String]
|
||||
newtype JsonApiOptions = JsonApiOptions [String]
|
||||
newtype ScriptOptions = ScriptOptions [String]
|
||||
newtype SandboxClassic = SandboxClassic { unSandboxClassic :: Bool }
|
||||
|
||||
withOptsFromProjectConfig :: T.Text -> [String] -> ProjectConfig -> IO [String]
|
||||
@ -180,35 +163,24 @@ withOptsFromProjectConfig fieldName cliOpts projectConfig = do
|
||||
queryProjectConfig [fieldName] projectConfig
|
||||
pure (optsYaml ++ cliOpts)
|
||||
|
||||
data StartOptions = StartOptions
|
||||
{ sandboxPortM :: Maybe SandboxPortSpec
|
||||
, shouldOpenBrowser :: Bool
|
||||
, shouldStartNavigator :: YesNoAuto
|
||||
, navigatorPort :: NavigatorPort
|
||||
, jsonApiConfig :: JsonApiConfig
|
||||
, onStartM :: Maybe String
|
||||
, shouldWaitForSignal :: Bool
|
||||
, sandboxOptions :: [String]
|
||||
, navigatorOptions :: [String]
|
||||
, jsonApiOptions :: [String]
|
||||
, scriptOptions :: [String]
|
||||
, sandboxClassic :: SandboxClassic
|
||||
}
|
||||
|
||||
runStart
|
||||
:: Maybe SandboxPortSpec
|
||||
-> Maybe StartNavigator
|
||||
-> NavigatorPort
|
||||
-> JsonApiConfig
|
||||
-> OpenBrowser
|
||||
-> Maybe String
|
||||
-> WaitForSignal
|
||||
-> SandboxOptions
|
||||
-> NavigatorOptions
|
||||
-> JsonApiOptions
|
||||
-> ScriptOptions
|
||||
-> SandboxClassic
|
||||
-> IO ()
|
||||
runStart
|
||||
sandboxPortM
|
||||
mbStartNavigator
|
||||
navigatorPort
|
||||
(JsonApiConfig mbJsonApiPort)
|
||||
(OpenBrowser shouldOpenBrowser)
|
||||
onStartM
|
||||
(WaitForSignal shouldWaitForSignal)
|
||||
(SandboxOptions sandboxOpts)
|
||||
(NavigatorOptions navigatorOpts)
|
||||
(JsonApiOptions jsonApiOpts)
|
||||
(ScriptOptions scriptOpts)
|
||||
sandboxClassic
|
||||
= withProjectRoot Nothing (ProjectCheck "daml start" True) $ \_ _ -> do
|
||||
runStart :: StartOptions -> IO ()
|
||||
runStart StartOptions{..} =
|
||||
withProjectRoot Nothing (ProjectCheck "daml start" True) $ \_ _ -> do
|
||||
projectConfig <- getProjectConfig Nothing
|
||||
darPath <- getDarPath
|
||||
mbScenario :: Maybe String <-
|
||||
@ -217,17 +189,15 @@ runStart
|
||||
mbInitScript :: Maybe String <-
|
||||
requiredE "Failed to parse init-script" $
|
||||
queryProjectConfig ["init-script"] projectConfig
|
||||
shouldStartNavigator :: Bool <- case mbStartNavigator of
|
||||
-- If an option is passed explicitly, we use it, otherwise we read daml.yaml.
|
||||
Nothing ->
|
||||
fmap (fromMaybe True) $
|
||||
requiredE "Failed to parse start-navigator" $
|
||||
queryProjectConfig ["start-navigator"] projectConfig
|
||||
Just (StartNavigator explicit) -> pure explicit
|
||||
sandboxOpts <- withOptsFromProjectConfig "sandbox-options" sandboxOpts projectConfig
|
||||
navigatorOpts <- withOptsFromProjectConfig "navigator-options" navigatorOpts projectConfig
|
||||
jsonApiOpts <- withOptsFromProjectConfig "json-api-options" jsonApiOpts projectConfig
|
||||
scriptOpts <- withOptsFromProjectConfig "script-options" scriptOpts projectConfig
|
||||
shouldStartNavigator :: Bool <-
|
||||
determineAutoM (fmap (fromMaybe True) $
|
||||
requiredE "Failed to parse start-navigator" $
|
||||
queryProjectConfig ["start-navigator"] projectConfig)
|
||||
shouldStartNavigator
|
||||
sandboxOpts <- withOptsFromProjectConfig "sandbox-options" sandboxOptions projectConfig
|
||||
navigatorOpts <- withOptsFromProjectConfig "navigator-options" navigatorOptions projectConfig
|
||||
jsonApiOpts <- withOptsFromProjectConfig "json-api-options" jsonApiOptions projectConfig
|
||||
scriptOpts <- withOptsFromProjectConfig "script-options" scriptOptions projectConfig
|
||||
doBuild
|
||||
doCodegen projectConfig
|
||||
let scenarioArgs = maybe [] (\scenario -> ["--scenario", scenario]) mbScenario
|
||||
@ -266,7 +236,7 @@ runStart
|
||||
then withNavigator
|
||||
else (\_ _ _ f -> f sandboxPh)
|
||||
withJsonApi' sandboxPh sandboxPort args f =
|
||||
case mbJsonApiPort of
|
||||
case mbJsonApiPort jsonApiConfig of
|
||||
Nothing -> f sandboxPh
|
||||
Just jsonApiPort -> withJsonApi sandboxPort jsonApiPort args f
|
||||
doCodegen projectConfig =
|
||||
|
@ -7,6 +7,7 @@ module Options.Applicative.Extended
|
||||
, flagYesNoAuto
|
||||
, flagYesNoAuto'
|
||||
, determineAuto
|
||||
, determineAutoM
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
@ -25,16 +26,25 @@ determineAuto b = \case
|
||||
Auto -> b
|
||||
Yes -> True
|
||||
|
||||
-- | Convert YesNoAuto value to Bool by specifying how default value for Auto should be determined, in a monad.
|
||||
determineAutoM :: Monad m => m Bool -> YesNoAuto -> m Bool
|
||||
determineAutoM m = \case
|
||||
No -> pure False
|
||||
Auto -> m
|
||||
Yes -> pure True
|
||||
|
||||
-- | This constructs flags that can be set to yes, no, or auto, with auto being the default.
|
||||
-- This maps yes to "Just true", no to "Just False" and auto to "Nothing"
|
||||
flagYesNoAuto' :: String -> String -> Mod OptionFields YesNoAuto -> Parser YesNoAuto
|
||||
flagYesNoAuto' flagName helpText mods =
|
||||
option reader (long flagName <> value Auto <> help helpText <> completeWith ["yes", "no", "auto"] <> mods)
|
||||
option reader (long flagName <> value Auto <> help helpText <> completeWith ["true", "false", "yes", "no", "auto"] <> mods)
|
||||
where reader = eitherReader $ \case
|
||||
"yes" -> Right Yes
|
||||
"true" -> Right Yes
|
||||
"no" -> Right No
|
||||
"false" -> Right No
|
||||
"auto" -> Right Auto
|
||||
s -> Left ("Expected \"yes\", \"no\" or \"auto\" but got " <> show s)
|
||||
s -> Left ("Expected \"yes\", \"true\", \"no\", \"false\", or \"auto\" but got " <> show s)
|
||||
|
||||
-- | This constructs flags that can be set to yes, no, or auto to control a boolean value
|
||||
-- with auto using the default.
|
||||
|
Loading…
Reference in New Issue
Block a user