From 734227f8fb1921b4aa961169734380c3dd605d7b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 2 Mar 2019 19:45:30 +0200 Subject: [PATCH] Fix hackage-tests roundtrip --- Cabal/Cabal.cabal | 4 +-- .../Distribution/PackageDescription/Parsec.hs | 25 +++++++++++-------- Cabal/tests/HackageTests.hs | 5 ++-- 3 files changed, 20 insertions(+), 14 deletions(-) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 3cd2cdabdae..eee1b029b68 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -605,7 +605,7 @@ test-suite parser-tests if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.1 && <0.1 + tree-diff >= 0.0.2 && <0.1 other-modules: Instances.TreeDiff Instances.TreeDiff.Language @@ -671,7 +671,7 @@ test-suite hackage-tests if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.1 && <0.1 + tree-diff >= 0.0.2 && <0.1 other-modules: Instances.TreeDiff Instances.TreeDiff.Language diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index 7a1cc5b1999..9513d4fa018 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -80,6 +80,8 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Distribution.Compat.Newtype as Newtype import qualified Distribution.Types.BuildInfo.Lens as L +import qualified Distribution.Types.Executable.Lens as L +import qualified Distribution.Types.ForeignLib.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L import qualified Text.Parsec as P @@ -292,7 +294,7 @@ goSections specVer = traverse_ process | name == "foreign-library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') fromBuildInfo' commonStanzas fields + flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') (fromBuildInfo' name') commonStanzas fields let hasType ts = foreignLibType ts /= foreignLibType mempty unless (onAllBranches hasType flib) $ lift $ parseFailure pos $ concat @@ -309,14 +311,14 @@ goSections specVer = traverse_ process | name == "executable" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - exe <- lift $ parseCondTree' (executableFieldGrammar name') fromBuildInfo' commonStanzas fields + exe <- lift $ parseCondTree' (executableFieldGrammar name') (fromBuildInfo' name') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condExecutables %= snoc (name', exe) | name == "test-suite" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - testStanza <- lift $ parseCondTree' testSuiteFieldGrammar fromBuildInfo' commonStanzas fields + testStanza <- lift $ parseCondTree' testSuiteFieldGrammar (fromBuildInfo' name') commonStanzas fields testSuite <- lift $ traverse (validateTestSuite pos) testStanza let hasType ts = testInterface ts /= testInterface mempty @@ -334,7 +336,7 @@ goSections specVer = traverse_ process | name == "benchmark" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar fromBuildInfo' commonStanzas fields + benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar (fromBuildInfo' name') commonStanzas fields bench <- lift $ traverse (validateBenchmark pos) benchStanza let hasType ts = benchmarkInterface ts /= benchmarkInterface mempty @@ -547,10 +549,13 @@ with new AST, this all need to be rewritten. type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo -- | Create @a@ from 'BuildInfo'. +-- This class is used to implement common stanza parsing. -- -- Law: @view buildInfo . fromBuildInfo = id@ +-- +-- This takes name, as 'FieldGrammar's take names too. class L.HasBuildInfo a => FromBuildInfo a where - fromBuildInfo' :: BuildInfo -> a + fromBuildInfo' :: UnqualComponentName -> BuildInfo -> a libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library libraryFromBuildInfo n bi = emptyLibrary @@ -561,15 +566,15 @@ libraryFromBuildInfo n bi = emptyLibrary , libBuildInfo = bi } -instance FromBuildInfo BuildInfo where fromBuildInfo' = id -instance FromBuildInfo ForeignLib where fromBuildInfo' bi = set L.buildInfo bi emptyForeignLib -instance FromBuildInfo Executable where fromBuildInfo' bi = set L.buildInfo bi emptyExecutable +instance FromBuildInfo BuildInfo where fromBuildInfo' _ = id +instance FromBuildInfo ForeignLib where fromBuildInfo' n bi = set L.foreignLibName n $ set L.buildInfo bi emptyForeignLib +instance FromBuildInfo Executable where fromBuildInfo' n bi = set L.exeName n $ set L.buildInfo bi emptyExecutable instance FromBuildInfo TestSuiteStanza where - fromBuildInfo' = TestSuiteStanza Nothing Nothing Nothing + fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi instance FromBuildInfo BenchmarkStanza where - fromBuildInfo' = BenchmarkStanza Nothing Nothing Nothing + fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi parseCondTreeWithCommonStanzas :: forall a. L.HasBuildInfo a diff --git a/Cabal/tests/HackageTests.hs b/Cabal/tests/HackageTests.hs index d93c5c9eeb4..066041a9100 100644 --- a/Cabal/tests/HackageTests.hs +++ b/Cabal/tests/HackageTests.hs @@ -70,7 +70,8 @@ import qualified Distribution.Types.PackageDescription.Lens as L import qualified Options.Applicative as O #ifdef MIN_VERSION_tree_diff -import Data.TreeDiff (ansiWlEditExpr, ediff) +import Data.TreeDiff (ediff) +import Data.TreeDiff.Pretty (ansiWlEditExprCompact) import Instances.TreeDiff () #endif @@ -238,7 +239,7 @@ roundtripTest testFieldsTransform fpath bs = do assertEqual' bs' x y = unless (x == y || fpath == "ixset/1.0.4/ixset.cabal") $ do putStrLn fpath #ifdef MIN_VERSION_tree_diff - print $ ansiWlEditExpr $ ediff x y + print $ ansiWlEditExprCompact $ ediff x y #else putStrLn "<<<<<<" print x