feat: defer merging of common stanza imports

proof of concept

retain imports for foreignLib section

retain imports for executable section

retain imports for test-suite

retain imports for benchmark

attempt to insert used imports and not all imports

use newtype

change import data type; fix issues with import propagation & decoration

fix missing import names in testSuite

fix missing import names in benchmark

run fourmolu

run hlint

defer merging prototype

Currently we have achieve the following:
- Stop merging, the merging function "endo" is id
- CondTree are completly retained in bigger types such as libarry and
  executable

We will need to do the following:
- Allow merging in the accessor

We broke:
- A bunch of Read and Ord instances

Revert "defer merging prototype"

This reverts commit 21636db.

stop merging

retain common stanza in GenericPackageDescription

experiment: use WithImport in gpd

add function to merge imports

mergeLibrary

fix transitive imports retaintion and merging

run fourmolu

deferred merging for sublibraries

simplification; remove todos

retain foreignlib imports

retain executable imports

retain TestSuiteStanza imports

We isolated the type TestSuiteStanza and the logic to infer test type

retain BenchmarkStanza imports

We isolated the BenchmarkStanza type and the logic to infer benchmark
type.

clean up

remove benchmark import field

We now use the WithImports type to tag imports

introduce type alias in GenericPackageDescription

add GenericPackageDescription pattern to hide internal implementation

backward compatible accessors

fix compiler errors

add todo

fix compiler errors for integration test

run fourmolu

don't expose intemediary accessors

remove early experiment "import" fields in TestSuite and Benchmark

move TestSuiteStanza validation to its module

clean up {TestSuite,Benchmark}Stanza exports from FieldGrammar

restore old behaviour in code working with PackageDescription

we fixed GenericPackageDescription's constructor

patch {TestSuite,Benchmark}Stanza type when using accessor

remove accessors tests

fix accessor dropping common stanza map when non it is not required

This guarantees that unmerged internal representation is correct

run fourmolu

remove FieldGrammar export {TestSuite,Benchmark}Stanza

fix(GenericPackageDescription): "pattern" keyword deprecated after 914

test: remove new test files

test: add tests for gpd accessors

test: check equality on each field

test: improve import list

test: use @? operator

test: use a tuple to store all gpd fields

test: define ToExpr tuple instance manually

test: update expected

test: use Rec constructor to annotate field names

test: update expected

test: remove comment not in scope for this PR

test: use field equality in hackage tests

test: add new test files

test: fix test build

test: newtype to guide GPD ToExpr instance

test: add internal accessors test

test: update expected for internal accessors test

test: update expected

test: fix hackage tests ToExpr instance

Author: leana8959

Cabal-syntax/Cabal-syntax.cabal

@@ -121,6 +121,7 @@ library
     Distribution.Types.AbiDependency
     Distribution.Types.AbiHash
     Distribution.Types.Benchmark
+    Distribution.Types.BenchmarkStanza
     Distribution.Types.Benchmark.Lens
     Distribution.Types.BenchmarkInterface
     Distribution.Types.BenchmarkType
@@ -160,6 +161,8 @@ library
     Distribution.Types.Library.Lens
     Distribution.Types.LibraryName
     Distribution.Types.LibraryVisibility
+    Distribution.Types.Imports
+    Distribution.Types.Imports.Lens
     Distribution.Types.MissingDependency
     Distribution.Types.MissingDependencyReason
     Distribution.Types.Mixin
@@ -183,6 +186,7 @@ library
     Distribution.Types.SourceRepo
     Distribution.Types.SourceRepo.Lens
     Distribution.Types.TestSuite
+    Distribution.Types.TestSuiteStanza
     Distribution.Types.TestSuite.Lens
     Distribution.Types.TestSuiteInterface
     Distribution.Types.TestType

Cabal-syntax/src/Distribution/PackageDescription.hs

@@ -15,6 +15,9 @@ module Distribution.PackageDescription
       module Distribution.Types.PackageDescription
   , module Distribution.Types.GenericPackageDescription
 
+    -- * Working with Imports
+  , module Distribution.Types.Imports
+
     -- * Components
   , module Distribution.Types.ComponentName
 
@@ -29,11 +32,13 @@ module Distribution.PackageDescription
 
     -- ** TestSuite
   , module Distribution.Types.TestSuite
