digital-asset · mergify · Jan 6, 2020 · Jan 3, 2020 · Jan 3, 2020 · Jan 3, 2020
diff --git a/daml-assistant/exe/DA/Daml/Assistant.hs b/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

diff --git a/daml-assistant/src/DA/Daml/Assistant/Command.hs b/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)
-
-
diff --git a/daml-assistant/src/DA/Daml/Assistant/Install.hs b/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 ()

diff --git a/daml-assistant/src/DA/Daml/Assistant/Install/BashCompletion.hs b/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"
diff --git a/daml-assistant/src/DA/Daml/Assistant/Types.hs b/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)
diff --git a/daml-assistant/test/DA/Daml/Assistant/Tests.hs b/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

diff --git a/docs/source/tools/assistant.rst b/docs/source/tools/assistant.rst
@@ -184,3 +184,12 @@ 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``.
+
+In the future, ``zsh`` and ``fish`` terminal completions may be implemented.
diff --git a/libs-haskell/da-hs-base/src/Options/Applicative/Extended.hs b/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 <> ")"
-