daml-assistant: Install bash completion scripts on Linux and Mac. (#3946)

* Improve bash completions for daml-assistant.

* Install bash completion script automatically

* Better default logic for bash completions

* specifically -> explicitly

* Copyright headers

* Better hook logic and refactoring

* Handle non-standard installations more robustly.

* Handle CI env & add changelog note.

CHANGELOG_BEGIN

- [DAML Assistant] Bash completions for the DAML assistant are now
available via ``daml install``. These will be installed automatically
on Linux and Mac. If you use bash and have bash completions installed,
these bash completions let you use the tab key to autocomplete
many DAML Assistant commands, such as ``daml install`` and
``daml version``.

CHANGELOG_END

* Mention bash completion in assistant docs

* Remove promises

daml-assistant/exe/DA/Daml/Assistant.hs

@@ -56,10 +56,10 @@ main = displayErrors $ do
                     ]
                 exitFailure
 
-            versionChecks env
             sdkConfig <- readSdkConfig (fromJust envSdkPath)
             sdkCommands <- fromRightM throwIO (listSdkCommands sdkConfig)
             userCommand <- getCommand sdkCommands
+            versionChecks env
             handleCommand env userCommand
 
 -- | Perform version checks, i.e. warn user if project SDK version or assistant SDK
@@ -111,6 +111,7 @@ autoInstall env@Env{..} = do
                 , iActivate = ActivateInstall False
                 , iForce = ForceInstall False
                 , iSetPath = SetPath True
