diff --git a/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal b/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal new file mode 100644 index 00000000000..9f3b1a4ed27 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.4 +name: InvalidDep +version: 0.1.0.0 + +executable Inv + main-is: Main.hs + hs-source-dirs: src + build-depends: another-framework + default-language: Haskell2010 + diff --git a/cabal-testsuite/PackageTests/Status/Invalid/cabal.project b/cabal-testsuite/PackageTests/Status/Invalid/cabal.project new file mode 100644 index 00000000000..6f920794c80 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal b/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal new file mode 100644 index 00000000000..87eb0492c91 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal @@ -0,0 +1,8 @@ +name: another-framework +version: 0.8.1.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base <3 && >=3 + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs b/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs new file mode 100644 index 00000000000..eef02a80080 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStr "Test" diff --git a/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out new file mode 100644 index 00000000000..c78a13ef3dd --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out @@ -0,0 +1,20 @@ +# cabal v2-update +Downloading the latest package list from test-local-repo +# cabal status +Resolving dependencies... +Error: cabal: Could not resolve dependencies: +[__0] trying: InvalidDep-0.1.0.0 (user goal) +[__1] trying: another-framework-0.8.1.1 (dependency of InvalidDep) +[__2] next goal: base (dependency of another-framework) +[__2] rejecting: base-/installed- (conflict: another-framework => base<3 && >=3) +[__2] fail (backjumping, conflict set: another-framework, base) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: another-framework (3), InvalidDep (2), base (2) +# cabal status +Resolving dependencies... +Error: cabal: Could not resolve dependencies: +[__0] trying: InvalidDep-0.1.0.0 (user goal) +[__1] trying: another-framework-0.8.1.1 (dependency of InvalidDep) +[__2] next goal: base (dependency of another-framework) +[__2] rejecting: base-/installed- (conflict: another-framework => base<3 && >=3) +[__2] fail (backjumping, conflict set: another-framework, base) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: another-framework (3), InvalidDep (2), base (2) diff --git a/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs new file mode 100644 index 00000000000..1055d0b608f --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withRepo "repo" $ do + -- no build plan available + r <- fails $ cabal' "status" ["--output-format=json", "--target", "src/Main.hs"] + assertOutputContains "Could not resolve dependencies" r + -- TODO: should this actually work? + r <- fails $ cabal' "status" ["--output-format=json", "--compiler"] + assertOutputContains "Could not resolve dependencies" r diff --git a/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal b/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal new file mode 100644 index 00000000000..49c9f939741 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal @@ -0,0 +1,69 @@ +cabal-version: 2.4 +name: Simple +version: 0.1.0.0 + +library + exposed-modules: + MyLib + MyLib2 + + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + +library unbuildable + exposed-modules: MyLib2 + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 + buildable: False + +library compilefail + exposed-modules: Fails + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 + buildable: False + +executable Simple + main-is: Main.hs + + -- Module that belongs to multiple components + other-modules: MyLib + hs-source-dirs: src exe + default-language: Haskell2010 + +-- Just some simple config to test 'exes' meta command +executable Simple2 + main-is: Main2.hs + + -- Module that belongs to multiple components + other-modules: MyLib + hs-source-dirs: src exe + default-language: Haskell2010 + +test-suite Tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: base + +benchmark Benchs + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: base + +foreign-library myforeignlib + type: native-shared + + if os(windows) + options: standalone + + other-modules: MyForeignLib.Hello + MyForeignLib.SomeBindings + MyForeignLib.AnotherVal + build-depends: base + hs-source-dirs: flibsrc + c-sources: csrc/MyForeignLibWrapper.c + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs b/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs new file mode 100644 index 00000000000..d1eb41ede58 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs @@ -0,0 +1,3 @@ +module Bench where + +main = putStr "Benchmarks!" diff --git a/cabal-testsuite/PackageTests/Status/Simple/cabal.project b/cabal-testsuite/PackageTests/Status/Simple/cabal.project new file mode 100644 index 00000000000..6f920794c80 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-testsuite/PackageTests/Status/Simple/compiler.out b/cabal-testsuite/PackageTests/Status/Simple/compiler.out new file mode 100644 index 00000000000..759e5ad3710 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/compiler.out @@ -0,0 +1,3 @@ +# cabal status +Resolving dependencies... +{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""}} diff --git a/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs b/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs new file mode 100644 index 00000000000..127033544cf --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo +import Data.Maybe + +main = cabalTest $ do + r <- cabal' "status" ["--output-format=json", "--compiler"] + statusInfo <- withJsonOutput r + assertBool "Must contain compiler information" (isJust $ siCompiler statusInfo) diff --git a/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c b/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c new file mode 100644 index 00000000000..3347c970e7d --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c @@ -0,0 +1,24 @@ +#include +#include +#include "HsFFI.h" + +bool myForeignLibInit(void){ + int argc = 2; + char *argv[] = { "+RTS", "-A32m", NULL }; + char **pargv = argv; + + // Initialize Haskell runtime + hs_init(&argc, &pargv); + + // do any other initialization here and + // return false if there was a problem + return true; +} + +void myForeignLibExit(void){ + hs_exit(); +} + +int cFoo2() { + return 1234; +} diff --git a/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs b/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs new file mode 100644 index 00000000000..2bba7565907 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Test" diff --git a/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs b/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs new file mode 100644 index 00000000000..2bba7565907 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Test" diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs new file mode 100644 index 00000000000..60fd694a14c --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs @@ -0,0 +1,3 @@ +module MyForeignLib.AnotherVal where + +anotherVal = 189 diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs new file mode 100644 index 00000000000..a9e54986dc6 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs @@ -0,0 +1,13 @@ +-- | Module with single foreign export +module MyForeignLib.Hello (sayHi) where + +import MyForeignLib.SomeBindings +import MyForeignLib.AnotherVal + +foreign export ccall sayHi :: IO () + +-- | Say hi! +sayHi :: IO () +sayHi = putStrLn $ + "Hi from a foreign library! Foo has value " ++ show valueOfFoo + ++ " and anotherVal has value " ++ show anotherVal diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc new file mode 100644 index 00000000000..beea7f8c49c --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc @@ -0,0 +1,10 @@ +-- | Module that needs the hsc2hs preprocessor +module MyForeignLib.SomeBindings where + +#define FOO 1 + +#ifdef FOO +-- | Value guarded by a CPP flag +valueOfFoo :: Int +valueOfFoo = 5678 +#endif diff --git a/cabal-testsuite/PackageTests/Status/Simple/plan.out b/cabal-testsuite/PackageTests/Status/Simple/plan.out new file mode 100644 index 00000000000..68ebc2e9844 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/plan.out @@ -0,0 +1,3 @@ +# cabal status +Resolving dependencies... +{"cabal-version":"3.9","targets":[{"target":"src/Main.hs","unit-id":null}]} diff --git a/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs b/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs new file mode 100644 index 00000000000..30136bca921 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs @@ -0,0 +1,7 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + -- Make sure plan.json is generated, even if no target is resolved + cabal "status" ["--output-format=json", "--target", "src/Main.hs"] + withPlan $ do + pure () diff --git a/cabal-testsuite/PackageTests/Status/Simple/simple.out b/cabal-testsuite/PackageTests/Status/Simple/simple.out new file mode 100644 index 00000000000..d1740c09bba --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/simple.out @@ -0,0 +1,41 @@ +# cabal status +Error: cabal: The status command requires the flag '--output-format'. +# cabal status +Resolving dependencies... +{"cabal-version":"3.9","targets":[{"target":"exe/Main.hs","unit-id":"Simple-0.1.0.0-inplace-Simple"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"exe/Main.hs","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"exe/Main2.hs","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"src/MyLib.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"src/MyLib2.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"bench/Bench.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"test/Main.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"flibsrc/MyForeignLib/AnotherVal.hs","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"flibsrc/MyForeignLib/Hello.hs","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"flibsrc/MyForeignLib/SomeBindings.hsc","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"csrc/MyForeignLibWrapper.c","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"Benchs","unit-id":"Simple-0.1.0.0-inplace-Benchs"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"all","unit-id":"Simple-0.1.0.0-inplace"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-Simple2"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"exes","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"exes","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"tests","unit-id":"Simple-0.1.0.0-inplace-Tests"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"benchmarks","unit-id":"Simple-0.1.0.0-inplace-Benchs"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"executables","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"executables","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"Main2.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"Main3.hs","unit-id":null},{"target":"src/MyLib2.hs","unit-id":null},{"target":"Main3.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"Lib.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"targets":[{"target":"Lib.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","targets":[{"target":"Lib2.hs","unit-id":null}]} +# cabal status +{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"targets":[{"target":"Lib.hs","unit-id":null}]} diff --git a/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs b/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs new file mode 100644 index 00000000000..5dd5b3b2cac --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs @@ -0,0 +1,54 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo +import Data.Maybe (isJust) +import Data.List (sort, nub) + +main = cabalTest $ do + -- output-format flag is missing but required, must fail + r <- fails $ cabal' "status" ["--target", "Main.hs"] + assertOutputContains "The status command requires the flag '--output-format'." r + + -- Simple file target tests + runStatusWithTargets ["exe/Main.hs"] + runStatusWithTargets ["exe/Main.hs", "exe/Main2.hs"] -- multiple targets + runStatusWithTargets ["src/MyLib.hs"] -- belongs to multiple components + runStatusWithTargets ["src/MyLib2.hs"] + runStatusWithTargets ["bench/Bench.hs"] + runStatusWithTargets ["test/Main.hs"] + runStatusWithTargets ["flibsrc/MyForeignLib/AnotherVal.hs", + "flibsrc/MyForeignLib/Hello.hs", + "flibsrc/MyForeignLib/SomeBindings.hsc", + "csrc/MyForeignLibWrapper.c" + ] + -- TODO: this should not fail, that's a bug! + -- runStatusWithTargets ["lib:Simple", "exe:Simple", "Simple:exe:Simple"] + -- pkgs syntax twsts + runStatusWithTargets ["Benchs"] + + -- meta targets + runStatusWithTargets ["all"] + runStatusWithTargets ["exes"] + runStatusWithTargets ["tests"] + runStatusWithTargets ["benchmarks"] + + -- unknown target selectors + runStatusWithTargets ["executables"] + runStatusWithTargets ["Main2.hs"] + + -- partially works, Main3.hs isn't known while `src/MyLib2.hs` is. + runStatusWithTargets ["Main3.hs", "src/MyLib2.hs"] + + -- component fails to compile, still works + cabal "status" ["--output-format=json", "--target", "Lib.hs"] + cabal "status" ["--output-format=json", "--compiler", "--target", "Lib.hs"] + -- unbuildable target, resolves to 'null' + cabal "status" ["--output-format=json", "--target", "Lib2.hs"] + cabal "status" ["--output-format=json", "--compiler", "--target", "Lib.hs"] + where + runStatusWithTargets :: [String] -> TestM () + runStatusWithTargets targets = do + r <- cabal' "status" $ ["--output-format=json"] ++ concatMap (\t -> ["--target", t]) targets + statusInfo <- withJsonOutput r + assertBool "Must contain targets" (isJust $ siTargetResolving statusInfo) + assertBool "Must contain all targets at least once" + (Just (nub $ sort targets) == fmap (nub . sort . map rtOriginalTarget) (siTargetResolving statusInfo)) diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs b/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs new file mode 100644 index 00000000000..ba479e8f17b --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs @@ -0,0 +1,4 @@ +module Fails where + +-- fails to compile intentionally +foo = diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs new file mode 100644 index 00000000000..e657c4403f6 --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs new file mode 100644 index 00000000000..c9b80390bbb --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs @@ -0,0 +1,4 @@ +module MyLib2 (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs b/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs new file mode 100644 index 00000000000..d3c7f187c8f --- /dev/null +++ b/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs @@ -0,0 +1,3 @@ +module Bench where + +main = putStr "Tests!" diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index 02c1cb7e733..335e342e847 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} module Test.Cabal.DecodeShowBuildInfo where import Test.Cabal.Prelude @@ -14,6 +15,8 @@ import Distribution.Package import Distribution.Pretty (prettyShow) import Control.Monad.Trans.Reader import Data.Aeson +import Data.List (sort, nub) +import Data.Maybe (maybeToList) import GHC.Generics import System.Exit @@ -186,3 +189,64 @@ bench = CBenchName . mkUnqualComponentName -- | Helper function to create a main library component name. mainLib :: ComponentName mainLib = CLibName LMainLibName + +-- ----------------------------------------------------------- +-- Cabal Status json decoder +-- ----------------------------------------------------------- + +-- Copied from 'CmdStatus' at the moment, but maybe the datatypes diverge at some point +-- in the future. Thus, we copy them here. + +data StatusInformation = StatusInformation + { siCabalVersion :: String + , siCompiler :: Maybe CompilerInformation + , siTargetResolving :: Maybe [ResolvedTarget] + } + deriving (Generic, Show, Read, Eq, Ord) + +data CompilerInformation = CompilerInformation + { ciFlavour :: String + , ciCompilerId :: String + , ciPath :: FilePath + } + deriving (Generic, Show, Read, Eq, Ord) + +data ResolvedTarget = ResolvedTarget + { rtOriginalTarget :: String + -- | UnitId of the resolved target. + -- If 'Nothing', then the given target can not be resolved + -- to a target in this project. + , rtUnitId :: Maybe String + } + deriving (Generic, Show, Read, Eq, Ord) + +instance FromJSON StatusInformation where + parseJSON = withObject "StatusInformation" $ \v -> do + StatusInformation + <$> v .: "cabal-version" + <*> v .:? "compiler" + <*> v .:? "targets" + +instance FromJSON CompilerInformation where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 3 . camelTo2 '-' } + +instance FromJSON ResolvedTarget where + parseJSON = withObject "ResolvedTarget" $ \v -> do + ResolvedTarget + <$> v .: "target" + <*> v .: "unit-id" + +-- ----------------------------------------------------------- +-- Assertion Helpers to define succinct test cases +-- ----------------------------------------------------------- + +allTargets :: StatusInformation -> [TargetString] +allTargets si = nub . sort . map rtOriginalTarget . concat $ maybeToList $ siTargetResolving si + +type TargetString = String + +resolve :: TargetString -> StatusInformation -> TestM [ResolvedTarget] +resolve target si = do + case fmap (filter ((== target) . rtOriginalTarget)) (siTargetResolving si) of + Nothing -> fail $ "Failed to find \"" ++ target ++ "\". Available: " ++ show (allTargets si) + Just rts -> pure rts diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 6f8a0a7c516..96ff6cafdec 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -330,6 +330,14 @@ withProjectFile :: FilePath -> TestM a -> TestM a withProjectFile fp m = withReaderT (\env -> env { testCabalProjectFile = fp }) m +-- | Decode a json object from the *last* line of the result output. +withJsonOutput :: JSON.FromJSON a => WithCallStack (Result -> TestM a) +withJsonOutput r = do + let jsonLine = last . lines . getMarkedOutput $ resultOutput r + case JSON.eitherDecode' (BSL.fromStrict $ C.pack jsonLine) of + Left err -> fail $ "Failed to decode JSON object:" ++ err + Right o -> pure o + -- | Assuming we've successfully configured a new-build project, -- read out the plan metadata so that we can use it to do other -- operations.