diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs index 3654e9c05fd..9286bd7f32f 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs @@ -66,6 +66,8 @@ import Distribution.Verbosity import Distribution.Client.Compat.Prelude import Prelude () +import Control.Monad ((<=<)) + import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BS import qualified Data.Map as Map @@ -159,6 +161,11 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = , "id" J..= (jdisplay . installedUnitId) elab , "pkg-name" J..= (jdisplay . pkgName . packageId) elab , "pkg-version" J..= (jdisplay . pkgVersion . packageId) elab + , -- The `x-revision` field is a feature of repos (not cabal itself), + -- but it's needed for external tools to unambiguously fetch + -- packages without having to use index-state and go through + -- the whole repo index, so we include it in the plan file. + "pkg-revision" J..= J.Number (elaboratedPackageToRevision elab) , "flags" J..= J.object [ PD.unFlagName fn J..= v @@ -267,6 +274,13 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = , "uri" J..= J.String (show (remoteRepoURI repoRemote)) ] + elaboratedPackageToRevision :: ElaboratedConfiguredPackage -> Double + elaboratedPackageToRevision = + fromMaybe 0 + . (readMaybe <=< lookup "x-revision") + . PD.customFieldsPD + . elabPkgDescription + sourceRepoToJ :: SourceRepoMaybe -> J.Value sourceRepoToJ SourceRepositoryPackage{..} = J.object $ diff --git a/cabal-testsuite/PackageTests/PlanJson/cabal.test.hs b/cabal-testsuite/PackageTests/PlanJson/cabal.test.hs new file mode 100644 index 00000000000..d27507c0fac --- /dev/null +++ b/cabal-testsuite/PackageTests/PlanJson/cabal.test.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} +import Distribution.Types.PackageName (PackageName, mkPackageName) +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo +import Test.Cabal.Plan +import Data.Maybe (mapMaybe) + +getRevisionFor :: PackageName -> InstallItem -> Maybe Revision +getRevisionFor pkgName (AConfiguredGlobal configuredGlobal) + | configuredGlobalPackageName configuredGlobal == pkgName = + Just $ configuredGlobalRevision configuredGlobal +getRevisionFor _ _ = Nothing + +main = cabalTest $ recordMode DoNotRecord $ do + let go = do + cabal "build" ["--dry-run", "all"] + withPlan $ do + Just plan <- testPlan `fmap` getTestEnv + let [fooRev] = mapMaybe (getRevisionFor $ mkPackageName "foo") $ planInstallPlan plan + let [barRev] = mapMaybe (getRevisionFor $ mkPackageName "bar") $ planInstallPlan plan + assertEqual "revision of package foo" fooRev $ Revision 0 + assertEqual "revision of package bar" barRev $ Revision 1337 + withRepo "repo" go + cabal "clean" [] + withRemoteRepo "repo" $ do + cabal "update" [] + go diff --git a/cabal-testsuite/PackageTests/PlanJson/pkg.cabal b/cabal-testsuite/PackageTests/PlanJson/pkg.cabal new file mode 100644 index 00000000000..168220eac9c --- /dev/null +++ b/cabal-testsuite/PackageTests/PlanJson/pkg.cabal @@ -0,0 +1,8 @@ +name: pkg +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +executable my-exe + main-is: Main.hs + build-depends: base, foo, bar diff --git a/cabal-testsuite/PackageTests/PlanJson/repo/bar-1.0/bar.cabal b/cabal-testsuite/PackageTests/PlanJson/repo/bar-1.0/bar.cabal new file mode 100644 index 00000000000..51a9d29a363 --- /dev/null +++ b/cabal-testsuite/PackageTests/PlanJson/repo/bar-1.0/bar.cabal @@ -0,0 +1,7 @@ +name: bar +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 +x-revision: 1337 + +library diff --git a/cabal-testsuite/PackageTests/PlanJson/repo/foo-1.0/foo.cabal b/cabal-testsuite/PackageTests/PlanJson/repo/foo-1.0/foo.cabal new file mode 100644 index 00000000000..e6e75b94ec1 --- /dev/null +++ b/cabal-testsuite/PackageTests/PlanJson/repo/foo-1.0/foo.cabal @@ -0,0 +1,6 @@ +name: foo +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +library diff --git a/cabal-testsuite/src/Test/Cabal/Plan.hs b/cabal-testsuite/src/Test/Cabal/Plan.hs index b0b46802f85..79340de8ca4 100644 --- a/cabal-testsuite/src/Test/Cabal/Plan.hs +++ b/cabal-testsuite/src/Test/Cabal/Plan.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | Utilities for understanding @plan.json@. module Test.Cabal.Plan ( - Plan, + Plan(..), DistDirOrBinFile(..), + InstallItem(..), + ConfiguredGlobal(..), + Revision(..), planDistDir, buildInfoFile, ) where -import Distribution.Parsec (simpleParsec) +import Distribution.Parsec (simpleParsec, eitherParsec) import Distribution.Pretty (prettyShow) import Distribution.Types.ComponentName +import Distribution.Types.Version import Distribution.Package import qualified Data.Text as Text import Data.Aeson @@ -32,15 +37,22 @@ data ConfiguredInplace = ConfiguredInplace { configuredInplaceDistDir :: FilePath , configuredInplaceBuildInfo :: Maybe FilePath , configuredInplacePackageName :: PackageName + , configuredInplaceVersion :: Version + , configuredInplaceRevision :: Revision , configuredInplaceComponentName :: Maybe ComponentName } deriving Show data ConfiguredGlobal = ConfiguredGlobal { configuredGlobalBinFile :: Maybe FilePath , configuredGlobalPackageName :: PackageName + , configuredGlobalVersion :: Version + , configuredGlobalRevision :: Revision , configuredGlobalComponentName :: Maybe ComponentName } deriving Show +newtype Revision = Revision Int + deriving (Show, Eq, FromJSON) + instance FromJSON Plan where parseJSON (Object v) = fmap Plan (v .: "install-plan") parseJSON invalid = typeMismatch "Plan" invalid @@ -65,22 +77,29 @@ instance FromJSON ConfiguredInplace where dist_dir <- v .: "dist-dir" build_info <- v .:? "build-info" pkg_name <- v .: "pkg-name" + pkg_version <- v .: "pkg-version" + pkg_revision <- v .: "pkg-revision" component_name <- v .:? "component-name" - return (ConfiguredInplace dist_dir build_info pkg_name component_name) + return (ConfiguredInplace dist_dir build_info pkg_name pkg_version pkg_revision component_name) parseJSON invalid = typeMismatch "ConfiguredInplace" invalid instance FromJSON ConfiguredGlobal where parseJSON (Object v) = do bin_file <- v .:? "bin-file" pkg_name <- v .: "pkg-name" + pkg_version <- v .: "pkg-version" + pkg_revision <- v .: "pkg-revision" component_name <- v .:? "component-name" - return (ConfiguredGlobal bin_file pkg_name component_name) + return (ConfiguredGlobal bin_file pkg_name pkg_version pkg_revision component_name) parseJSON invalid = typeMismatch "ConfiguredGlobal" invalid instance FromJSON PackageName where parseJSON (String t) = return (mkPackageName (Text.unpack t)) parseJSON invalid = typeMismatch "PackageName" invalid +instance FromJSON Version where + parseJSON = withText "Version" $ either fail pure . eitherParsec . Text.unpack + instance FromJSON ComponentName where parseJSON (String t) = case simpleParsec s of diff --git a/changelog.d/pr-10980 b/changelog.d/pr-10980 new file mode 100644 index 00000000000..5c24e3e7a6d --- /dev/null +++ b/changelog.d/pr-10980 @@ -0,0 +1,9 @@ +synopsis: Added revision information to `plan.json` +packages: cabal-install +prs: #10980 +issues: #6186 + +description: { + The contents of `x-revision` `.cabal` fields are now available in `plan.json`. + They are located under `pkg-src.repo.pkg-revision`, have type `Number`, and are only available for `repo-tar` repositories of type `remote-repo` or `secure-repo`. +}