+  , module Distribution.Types.TestSuiteStanza
   , module Distribution.Types.TestType
   , module Distribution.Types.TestSuiteInterface
 
     -- ** Benchmark
   , module Distribution.Types.Benchmark
+  , module Distribution.Types.BenchmarkStanza
   , module Distribution.Types.BenchmarkType
   , module Distribution.Types.BenchmarkInterface
 
@@ -88,6 +93,7 @@ import Prelude ()
 
 import Distribution.Types.Benchmark
 import Distribution.Types.BenchmarkInterface
+import Distribution.Types.BenchmarkStanza
 import Distribution.Types.BenchmarkType
 import Distribution.Types.BuildInfo
 import Distribution.Types.BuildType
@@ -105,6 +111,7 @@ import Distribution.Types.ForeignLibOption
 import Distribution.Types.ForeignLibType
 import Distribution.Types.GenericPackageDescription
 import Distribution.Types.HookedBuildInfo
+import Distribution.Types.Imports
 import Distribution.Types.IncludeRenaming
 import Distribution.Types.LegacyExeDependency
 import Distribution.Types.Library
@@ -124,5 +131,6 @@ import Distribution.Types.SetupBuildInfo
 import Distribution.Types.SourceRepo
 import Distribution.Types.TestSuite
 import Distribution.Types.TestSuiteInterface
+import Distribution.Types.TestSuiteStanza
 import Distribution.Types.TestType
 import Distribution.Types.UnqualComponentName

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

@@ -22,22 +22,10 @@ module Distribution.PackageDescription.FieldGrammar
   , executableFieldGrammar
 
     -- * Test suite
-  , TestSuiteStanza (..)
   , testSuiteFieldGrammar
-  , validateTestSuite
-  , unvalidateTestSuite
-
-    -- ** Lenses
-  , testStanzaTestType
-  , testStanzaMainIs
-  , testStanzaTestModule
-  , testStanzaBuildInfo
 
     -- * Benchmark
-  , BenchmarkStanza (..)
   , benchmarkFieldGrammar
-  , validateBenchmark
-  , unvalidateBenchmark
 
     -- * Field grammars
   , formatDependencyList
@@ -48,12 +36,6 @@ module Distribution.PackageDescription.FieldGrammar
   , formatOtherExtensions
   , formatOtherModules
 
-    -- ** Lenses
-  , benchmarkStanzaBenchmarkType
-  , benchmarkStanzaMainIs
-  , benchmarkStanzaBenchmarkModule
-  , benchmarkStanzaBuildInfo
-
     -- * Flag
   , flagFieldGrammar
 
