From 7fb1ca65009a91daa27c67893959ee041233f3d9 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 3 Nov 2023 14:56:34 +0000 Subject: [PATCH 1/2] External commands: Add tests for #9402 #9403 #9404 This adds 4 tests which test the new external commands feature: * ExternalCommand - Tests the expected usage of external command invoked via cabal-install * ExternalCommandSetup - Tests that the ./Setup interface does not support external commands (#9403) * ExternalCommandEnv - Tests that environment variables are set and preserved appropiately (#9402) * ExternalCommandHelp - Test that `cabal help ` is interpreted appropiately (#9404) --- .../PackageTests/ExternalCommand/cabal.out | 8 ++++ .../ExternalCommand/cabal.project | 1 + .../ExternalCommand/cabal.test.hs | 37 ++++++++++++++++++ .../ExternalCommand/setup-test/AAAA.hs | 4 ++ .../ExternalCommand/setup-test/CHANGELOG.md | 5 +++ .../ExternalCommand/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../PackageTests/ExternalCommandEnv/cabal.out | 8 ++++ .../ExternalCommandEnv/cabal.project | 1 + .../ExternalCommandEnv/cabal.test.hs | 39 +++++++++++++++++++ .../ExternalCommandEnv/setup-test/AAAA.hs | 11 ++++++ .../setup-test/CHANGELOG.md | 5 +++ .../ExternalCommandEnv/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../ExternalCommandHelp/cabal.out | 12 ++++++ .../ExternalCommandHelp/cabal.project | 1 + .../ExternalCommandHelp/cabal.test.hs | 37 ++++++++++++++++++ .../ExternalCommandHelp/setup-test/AAAA.hs | 9 +++++ .../setup-test/CHANGELOG.md | 5 +++ .../ExternalCommandHelp/setup-test/LICENSE | 30 ++++++++++++++ .../setup-test/setup-test.cabal | 25 ++++++++++++ .../ExternalCommandSetup/aaaa/LICENSE | 0 .../ExternalCommandSetup/aaaa/Main.hs | 3 ++ .../ExternalCommandSetup/aaaa/aaaa.cabal | 22 +++++++++++ .../ExternalCommandSetup/custom/CHANGELOG.md | 5 +++ .../ExternalCommandSetup/custom/LICENSE | 30 ++++++++++++++ .../ExternalCommandSetup/custom/Setup.hs | 3 ++ .../ExternalCommandSetup/custom/custom.cabal | 29 ++++++++++++++ .../ExternalCommandSetup/setup.cabal.hs | 17 ++++++++ .../ExternalCommandSetup/setup.out | 22 +++++++++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 12 ++++-- 31 files changed, 488 insertions(+), 3 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs create mode 100644 cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.out b/cabal-testsuite/PackageTests/ExternalCommand/cabal.out new file mode 100644 index 00000000000..1c4c24db55c --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.project b/cabal-testsuite/PackageTests/ExternalCommand/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs new file mode 100644 index 00000000000..850c8bfbcec --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs @@ -0,0 +1,37 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "aaaa" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs new file mode 100644 index 00000000000..5bee0ebbef1 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs @@ -0,0 +1,4 @@ +module Main where + +main = do + putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal new file mode 100644 index 00000000000..8deb0577a16 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out new file mode 100644 index 00000000000..1c4c24db55c --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs new file mode 100644 index 00000000000..891c9e43d4b --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs @@ -0,0 +1,39 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ expectBroken 9402 $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("OTHER_VAR", Just "is set") : ("PATH", Just newpath) : (testEnvironment env)) + + withEnv new_env $ do + res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "cabal-install" res + assertOutputContains "is set" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs new file mode 100644 index 00000000000..99af61e9c03 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/AAAA.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.Process + +main = do + cabal_proc <- getEnv "CABAL" + other_var <- getEnv "OTHER_VAR" + putStrLn ("OTHER_VAR is set to: " ++ other_var) + callProcess cabal_proc ["--version"] + diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal new file mode 100644 index 00000000000..a5feea69112 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base, process + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out new file mode 100644 index 00000000000..0a3edf696f9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out @@ -0,0 +1,12 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) + - setup-test-0.1.0.0 (exe:setup) (first run) +Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... +Building executable 'cabal-aaaa' for setup-test-0.1.0.0... +Configuring executable 'setup' for setup-test-0.1.0.0... +Preprocessing executable 'setup' for setup-test-0.1.0.0... +Building executable 'setup' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project new file mode 100644 index 00000000000..1a33bb5a25e --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.project @@ -0,0 +1 @@ +packages: setup-test/ diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs new file mode 100644 index 00000000000..a3a8acfa5c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs @@ -0,0 +1,37 @@ +import Test.Cabal.Prelude +import qualified System.Process as Process +import Control.Concurrent (threadDelay) +import System.Directory (removeFile) +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import qualified Data.Time.Clock as Time +import qualified Data.Time.Format as Time +import Data.Maybe +import System.Environment + +main = do + cabalTest $ expectBroken 9404 $ do + res <- cabalWithStdin "v2-build" ["all"] "" + exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = takeDirectory exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- cabal_raw_action ["help", "aaaa"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "I am helping with the aaaa command" res + + +cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result +cabal_raw_action args action = do + configured_prog <- requireProgramM cabalProgram + env <- getTestEnv + r <- liftIO $ runAction (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + (programPath configured_prog) + args + Nothing + action + recordLog r + requireSuccess r diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs new file mode 100644 index 00000000000..10fe05988d8 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs @@ -0,0 +1,9 @@ +module Main where + +import System.Environment + +main = do + args <- getArgs + case args of + ["--help"] -> putStrLn "I am helping with the aaaa command" + _ -> putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md new file mode 100644 index 00000000000..7ae8ff6113d --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for setup-test + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal new file mode 100644 index 00000000000..8deb0577a16 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/setup-test.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: setup-test +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: AAAA.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/LICENSE new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs new file mode 100644 index 00000000000..b3fcf560699 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal new file mode 100644 index 00000000000..cafeabd5855 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/aaaa/aaaa.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: aaaa +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable cabal-aaaa + import: warnings + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md new file mode 100644 index 00000000000..063fef7c698 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for custom + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE new file mode 100644 index 00000000000..cd8ad2ac8ae --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs new file mode 100644 index 00000000000..e8efd11bddb --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/Setup.hs @@ -0,0 +1,3 @@ +module Main where +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal new file mode 100644 index 00000000000..0dbc609439b --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/custom/custom.cabal @@ -0,0 +1,29 @@ +cabal-version: 3.0 +name: custom +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +build-type: Custom +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +custom-setup + build-depends: base, Cabal + +library + import: warnings + exposed-modules: MyLib + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs new file mode 100644 index 00000000000..7de624d4530 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs @@ -0,0 +1,17 @@ +import Test.Cabal.Prelude +import System.Environment + +main = setupTest $ expectBroken 9403 $ do + withPackageDb $ do + withDirectory "aaaa" $ setup_install [] + r <- runInstalledExe' "cabal-aaaa" [] + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let exe_path = testPrefixDir env "bin" + let newpath = exe_path ++ ":" ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env $ do + res <- withDirectory "custom" $ setup' "aaaa" [] + assertOutputContains "did you mean" res + + diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out new file mode 100644 index 00000000000..e234d5e2a48 --- /dev/null +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out @@ -0,0 +1,22 @@ +# Setup configure +Configuring aaaa-0.1.0.0... +# Setup build +Preprocessing executable 'aaaa' for aaaa-0.1.0.0... +Building executable 'aaaa' for aaaa-0.1.0.0... +# Setup copy +Installing executable aaaa in +Warning: The directory /setup.dist/usr/bin is not in the system search path. +# Setup register +Package contains no library to register: aaaa-0.1.0.0... +# aaaa +aaaa +# Setup configure +Warning: custom.cabal:19:3: Unknown field: "build-depends" +Configuring custom-0.1.0.0... +# Setup build +Preprocessing library for custom-0.1.0.0... +Building library for custom-0.1.0.0... +# Setup copy +Installing library in +# Setup register +Registering library for custom-0.1.0.0... diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 757a71aefb7..2977a9270cc 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -358,15 +358,21 @@ runPlanExe pkg_name cname args = void $ runPlanExe' pkg_name cname args runPlanExe' :: String {- package name -} -> String {- component name -} -> [String] -> TestM Result runPlanExe' pkg_name cname args = do + exePath <- planExePath pkg_name cname + defaultRecordMode RecordAll $ do + recordHeader [pkg_name, cname] + runM exePath args Nothing + +planExePath :: String {- package name -} -> String {- component name -} + -> TestM FilePath +planExePath pkg_name cname = do Just plan <- testPlan `fmap` getTestEnv let distDirOrBinFile = planDistDir plan (mkPackageName pkg_name) (CExeName (mkUnqualComponentName cname)) exePath = case distDirOrBinFile of DistDir dist_dir -> dist_dir "build" cname cname BinFile bin_file -> bin_file - defaultRecordMode RecordAll $ do - recordHeader [pkg_name, cname] - runM exePath args Nothing + return exePath ------------------------------------------------------------------------ -- * Running ghc-pkg From d8ebb8146f36ad0809c93940e888fda88dd329e1 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Mon, 6 Nov 2023 11:01:34 +0000 Subject: [PATCH 2/2] Finish off the external commands feature * Remove 'CommandDelegate' in favour of abstracting the fallback in 'commandsRun', there is a new variant 'commdandRunWithFallback' which takes a continuation - This restores the modularity between the `Cabal` library and `cabal-install` as now `Cabal` doesn't need to know anything about the external command interface. - Fixes #9403 * Set the $CABAL environment variable to the current executable path - This allows external commands to be implemented by calling $CABAL, which is strongly preferred to linking against the Cabal library as there is no easy way to guantee your tool and `cabal-install` link against the same `Cabal` library. - Fixes #9402 * Pass the name of the argument - This allows external commands to be implemented as symlinks to an executable, and multiple commands can be interpreted by the same executable. - Fixes #9405 * `cabal help ` is interpreted as `cabal- --help` for external commands. - This allows the `help` command to also work for external commands and hence they are better integrated into cabal-install. - Fixes #9404 The tests are updated to test all these additions. These features bring the external command interface up to par with the cargo external command interface. --- Cabal/src/Distribution/Make.hs | 2 - Cabal/src/Distribution/Simple.hs | 2 - Cabal/src/Distribution/Simple/Command.hs | 102 +++++++++--------- cabal-install/src/Distribution/Client/Main.hs | 33 +++++- .../src/Distribution/Client/SavedFlags.hs | 1 - .../ExternalCommand/cabal.test.hs | 20 +++- .../ExternalCommand/setup-test/AAAA.hs | 5 +- .../ExternalCommandEnv/cabal.test.hs | 9 +- .../ExternalCommandHelp/cabal.out | 4 - .../ExternalCommandHelp/cabal.test.hs | 8 +- .../ExternalCommandHelp/setup-test/AAAA.hs | 2 +- .../ExternalCommandSetup/setup.cabal.hs | 11 +- .../ExternalCommandSetup/setup.out | 19 +--- cabal-testsuite/src/Test/Cabal/Prelude.hs | 16 ++- doc/external-commands.rst | 18 +++- 15 files changed, 144 insertions(+), 108 deletions(-) diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs index aaa63a94bdb..82334d550f0 100644 --- a/Cabal/src/Distribution/Make.hs +++ b/Cabal/src/Distribution/Make.hs @@ -91,7 +91,6 @@ defaultMainHelper :: [String] -> IO () defaultMainHelper args = do command <- commandsRun (globalCommand commands) commands args case command of - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -100,7 +99,6 @@ defaultMainHelper args = do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 0649a085260..c52a02c0f96 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -170,7 +170,6 @@ defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args command <- commandsRun (globalCommand commands) commands args' case command of - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -179,7 +178,6 @@ defaultMainHelper hooks args = topHandler $ do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index dc2be1a698b..2da6486cba6 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -47,6 +47,8 @@ module Distribution.Simple.Command -- ** Running commands , commandsRun + , commandsRunWithFallback + , defaultCommandFallback -- * Option Fields , OptionField (..) @@ -85,15 +87,12 @@ module Distribution.Simple.Command import Distribution.Compat.Prelude hiding (get) import Prelude () -import Control.Exception (try) import qualified Data.Array as Array import qualified Data.List as List import Distribution.Compat.Lens (ALens', (#~), (^#)) import qualified Distribution.GetOpt as GetOpt import Distribution.ReadE import Distribution.Simple.Utils -import System.Directory (findExecutable) -import System.Process (callProcess) data CommandUI flags = CommandUI { commandName :: String @@ -599,13 +598,11 @@ data CommandParse flags | CommandList [String] | CommandErrors [String] | CommandReadyToGo flags - | CommandDelegate instance Functor CommandParse where fmap _ (CommandHelp help) = CommandHelp help fmap _ (CommandList opts) = CommandList opts fmap _ (CommandErrors errs) = CommandErrors errs fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags) - fmap _ CommandDelegate = CommandDelegate data CommandType = NormalCommand | HiddenCommand data Command action @@ -632,27 +629,62 @@ commandAddAction command action = let flags = mkflags (commandDefaultFlags command) in action flags args +-- Print suggested command if edit distance is < 5 +badCommand :: [Command action] -> String -> CommandParse a +badCommand commands' cname = + case eDists of + [] -> CommandErrors [unErr] + (s : _) -> + CommandErrors + [ unErr + , "Maybe you meant `" ++ s ++ "`?\n" + ] + where + eDists = + map fst . List.sortBy (comparing snd) $ + [ (cname', dist) + | -- Note that this is not commandNames, so close suggestions will show + -- hidden commands + (Command cname' _ _ _) <- commands' + , let dist = editDistance cname' cname + , dist < 5 + ] + unErr = "unrecognised command: " ++ cname ++ " (try --help)" + commandsRun :: CommandUI a -> [Command action] -> [String] -> IO (CommandParse (a, CommandParse action)) commandsRun globalCommand commands args = + commandsRunWithFallback globalCommand commands defaultCommandFallback args + +defaultCommandFallback + :: [Command action] + -> String + -> [String] + -> IO (CommandParse action) +defaultCommandFallback commands' name _cmdArgs = pure $ badCommand commands' name + +commandsRunWithFallback + :: CommandUI a + -> [Command action] + -> ([Command action] -> String -> [String] -> IO (CommandParse action)) + -> [String] + -> IO (CommandParse (a, CommandParse action)) +commandsRunWithFallback globalCommand commands defaultCommand args = case commandParseArgs globalCommand True args of - CommandDelegate -> pure CommandDelegate CommandHelp help -> pure $ CommandHelp help CommandList opts -> pure $ CommandList (opts ++ commandNames) CommandErrors errs -> pure $ CommandErrors errs CommandReadyToGo (mkflags, args') -> case args' of - ("help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs + ("help" : cmdArgs) -> handleHelpCommand flags cmdArgs (name : cmdArgs) -> case lookupCommand name of [Command _ _ action _] -> pure $ CommandReadyToGo (flags, action cmdArgs) _ -> do - mCommand <- findExecutable $ "cabal-" <> name - case mCommand of - Just exec -> callExternal flags exec cmdArgs - Nothing -> pure $ CommandReadyToGo (flags, badCommand name) + final_cmd <- defaultCommand commands' name cmdArgs + return $ CommandReadyToGo (flags, final_cmd) [] -> pure $ CommandReadyToGo (flags, noCommand) where flags = mkflags (commandDefaultFlags globalCommand) @@ -661,55 +693,29 @@ commandsRun globalCommand commands args = [ cmd | cmd@(Command cname' _ _ _) <- commands', cname' == cname ] - callExternal :: a -> String -> [String] -> IO (CommandParse (a, CommandParse action)) - callExternal flags exec cmdArgs = do - result <- try $ callProcess exec cmdArgs - case result of - Left ex -> pure $ CommandErrors ["Error executing external command: " ++ show (ex :: SomeException)] - Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate) - noCommand = CommandErrors ["no command given (try --help)\n"] - -- Print suggested command if edit distance is < 5 - badCommand :: String -> CommandParse a - badCommand cname = - case eDists of - [] -> CommandErrors [unErr] - (s : _) -> - CommandErrors - [ unErr - , "Maybe you meant `" ++ s ++ "`?\n" - ] - where - eDists = - map fst . List.sortBy (comparing snd) $ - [ (cname', dist) - | (Command cname' _ _ _) <- commands' - , let dist = editDistance cname' cname - , dist < 5 - ] - unErr = "unrecognised command: " ++ cname ++ " (try --help)" - commands' = commands ++ [commandAddAction helpCommandUI undefined] commandNames = [name | (Command name _ _ NormalCommand) <- commands'] -- A bit of a hack: support "prog help" as a synonym of "prog --help" -- furthermore, support "prog help command" as "prog command --help" - handleHelpCommand cmdArgs = + handleHelpCommand flags cmdArgs = case commandParseArgs helpCommandUI True cmdArgs of - CommandDelegate -> CommandDelegate - CommandHelp help -> CommandHelp help - CommandList list -> CommandList (list ++ commandNames) - CommandErrors _ -> CommandHelp globalHelp - CommandReadyToGo (_, []) -> CommandHelp globalHelp + CommandHelp help -> pure $ CommandHelp help + CommandList list -> pure $ CommandList (list ++ commandNames) + CommandErrors _ -> pure $ CommandHelp globalHelp + CommandReadyToGo (_, []) -> pure $ CommandHelp globalHelp CommandReadyToGo (_, (name : cmdArgs')) -> case lookupCommand name of [Command _ _ action _] -> case action ("--help" : cmdArgs') of - CommandHelp help -> CommandHelp help - CommandList _ -> CommandList [] - _ -> CommandHelp globalHelp - _ -> badCommand name + CommandHelp help -> pure $ CommandHelp help + CommandList _ -> pure $ CommandList [] + _ -> pure $ CommandHelp globalHelp + _ -> do + fall_back <- defaultCommand commands' name ("--help" : cmdArgs') + return $ CommandReadyToGo (flags, fall_back) where globalHelp = commandHelp globalCommand diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 9114102f2bf..dc196a66864 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -205,7 +205,8 @@ import Distribution.Simple.Command , commandAddAction , commandFromSpec , commandShowOptions - , commandsRun + , commandsRunWithFallback + , defaultCommandFallback , hiddenCommand ) import Distribution.Simple.Compiler (PackageDBStack) @@ -221,6 +222,8 @@ import Distribution.Simple.PackageDescription (readGenericPackageDescription) import Distribution.Simple.Program ( configureAllKnownPrograms , defaultProgramDb + , defaultProgramSearchPath + , findProgramOnSearchPath , getProgramInvocationOutput , simpleProgramInvocation ) @@ -261,7 +264,7 @@ import System.Directory , getCurrentDirectory , withCurrentDirectory ) -import System.Environment (getProgName) +import System.Environment (getEnvironment, getExecutablePath, getProgName) import System.FilePath ( dropExtension , splitExtension @@ -276,6 +279,7 @@ import System.IO , stderr , stdout ) +import System.Process (createProcess, env, proc) -- | Entry point -- @@ -334,9 +338,8 @@ warnIfAssertionsAreEnabled = mainWorker :: [String] -> IO () mainWorker args = do topHandler $ do - command <- commandsRun (globalCommand commands) commands args + command <- commandsRunWithFallback (globalCommand commands) commands delegateToExternal args case command of - CommandDelegate -> pure () CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -347,7 +350,6 @@ mainWorker args = do printVersion | fromFlagOrDefault False (globalNumericVersion globalFlags) -> printNumericVersion - CommandDelegate -> pure () CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> do @@ -366,6 +368,27 @@ mainWorker args = do warnIfAssertionsAreEnabled action globalFlags where + delegateToExternal + :: [Command Action] + -> String + -> [String] + -> IO (CommandParse Action) + delegateToExternal commands' name cmdArgs = do + mCommand <- findProgramOnSearchPath normal defaultProgramSearchPath ("cabal-" <> name) + case mCommand of + Just (exec, _) -> return (CommandReadyToGo $ \_ -> callExternal exec name cmdArgs) + Nothing -> defaultCommandFallback commands' name cmdArgs + + callExternal :: String -> String -> [String] -> IO () + callExternal exec name cmdArgs = do + cur_env <- getEnvironment + cabal_exe <- getExecutablePath + let new_env = ("CABAL", cabal_exe) : cur_env + result <- try $ createProcess ((proc exec (name : cmdArgs)){env = Just new_env}) + case result of + Left ex -> printErrors ["Error executing external command: " ++ show (ex :: SomeException)] + Right _ -> return () + printCommandHelp help = do pname <- getProgName putStr (help pname) diff --git a/cabal-install/src/Distribution/Client/SavedFlags.hs b/cabal-install/src/Distribution/Client/SavedFlags.hs index 5fa417a8578..1a598a58fd7 100644 --- a/cabal-install/src/Distribution/Client/SavedFlags.hs +++ b/cabal-install/src/Distribution/Client/SavedFlags.hs @@ -51,7 +51,6 @@ readCommandFlags :: FilePath -> CommandUI flags -> IO flags readCommandFlags path command = do savedArgs <- fmap (fromMaybe []) (readSavedArgs path) case (commandParseArgs command True savedArgs) of - CommandDelegate -> error "CommandDelegate Flags evaluated, this should never occur" CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs) CommandList _ -> throwIO (SavedArgsErrorList savedArgs) CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs) diff --git a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs index 850c8bfbcec..d9535b60507 100644 --- a/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommand/cabal.test.hs @@ -8,19 +8,29 @@ import qualified Data.Time.Clock as Time import qualified Data.Time.Format as Time import Data.Maybe import System.Environment +import System.FilePath main = do cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" - env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do + addToPath (takeDirectory exe_path) $ do + -- Test that the thing works at all res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "aaaa" res + -- Test that the extra arguments are passed on + res <- cabal_raw_action ["aaaa", "--foobaz"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--foobaz" res + + -- Test what happens with "global" flags + res <- cabal_raw_action ["aaaa", "--version"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--version" res + + -- Test what happens with "global" flags + res <- cabal_raw_action ["aaaa", "--config-file", "abc"] (\h -> () <$ Process.waitForProcess h) + assertOutputContains "--config-file" res + cabal_raw_action :: [String] -> (Process.ProcessHandle -> IO ()) -> TestM Result cabal_raw_action args action = do diff --git a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs index 5bee0ebbef1..c2d121c9a39 100644 --- a/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs +++ b/cabal-testsuite/PackageTests/ExternalCommand/setup-test/AAAA.hs @@ -1,4 +1,5 @@ module Main where -main = do - putStrLn "aaaa" +import System.Environment + +main = getArgs >>= print diff --git a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs index 891c9e43d4b..4344076398a 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandEnv/cabal.test.hs @@ -10,15 +10,12 @@ import Data.Maybe import System.Environment main = do - cabalTest $ expectBroken 9402 $ do + cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("OTHER_VAR", Just "is set") : ("PATH", Just newpath) : (testEnvironment env)) - - withEnv new_env $ do + let new_env = (("OTHER_VAR", Just "is set") : (testEnvironment env)) + withEnv new_env $ addToPath (takeDirectory exe_path) $ do res <- cabal_raw_action ["aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "cabal-install" res assertOutputContains "is set" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out index 0a3edf696f9..1c4c24db55c 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.out @@ -3,10 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - setup-test-0.1.0.0 (exe:cabal-aaaa) (first run) - - setup-test-0.1.0.0 (exe:setup) (first run) Configuring executable 'cabal-aaaa' for setup-test-0.1.0.0... Preprocessing executable 'cabal-aaaa' for setup-test-0.1.0.0... Building executable 'cabal-aaaa' for setup-test-0.1.0.0... -Configuring executable 'setup' for setup-test-0.1.0.0... -Preprocessing executable 'setup' for setup-test-0.1.0.0... -Building executable 'setup' for setup-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs index a3a8acfa5c7..96e69bbbd6e 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/cabal.test.hs @@ -10,14 +10,10 @@ import Data.Maybe import System.Environment main = do - cabalTest $ expectBroken 9404 $ do + cabalTest $ do res <- cabalWithStdin "v2-build" ["all"] "" exe_path <- withPlan $ planExePath "setup-test" "cabal-aaaa" - env <- getTestEnv - path <- liftIO $ getEnv "PATH" - let newpath = takeDirectory exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do + addToPath (takeDirectory exe_path) $ do res <- cabal_raw_action ["help", "aaaa"] (\h -> () <$ Process.waitForProcess h) assertOutputContains "I am helping with the aaaa command" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs index 10fe05988d8..dd139b905da 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandHelp/setup-test/AAAA.hs @@ -5,5 +5,5 @@ import System.Environment main = do args <- getArgs case args of - ["--help"] -> putStrLn "I am helping with the aaaa command" + ["aaaa" , "--help"] -> putStrLn "I am helping with the aaaa command" _ -> putStrLn "aaaa" diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs index 7de624d4530..d6bea04003f 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.cabal.hs @@ -1,17 +1,14 @@ import Test.Cabal.Prelude import System.Environment -main = setupTest $ expectBroken 9403 $ do +main = setupTest $ do withPackageDb $ do withDirectory "aaaa" $ setup_install [] r <- runInstalledExe' "cabal-aaaa" [] env <- getTestEnv - path <- liftIO $ getEnv "PATH" let exe_path = testPrefixDir env "bin" - let newpath = exe_path ++ ":" ++ path - let new_env = (("PATH", Just newpath) : (testEnvironment env)) - withEnv new_env $ do - res <- withDirectory "custom" $ setup' "aaaa" [] - assertOutputContains "did you mean" res + addToPath exe_path $ do + res <- fails $ withDirectory "custom" $ setup' "aaaa" [] + assertOutputContains "unrecognised command" res diff --git a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out index e234d5e2a48..6600ad3ca2f 100644 --- a/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out +++ b/cabal-testsuite/PackageTests/ExternalCommandSetup/setup.out @@ -1,22 +1,13 @@ # Setup configure Configuring aaaa-0.1.0.0... # Setup build -Preprocessing executable 'aaaa' for aaaa-0.1.0.0... -Building executable 'aaaa' for aaaa-0.1.0.0... +Preprocessing executable 'cabal-aaaa' for aaaa-0.1.0.0... +Building executable 'cabal-aaaa' for aaaa-0.1.0.0... # Setup copy -Installing executable aaaa in +Installing executable cabal-aaaa in Warning: The directory /setup.dist/usr/bin is not in the system search path. # Setup register Package contains no library to register: aaaa-0.1.0.0... -# aaaa +# cabal-aaaa aaaa -# Setup configure -Warning: custom.cabal:19:3: Unknown field: "build-depends" -Configuring custom-0.1.0.0... -# Setup build -Preprocessing library for custom-0.1.0.0... -Building library for custom-0.1.0.0... -# Setup copy -Installing library in -# Setup register -Registering library for custom-0.1.0.0... +# Setup aaaa diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 2977a9270cc..c95a55988f8 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -60,16 +60,16 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe, fromMaybe) import System.Exit (ExitCode (..)) -import System.FilePath ((), takeExtensions, takeDrive, takeDirectory, normalise, splitPath, joinPath, splitFileName, (<.>), dropTrailingPathSeparator) +import System.FilePath import Control.Concurrent (threadDelay) import qualified Data.Char as Char -import System.Directory (canonicalizePath, copyFile, copyFile, doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getDirectoryContents, listDirectory) +import System.Directory import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay) import Network.Wait (waitTcpVerbose) +import System.Environment #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) -import System.Directory ( removeFile ) import System.Posix.Files ( createSymbolicLink ) import System.Posix.Resource #endif @@ -113,6 +113,16 @@ withDirectory f = withReaderT withEnv :: [(String, Maybe String)] -> TestM a -> TestM a withEnv e = withReaderT (\env -> env { testEnvironment = testEnvironment env ++ e }) +-- | Prepend a directory to the PATH +addToPath :: FilePath -> TestM a -> TestM a +addToPath exe_dir action = do + env <- getTestEnv + path <- liftIO $ getEnv "PATH" + let newpath = exe_dir ++ [searchPathSeparator] ++ path + let new_env = (("PATH", Just newpath) : (testEnvironment env)) + withEnv new_env action + + -- HACK please don't use me withEnvFilter :: (String -> Bool) -> TestM a -> TestM a withEnvFilter p = withReaderT (\env -> env { testEnvironment = filter (p . fst) (testEnvironment env) }) diff --git a/doc/external-commands.rst b/doc/external-commands.rst index 047d8f4dca0..e72495aa160 100644 --- a/doc/external-commands.rst +++ b/doc/external-commands.rst @@ -1,8 +1,22 @@ External Commands ================= -Cabal provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. +``cabal-install`` provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. -If you execute ``cabal my-custom-command``, Cabal will search the path for an executable named ``cabal-my-custom-command`` and execute it, passing any remaining arguments to this external command. An error will be thrown in case the custom command is not found. +If you execute ``cabal ``, ``cabal-install`` will search the path for an executable named ``cabal-`` and execute it. The name of the command is passed as the first argument and +the remaining arguments are passed afterwards. An error will be thrown in case the custom command is not found. + +The ``$CABAL`` environment variable is set to the path of the ``cabal-install`` executable +which invoked the subcommand. + +It is strongly recommended that you implement your custom commands by calling the +CLI via the ``$CABAL`` variable rather than linking against the ``Cabal`` library. +There is no guarantee that the subcommand will link against the same version of the +``Cabal`` library as ``cabal-install`` so it would lead to unexpected results and +incompatibilities. + +``cabal-install`` can also display the help message of the external command. +When ``cabal help `` is invoked, then ``cabal- --help`` will be called so +your external command can display a help message. For ideas or existing external commands, visit `this Discourse thread `_.