+                , iBashCompletions = BashCompletions Auto
                 }
             installEnv = InstallEnv
                 { options = options

daml-assistant/src/DA/Daml/Assistant/Command.hs

@@ -83,12 +83,13 @@ versionParser = VersionOptions
 
 installParser :: Parser InstallOptions
 installParser = InstallOptions
-    <$> optional (RawInstallTarget <$> argument str (metavar "TARGET" <> help "The SDK version to install. Use 'latest' to download and install the latest stable SDK version available. Run 'daml install' to see the full set of options."))
+    <$> optional (RawInstallTarget <$> argument str (metavar "TARGET" <> completeWith ["latest"] <> help "The SDK version to install. Use 'latest' to download and install the latest stable SDK version available. Run 'daml install' to see the full set of options."))
     <*> (InstallAssistant <$> flagYesNoAuto' "install-assistant" "Install associated DAML assistant version. Can be set to \"yes\" (always installs), \"no\" (never installs), or \"auto\" (installs if newer). Default is \"auto\"." idm)
     <*> iflag ActivateInstall "activate" hidden "Activate installed version of daml"
     <*> iflag ForceInstall "force" (short 'f') "Overwrite existing installation"
     <*> iflag QuietInstall "quiet" (short 'q') "Don't display installation messages"
     <*> fmap SetPath (flagYesNoAuto "set-path" True "Adjust PATH automatically. This option only has an effect on Windows." idm)
+    <*> fmap BashCompletions (flagYesNoAuto' "bash-completions" "Install bash completions for DAML assistant. Default is yes for linux and mac, no for windows." idm)
     where
         iflag p name opts desc = fmap p (switch (long name <> help desc <> opts))
 
@@ -99,5 +100,3 @@ uninstallParser =
 readSdkVersion :: ReadM SdkVersion
 readSdkVersion =
     eitherReader (mapLeft displayException . parseVersion . pack)
-
-

daml-assistant/src/DA/Daml/Assistant/Install.hs

@@ -15,6 +15,7 @@ import DA.Daml.Assistant.Types
 import DA.Daml.Assistant.Util
 import qualified DA.Daml.Assistant.Install.Github as Github
 import DA.Daml.Assistant.Install.Path
+import DA.Daml.Assistant.Install.BashCompletion
 import DA.Daml.Project.Consts
 import DA.Daml.Project.Config
 import DA.Daml.Project.Util
@@ -190,6 +191,7 @@ activateDaml env@InstallEnv{..} targetPath = do
             else createSymbolicLink damlBinarySourcePath damlBinaryTargetPath
 
     updatePath options (\s -> unlessQuiet env (output s)) damlBinaryTargetDir
+    installBashCompletions options damlPath (\s -> unlessQuiet env (output s))
 
 data WalkCallbacks = WalkCallbacks
     { walkOnFile :: FilePath -> IO ()

daml-assistant/src/DA/Daml/Assistant/Install/BashCompletion.hs

@@ -0,0 +1,112 @@
+-- Copyright (c) 2020 The DAML Authors. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+-- | Installation of bash completions. The completion script is
+-- installed in @~/.daml/bash_completion.sh@ and a hook is added
+-- in @~/.bash_completion@ to invoke it if available.
+module DA.Daml.Assistant.Install.BashCompletion
+    ( installBashCompletions
+    ) where
+
+import DA.Daml.Assistant.Types
+
+import qualified Data.ByteString.Lazy as BSL
+import Control.Exception.Safe (tryIO, catchIO, displayException)
+import Control.Monad.Extra (unless, andM, whenM)
+import System.Directory (getHomeDirectory, getAppUserDataDirectory, doesFileExist, removePathForcibly)
+import System.FilePath ((</>))
+import System.Info.Extra (isWindows)
+import System.Process.Typed (proc, readProcessStdout_)
+import System.IO.Extra (readFileUTF8, writeFileUTF8)
+
+-- | Install bash completion script if we should.
+installBashCompletions :: InstallOptions -> DamlPath -> (String -> IO ()) -> IO ()
+installBashCompletions options damlPath output =
+    whenM (shouldInstallBashCompletions options damlPath) $
+        doInstallBashCompletions damlPath output
+
+-- | Should we install bash completions? By default, yes, but only if the
+-- we're not on Windows and the completion script hasn't yet been generated.
+shouldInstallBashCompletions :: InstallOptions -> DamlPath -> IO Bool
+shouldInstallBashCompletions options damlPath =
+    case iBashCompletions options of
+        BashCompletions Yes -> pure True
+        BashCompletions No -> pure False
+        BashCompletions Auto -> andM
+            [ pure (not isWindows)
+            , not <$> doesFileExist (completionScriptPath damlPath)
+            , isDefaultDamlPath damlPath
+            ]
+
+-- | Generate the bash completion script, and add a hook.
+doInstallBashCompletions :: DamlPath -> (String -> IO ()) -> IO ()
+doInstallBashCompletions damlPath output = do
+    let scriptPath = completionScriptPath damlPath
+    script <- getCompletionScript damlPath
+    BSL.writeFile scriptPath script
+    unitE <- tryIO $ addCompletionHook scriptPath
+    case unitE of
+        Left e -> do
+            output ("Bash completions not installed: " <> displayException e)
+            catchIO (removePathForcibly scriptPath) (const $ pure ())
+        Right () -> output "Bash completions installed for DAML assistant."
+
+-- | Read the bash completion script from optparse-applicative's
+-- built-in @--bash-completion-script@ routine. Please read
+-- https://github.com/pcapriotti/optparse-applicative/wiki/Bash-Completion
+-- for more details. Note that the bash completion script doesn't
+-- in general contain any daml-assistant specific information, it's only
+-- specific to the path, so we don't need to regenerate it every version.
+getCompletionScript :: DamlPath -> IO BSL.ByteString
+getCompletionScript damlPath = do
+    let assistant = assistantPath damlPath
+    readProcessStdout_ (proc assistant ["--bash-completion-script", assistant])
+
+-- | Add a completion hook in ~/.bash_completion
+-- Does nothing if the hook is already there
+addCompletionHook :: FilePath -> IO ()
+addCompletionHook scriptPath = do
+    let newHook = makeHook scriptPath
+    hookPath <- getHookPath
+    hooks <- readHooks hookPath
+    unless (newHook `elem` hooks) $ do
+        writeHooks hookPath (hooks ++ [newHook])
+
+-- | Check the daml path is default. We don't want to install completions
+-- for non-standard paths by default.
+isDefaultDamlPath :: DamlPath -> IO Bool
+isDefaultDamlPath (DamlPath damlPath) = do
+    rawDamlPath <- tryIO (getAppUserDataDirectory "daml")
+    pure $ Right damlPath == rawDamlPath
+
+newtype HookPath = HookPath FilePath
+newtype Hook = Hook { unHook :: String } deriving Eq
+
+makeHook :: FilePath -> Hook
+makeHook scriptPath = Hook $ concat
+    [ "[ -f "
+    , show scriptPath
+    , " ] && source "
+    , show scriptPath
+    ]
+
+getHookPath :: IO HookPath
+getHookPath = do
+    home <- getHomeDirectory
+    pure (HookPath $ home </> ".bash_completion")
+
+readHooks :: HookPath -> IO [Hook]
+readHooks (HookPath p) = catchIO
+    (map Hook . lines <$> readFileUTF8 p)
+    (const $ pure [])
+
+writeHooks :: HookPath -> [Hook] -> IO ()
+writeHooks (HookPath p) = writeFileUTF8 p . unlines . map unHook
+
+----
+
+assistantPath :: DamlPath -> FilePath
+assistantPath (DamlPath p) = p </> "bin" </> "daml"
+
+completionScriptPath :: DamlPath -> FilePath
+completionScriptPath (DamlPath p) = p </> "bash_completions.sh"

daml-assistant/src/DA/Daml/Assistant/Types.hs

@@ -88,6 +88,7 @@ data InstallOptions = InstallOptions
     , iForce :: ForceInstall -- ^ force reinstall if already installed
     , iQuiet :: QuietInstall -- ^ don't print messages
     , iSetPath :: SetPath -- ^ set the user's PATH (on Windows)
+    , iBashCompletions :: BashCompletions -- ^ install bash completions for the daml assistant
     } deriving (Eq, Show)
 
 -- | An install URL is a fully qualified HTTP[S] URL to an SDK release tarball. For example:
@@ -102,5 +103,4 @@ newtype QuietInstall = QuietInstall { unQuietInstall :: Bool } deriving (Eq, Sho
 newtype ActivateInstall = ActivateInstall { unActivateInstall :: Bool } deriving (Eq, Show)
 newtype SetPath = SetPath Bool deriving (Eq, Show)
 newtype InstallAssistant = InstallAssistant { unwrapInstallAssistant :: YesNoAuto } deriving (Eq, Show)
-
-
+newtype BashCompletions = BashCompletions { unwrapBashCompletions :: YesNoAuto } deriving (Eq, Show)

daml-assistant/test/DA/Daml/Assistant/Tests.hs

@@ -378,6 +378,7 @@ testInstall = Tasty.testGroup "DA.Daml.Assistant.Install"
                     , iQuiet = QuietInstall True
                     , iForce = ForceInstall False
                     , iSetPath = SetPath False
+                    , iBashCompletions = BashCompletions No
                     }
 
             setCurrentDirectory base
@@ -411,6 +412,7 @@ testInstallUnix = Tasty.testGroup "unix-specific tests"
                           , iQuiet = QuietInstall True
                           , iForce = ForceInstall False
                           , iSetPath = SetPath False
+                          , iBashCompletions = BashCompletions No
                           }
 
                   setCurrentDirectory base
@@ -439,6 +441,7 @@ testInstallUnix = Tasty.testGroup "unix-specific tests"
                     , iQuiet = QuietInstall True
                     , iForce = ForceInstall False
                     , iSetPath = SetPath False
+                    , iBashCompletions = BashCompletions No
                     }
 
             setCurrentDirectory base
@@ -467,6 +470,7 @@ testInstallUnix = Tasty.testGroup "unix-specific tests"
                     , iQuiet = QuietInstall True
                     , iForce = ForceInstall False
                     , iSetPath = SetPath False
+                    , iBashCompletions = BashCompletions No
                     }
 
             setCurrentDirectory base

