Add revision information to plan.json

Closes #6186

Author: fgaz

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 Data.Either (fromRight)
@@ -160,6 +162,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
@@ -268,6 +275,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 $

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

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

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

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

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

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`.
+}