diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs index 454f9f18878..3a7e5a3dd9c 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 @@ -259,13 +261,24 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = J.object [ "type" J..= J.String "remote-repo" , "uri" J..= J.String (show (remoteRepoURI repoRemote)) + , -- The x-revision field is a feature of remote repos, + -- so we only output it for remote/secure repos, in the "repo" object. + "pkg-revision" J..= J.Number (elaboratedPackageToRevision elab) ] RepoSecure{..} -> J.object [ "type" J..= J.String "secure-repo" , "uri" J..= J.String (show (remoteRepoURI repoRemote)) + , "pkg-revision" J..= J.Number (elaboratedPackageToRevision elab) ] + 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..f200af89782 --- /dev/null +++ b/cabal-testsuite/PackageTests/PlanJson/cabal.test.hs @@ -0,0 +1,23 @@ +{-# 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 $ pkgRevision $ repo $ configuredGlobalPkgSrc configuredGlobal +getRevisionFor _ _ = Nothing + +main = cabalTest $ recordMode DoNotRecord $ do + withRemoteRepo "repo" $ do + cabal "update" [] + 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 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..6db948ea8b2 100644 --- a/cabal-testsuite/src/Test/Cabal/Plan.hs +++ b/cabal-testsuite/src/Test/Cabal/Plan.hs @@ -1,9 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | Utilities for understanding @plan.json@. module Test.Cabal.Plan ( - Plan, + Plan(..), DistDirOrBinFile(..), + InstallItem(..), + ConfiguredGlobal(..), + Revision(..), + PkgSrc(..), + Repo(..), planDistDir, buildInfoFile, ) where @@ -16,6 +23,7 @@ import qualified Data.Text as Text import Data.Aeson import Data.Aeson.Types import Control.Monad +import GHC.Generics (Generic) -- TODO: index this data Plan = Plan { planInstallPlan :: [InstallItem] } @@ -32,15 +40,33 @@ data ConfiguredInplace = ConfiguredInplace { configuredInplaceDistDir :: FilePath , configuredInplaceBuildInfo :: Maybe FilePath , configuredInplacePackageName :: PackageName - , configuredInplaceComponentName :: Maybe ComponentName } + , configuredInplaceComponentName :: Maybe ComponentName + , configuredInplacePkgSrc :: PkgSrc } deriving Show data ConfiguredGlobal = ConfiguredGlobal { configuredGlobalBinFile :: Maybe FilePath , configuredGlobalPackageName :: PackageName - , configuredGlobalComponentName :: Maybe ComponentName } + , configuredGlobalComponentName :: Maybe ComponentName + , configuredGlobalPkgSrc :: PkgSrc } deriving Show +newtype Revision = Revision Int + deriving (Show, Eq, FromJSON) + +-- | A stripped-down 'Distribution.Client.Types.PackageLocation.PackageLocation' +data PkgSrc + = RepoTar { repo :: Repo } + | PkgSrcOther + deriving (Show, Generic) + +-- | A stripped-down 'Distribution.Client.Types.Repo.Repo', plus revision information +data Repo + = LocalRepoNoIndex + | RemoteRepo { pkgRevision :: Revision } + | SecureRepo { pkgRevision :: Revision } + deriving (Show, Generic) + instance FromJSON Plan where parseJSON (Object v) = fmap Plan (v .: "install-plan") parseJSON invalid = typeMismatch "Plan" invalid @@ -66,7 +92,8 @@ instance FromJSON ConfiguredInplace where build_info <- v .:? "build-info" pkg_name <- v .: "pkg-name" component_name <- v .:? "component-name" - return (ConfiguredInplace dist_dir build_info pkg_name component_name) + pkg_src <- v .: "pkg-src" + return (ConfiguredInplace dist_dir build_info pkg_name component_name pkg_src) parseJSON invalid = typeMismatch "ConfiguredInplace" invalid instance FromJSON ConfiguredGlobal where @@ -74,7 +101,8 @@ instance FromJSON ConfiguredGlobal where bin_file <- v .:? "bin-file" pkg_name <- v .: "pkg-name" component_name <- v .:? "component-name" - return (ConfiguredGlobal bin_file pkg_name component_name) + pkg_src <- v .: "pkg-src" + return (ConfiguredGlobal bin_file pkg_name component_name pkg_src) parseJSON invalid = typeMismatch "ConfiguredGlobal" invalid instance FromJSON PackageName where @@ -89,6 +117,21 @@ instance FromJSON ComponentName where where s = Text.unpack t parseJSON invalid = typeMismatch "ComponentName" invalid +instance FromJSON PkgSrc where + parseJSON (Object v) = do + t <- v .: "type" + case t :: String of + "repo-tar" -> RepoTar <$> v .: "repo" + _ -> return PkgSrcOther + parseJSON invalid = typeMismatch "PkgSrc" invalid + +instance FromJSON Repo where + parseJSON = genericParseJSON defaultOptions + { constructorTagModifier = camelTo2 '-' + , fieldLabelModifier = camelTo2 '-' + , sumEncoding = TaggedObject "type" "" + } + data DistDirOrBinFile = DistDir FilePath | BinFile FilePath planDistDir :: Plan -> PackageName -> ComponentName -> DistDirOrBinFile 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`. +}