docs/source/tools/assistant.rst

@@ -184,3 +184,10 @@ Rarely, you might need to install an SDK release from a downloaded SDK release t
 
   daml install path-to-tarball.tar.gz
 
+Terminal Command Completion
+***************************
+
+The ``daml`` assistant comes with support for ``bash`` completions. These will be installed automatically on Linux and Mac when you install or upgrade the DAML assistant. If you use the ``bash`` shell, and your ``bash`` supports completions, you can use the TAB key to complete many ``daml`` commands, such as ``daml install`` and ``daml version``.
+
+You can override whether bash completions are installed for ``daml`` by
+passing ``--bash-completions=yes`` or ``--bash-completions=no`` to ``daml install``.

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

@@ -29,7 +29,7 @@ determineAuto b = \case
 -- 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 <> mods)
+    option reader (long flagName <> value Auto <> help helpText <> completeWith ["yes", "no", "auto"] <> mods)
   where reader = eitherReader $ \case
             "yes" -> Right Yes
             "no" -> Right No
@@ -43,4 +43,3 @@ flagYesNoAuto flagName defaultValue helpText mods =
     determineAuto defaultValue <$> flagYesNoAuto' flagName (helpText <> commonHelp) mods
     where
         commonHelp = " Can be set to \"yes\", \"no\" or \"auto\" to select the default (" <> show defaultValue <> ")"
-