@@ -290,43 +272,6 @@ executableFieldGrammar n =
 {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' Executable #-}
 {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-}
 
--------------------------------------------------------------------------------
--- TestSuite
--------------------------------------------------------------------------------
-
--- | An intermediate type just used for parsing the test-suite stanza.
--- After validation it is converted into the proper 'TestSuite' type.
-data TestSuiteStanza = TestSuiteStanza
-  { _testStanzaTestType :: Maybe TestType
-  , _testStanzaMainIs :: Maybe (RelativePath Source File)
-  , _testStanzaTestModule :: Maybe ModuleName
-  , _testStanzaBuildInfo :: BuildInfo
-  , _testStanzaCodeGenerators :: [String]
-  }
-
-instance L.HasBuildInfo TestSuiteStanza where
-  buildInfo = testStanzaBuildInfo
-
-testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
-testStanzaTestType f s = fmap (\x -> s{_testStanzaTestType = x}) (f (_testStanzaTestType s))
-{-# INLINE testStanzaTestType #-}
-
-testStanzaMainIs :: Lens' TestSuiteStanza (Maybe (RelativePath Source File))
-testStanzaMainIs f s = fmap (\x -> s{_testStanzaMainIs = x}) (f (_testStanzaMainIs s))
-{-# INLINE testStanzaMainIs #-}
-
-testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName)
-testStanzaTestModule f s = fmap (\x -> s{_testStanzaTestModule = x}) (f (_testStanzaTestModule s))
-{-# INLINE testStanzaTestModule #-}
-
-testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
-testStanzaBuildInfo f s = fmap (\x -> s{_testStanzaBuildInfo = x}) (f (_testStanzaBuildInfo s))
-{-# INLINE testStanzaBuildInfo #-}
-
-testStanzaCodeGenerators :: Lens' TestSuiteStanza [String]
-testStanzaCodeGenerators f s = fmap (\x -> s{_testStanzaCodeGenerators = x}) (f (_testStanzaCodeGenerators s))
-{-# INLINE testStanzaCodeGenerators #-}
-
 testSuiteFieldGrammar
   :: ( FieldGrammar c g
      , Applicative (g TestSuiteStanza)
@@ -361,117 +306,10 @@ testSuiteFieldGrammar =
     <*> monoidalFieldAla "code-generators" (alaList' CommaFSep Token) testStanzaCodeGenerators
       ^^^ availableSince CabalSpecV3_8 []
 
-validateTestSuite :: CabalSpecVersion -> Position -> TestSuiteStanza -> ParseResult src TestSuite
-validateTestSuite cabalSpecVersion pos stanza = case testSuiteType of
-  Nothing -> pure basicTestSuite
-  Just tt@(TestTypeUnknown _ _) ->
-    pure
-      basicTestSuite
-        { testInterface = TestSuiteUnsupported tt
-        }
-  Just tt
-    | tt `notElem` knownTestTypes ->
-        pure
-          basicTestSuite
-            { testInterface = TestSuiteUnsupported tt
-            }
-  Just tt@(TestTypeExe ver) -> case _testStanzaMainIs stanza of
-    Nothing -> do
-      parseFailure pos (missingField "main-is" tt)
-      pure emptyTestSuite
-    Just file -> do
-      when (isJust (_testStanzaTestModule stanza)) $
-        parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt)
-      pure
-        basicTestSuite
-          { testInterface = TestSuiteExeV10 ver file
-          }
-  Just tt@(TestTypeLib ver) -> case _testStanzaTestModule stanza of
-    Nothing -> do
-      parseFailure pos (missingField "test-module" tt)
-      pure emptyTestSuite
-    Just module_ -> do
-      when (isJust (_testStanzaMainIs stanza)) $
-        parseWarning pos PWTExtraMainIs (extraField "main-is" tt)
-      pure
-        basicTestSuite
-          { testInterface = TestSuiteLibV09 ver module_
-          }
-  where
-    testSuiteType =
-      _testStanzaTestType stanza
-        <|> do
-          guard (cabalSpecVersion >= CabalSpecV3_8)
-
-          testTypeExe <$ _testStanzaMainIs stanza
-        <|> testTypeLib <$ _testStanzaTestModule stanza
-
-    missingField name tt =
-      "The '"
-        ++ name
-        ++ "' field is required for the "
-        ++ prettyShow tt
-        ++ " test suite type."
-
-    extraField name tt =
-      "The '"
-        ++ name
-        ++ "' field is not used for the '"
-        ++ prettyShow tt
-        ++ "' test suite type."
-    basicTestSuite =
-      emptyTestSuite
-        { testBuildInfo = _testStanzaBuildInfo stanza
-        , testCodeGenerators = _testStanzaCodeGenerators stanza
-        }
-
-unvalidateTestSuite :: TestSuite -> TestSuiteStanza
-unvalidateTestSuite t =
-  TestSuiteStanza
-    { _testStanzaTestType = ty
-    , _testStanzaMainIs = ma
-    , _testStanzaTestModule = mo
-    , _testStanzaBuildInfo = testBuildInfo t
-    , _testStanzaCodeGenerators = testCodeGenerators t
-    }
-  where
-    (ty, ma, mo) = case testInterface t of
-      TestSuiteExeV10 ver file -> (Just $ TestTypeExe ver, Just file, Nothing)
-      TestSuiteLibV09 ver modu -> (Just $ TestTypeLib ver, Nothing, Just modu)
-      _ -> (Nothing, Nothing, Nothing)
-
 -------------------------------------------------------------------------------
 -- Benchmark
 -------------------------------------------------------------------------------
 
--- | An intermediate type just used for parsing the benchmark stanza.
--- After validation it is converted into the proper 'Benchmark' type.
-data BenchmarkStanza = BenchmarkStanza
-  { _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
-  , _benchmarkStanzaMainIs :: Maybe (RelativePath Source File)
-  , _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
-  , _benchmarkStanzaBuildInfo :: BuildInfo
-  }
-
-instance L.HasBuildInfo BenchmarkStanza where
-  buildInfo = benchmarkStanzaBuildInfo
-
-benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
-benchmarkStanzaBenchmarkType f s = fmap (\x -> s{_benchmarkStanzaBenchmarkType = x}) (f (_benchmarkStanzaBenchmarkType s))
-{-# INLINE benchmarkStanzaBenchmarkType #-}
-
-benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe (RelativePath Source File))
-benchmarkStanzaMainIs f s = fmap (\x -> s{_benchmarkStanzaMainIs = x}) (f (_benchmarkStanzaMainIs s))
-{-# INLINE benchmarkStanzaMainIs #-}
-
-benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName)
-benchmarkStanzaBenchmarkModule f s = fmap (\x -> s{_benchmarkStanzaBenchmarkModule = x}) (f (_benchmarkStanzaBenchmarkModule s))
-{-# INLINE benchmarkStanzaBenchmarkModule #-}
-
-benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo
-benchmarkStanzaBuildInfo f s = fmap (\x -> s{_benchmarkStanzaBuildInfo = x}) (f (_benchmarkStanzaBuildInfo s))
-{-# INLINE benchmarkStanzaBuildInfo #-}
-
 benchmarkFieldGrammar
   :: ( FieldGrammar c g
      , Applicative (g BenchmarkStanza)
@@ -503,76 +341,6 @@ benchmarkFieldGrammar =
     <*> optionalField "benchmark-module" benchmarkStanzaBenchmarkModule
     <*> blurFieldGrammar benchmarkStanzaBuildInfo buildInfoFieldGrammar
 
-validateBenchmark :: CabalSpecVersion -> Position -> BenchmarkStanza -> ParseResult src Benchmark
-validateBenchmark cabalSpecVersion pos stanza = case benchmarkStanzaType of
-  Nothing ->
-    pure
-      emptyBenchmark
-        { benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza
-        }
-  Just tt@(BenchmarkTypeUnknown _ _) ->
-    pure
-      emptyBenchmark
-        { benchmarkInterface = BenchmarkUnsupported tt
-        , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza
-        }
-  Just tt
-    | tt `notElem` knownBenchmarkTypes ->
-        pure
-          emptyBenchmark
-            { benchmarkInterface = BenchmarkUnsupported tt
-            , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza
-            }
-  Just tt@(BenchmarkTypeExe ver) -> case _benchmarkStanzaMainIs stanza of
-    Nothing -> do
-      parseFailure pos (missingField "main-is" tt)
-      pure emptyBenchmark
-    Just file -> do
-      when (isJust (_benchmarkStanzaBenchmarkModule stanza)) $
-        parseWarning pos PWTExtraBenchmarkModule (extraField "benchmark-module" tt)
-      pure
-        emptyBenchmark
-          { benchmarkInterface = BenchmarkExeV10 ver file
-          , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza
-          }
-  where
-    benchmarkStanzaType =
-      _benchmarkStanzaBenchmarkType stanza <|> do
-        guard (cabalSpecVersion >= CabalSpecV3_8)
-
-        benchmarkTypeExe <$ _benchmarkStanzaMainIs stanza
-
-    missingField name tt =
-      "The '"
-        ++ name
-        ++ "' field is required for the "
-        ++ prettyShow tt
-        ++ " benchmark type."
-
-    extraField name tt =
-      "The '"
-        ++ name
-        ++ "' field is not used for the '"
-        ++ prettyShow tt
-        ++ "' benchmark type."
-
-unvalidateBenchmark :: Benchmark -> BenchmarkStanza
-unvalidateBenchmark b =
-  BenchmarkStanza
-    { _benchmarkStanzaBenchmarkType = ty
-    , _benchmarkStanzaMainIs = ma
-    , _benchmarkStanzaBenchmarkModule = mo
-    , _benchmarkStanzaBuildInfo = benchmarkBuildInfo b
-    }
-  where
-    (ty, ma, mo) = case benchmarkInterface b of
-      BenchmarkExeV10 ver ma'
-        | getSymbolicPath ma' == "" ->
-            (Just $ BenchmarkTypeExe ver, Nothing, Nothing)
-        | otherwise ->
-            (Just $ BenchmarkTypeExe ver, Just ma', Nothing)
-      _ -> (Nothing, Nothing, Nothing)
-
 -------------------------------------------------------------------------------
 -- Build info
 -------------------------------------------------------------------------------