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

daml-assistant/daml-helper/src/DA/Daml/Helper/Main.hs

@@ -61,20 +61,9 @@ data Command
     | Init { targetFolderM :: Maybe FilePath }
     | ListTemplates
     | Start
-      { sandboxPortM :: Maybe SandboxPortSpec
+        { startOptions :: StartOptions
-      , openBrowser :: OpenBrowser
+        , shutdownStdinClose :: Bool
-      , startNavigator :: Maybe StartNavigator
+        }
-      , navigatorPort :: NavigatorPort
-      , jsonApiCfg :: JsonApiConfig
-      , onStartM :: Maybe String
-      , waitForSignal :: WaitForSignal
-      , sandboxOptions :: SandboxOptions
-      , navigatorOptions :: NavigatorOptions
-      , jsonApiOptions :: JsonApiOptions
-      , scriptOptions :: ScriptOptions
-      , shutdownStdinClose :: Bool
-      , sandboxClassic :: SandboxClassic
-      }
     | 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
+    startCmd = do
-        <$> optional (option (maybeReader (toSandboxPortSpec <=< readMaybe)) (long "sandbox-port" <> metavar "PORT_NUM" <> help "Port number for the sandbox"))
+        sandboxPortM <- 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)
+        shouldOpenBrowser <- flagYesNoAuto "open-browser" True "Open the browser after navigator" idm
-        <*> optional navigatorFlag
+        shouldStartNavigator <- flagYesNoAuto' "start-navigator" "Start navigator as part of daml start. Can be set to true or false. Defaults to true." idm
-        <*> navigatorPortOption
+        navigatorPort <- navigatorPortOption
-        <*> jsonApiCfg
+        jsonApiConfig <- jsonApiCfg
-        <*> optional (option str (long "on-start" <> metavar "COMMAND" <> help "Command to run once sandbox and navigator are running."))
+        onStartM <- 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)
+        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")))
+        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")))
+        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")))
+        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")))
+        scriptOptions <- many (strOption (long "script-option" <> metavar "SCRIPT_OPTION" <> help "Pass option to Daml script interpreter"))
-        <*> stdinCloseOpt
+        shutdownStdinClose <- stdinCloseOpt
-        <*> (SandboxClassic <$> switch (long "sandbox-classic" <> help "Deprecated. Run with Sandbox Classic."))
+        sandboxClassic <- SandboxClassic <$> switch (long "sandbox-classic" <> help "Deprecated. Run with Sandbox Classic.")
-
+        pure $ Start StartOptions{..} shutdownStdinClose
-    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."
 
     navigatorPortOption = NavigatorPort <$> option auto
         (long "navigator-port"
@@ -475,19 +448,7 @@ runCommand = \case
     ListTemplates -> runListTemplates
     Start {..} ->
         (if shutdownStdinClose then withCloseOnStdin else id) $
-        runStart
+        runStart startOptions
-            sandboxPortM
-            startNavigator
-            navigatorPort
-            jsonApiCfg
-            openBrowser
-            onStartM
-            waitForSignal
-            sandboxOptions
-            navigatorOptions
-            jsonApiOptions
-            scriptOptions
-            sandboxClassic
     Deploy {..} -> runDeploy flags
     LedgerListParties {..} -> runLedgerListParties flags json
     PackagesList {..} -> runLedgerListPackages0 flags

daml-assistant/daml-helper/src/DA/Daml/Helper/Start.hs

@@ -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
+runStart :: StartOptions -> IO ()
-    :: Maybe SandboxPortSpec
+runStart StartOptions{..} =
-    -> Maybe StartNavigator
+  withProjectRoot Nothing (ProjectCheck "daml start" True) $ \_ _ -> do
-    -> 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
     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
+    shouldStartNavigator :: Bool <-
-        -- If an option is passed explicitly, we use it, otherwise we read daml.yaml.
+      determineAutoM (fmap (fromMaybe True) $
-        Nothing ->
+        requiredE "Failed to parse start-navigator" $
-            fmap (fromMaybe True) $
+        queryProjectConfig ["start-navigator"] projectConfig)
-            requiredE "Failed to parse start-navigator" $
+        shouldStartNavigator
-            queryProjectConfig ["start-navigator"] projectConfig
+    sandboxOpts <- withOptsFromProjectConfig "sandbox-options" sandboxOptions projectConfig
-        Just (StartNavigator explicit) -> pure explicit
+    navigatorOpts <- withOptsFromProjectConfig "navigator-options" navigatorOptions projectConfig
-    sandboxOpts <- withOptsFromProjectConfig "sandbox-options" sandboxOpts projectConfig
+    jsonApiOpts <- withOptsFromProjectConfig "json-api-options" jsonApiOptions projectConfig
-    navigatorOpts <- withOptsFromProjectConfig "navigator-options" navigatorOpts projectConfig
+    scriptOpts <- withOptsFromProjectConfig "script-options" scriptOptions projectConfig
-    jsonApiOpts <- withOptsFromProjectConfig "json-api-options" jsonApiOpts projectConfig
-    scriptOpts <- withOptsFromProjectConfig "script-options" scriptOpts 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 =

libs-haskell/da-hs-base/src/Options/Applicative/Extended.hs

@@ -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.