Merge pull request #4979 from phadej/showFullInstalledPackageInfo

Add showFullInstalledPackageInfo
haskell · Dec 28, 2017 · d7a88c6 · d7a88c6
2 parents 2faf520 + 4085c5e
commit d7a88c6
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 7 deletions.
diff --git a/Cabal/Distribution/InstalledPackageInfo.hs b/Cabal/Distribution/InstalledPackageInfo.hs
@@ -41,6 +41,7 @@ module Distribution.InstalledPackageInfo (
         emptyInstalledPackageInfo,
         parseInstalledPackageInfo,
         showInstalledPackageInfo,
+        showFullInstalledPackageInfo,
         showInstalledPackageInfoField,
         showSimpleInstalledPackageInfoField,
         fieldsInstalledPackageInfo,
@@ -359,8 +360,16 @@ parseInstalledPackageInfo =
 -- -----------------------------------------------------------------------------
 -- Pretty-printing
 
+-- | Pretty print 'InstalledPackageInfo'.
+--
+-- @pkgRoot@ isn't printed, as ghc-pkg prints it manually (as GHC-8.4).
 showInstalledPackageInfo :: InstalledPackageInfo -> String
-showInstalledPackageInfo = showFields fieldsInstalledPackageInfo
+showInstalledPackageInfo ipi =
+    showFullInstalledPackageInfo ipi { pkgRoot = Nothing }
+
+-- | The variant of 'showInstalledPackageInfo' which outputs @pkgroot@ field too.
+showFullInstalledPackageInfo :: InstalledPackageInfo -> String
+showFullInstalledPackageInfo = showFields fieldsInstalledPackageInfo
 
 showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
 showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
@@ -505,8 +514,8 @@ installedFieldDescrs = [
         showFilePath       parseFilePathQ
         haddockHTMLs       (\xs pkg -> pkg{haddockHTMLs=xs})
  , simpleField "pkgroot"
-        (const Disp.empty)        parseFilePathQ
-        (fromMaybe "" . pkgRoot)  (\xs pkg -> pkg{pkgRoot=Just xs})
+        (maybe mempty showFilePath)  (fmap Just parseFilePathQ)
+        pkgRoot                      (\xs pkg -> pkg{pkgRoot=xs})
  ]
 
 deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo]

diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs
@@ -8,7 +8,7 @@ import Test.Tasty.HUnit
 
 import Control.Monad                               (void)
 import Data.Algorithm.Diff                         (Diff (..), getGroupedDiff)
-import Data.Maybe                                  (isJust)
+import Data.Maybe                                  (isJust, isNothing)
 import Distribution.License                        (License (..))
 import Distribution.PackageDescription             (GenericPackageDescription)
 import Distribution.PackageDescription.Parsec      (parseGenericPackageDescription)
@@ -205,11 +205,17 @@ ipiFormatRoundTripTest fp = testCase "roundtrip" $ do
     let contents' = IPI.showInstalledPackageInfo x
     y <- parse contents'
 
-    -- TODO: pkgRoot doesn't seem to be shown!
+    -- ghc-pkg prints pkgroot itself, based on cli arguments!
     let x' = x { IPI.pkgRoot = Nothing }
-    let y' = y { IPI.pkgRoot = Nothing }
-
+    let y' = y
+    assertBool "pkgRoot isn't shown" (isNothing (IPI.pkgRoot y))
     assertEqual "re-parsed doesn't match" x' y'
+
+    -- Complete round-trip
+    let contents2 = IPI.showFullInstalledPackageInfo x
+    z <- parse contents2
+    assertEqual "re-parsed doesn't match" x z
+
   where
     parse :: String -> IO IPI.InstalledPackageInfo
     parse c = do