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

Author: leana8959

Cabal-syntax/Cabal-syntax.cabal

@@ -160,7 +160,6 @@ library
     Distribution.Types.Library.Lens
     Distribution.Types.LibraryName
     Distribution.Types.LibraryVisibility
-    Distribution.Types.Imports
     Distribution.Types.MissingDependency
     Distribution.Types.MissingDependencyReason
     Distribution.Types.Mixin

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

@@ -84,7 +84,6 @@ import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.Parsec
 import Distribution.Pretty (Pretty (..), prettyShow, showToken)
-import Distribution.Types.Imports
 import Distribution.Utils.Path
 import Distribution.Version (Version, VersionRange)
 
@@ -300,7 +299,7 @@ executableFieldGrammar n =
 -- | An intermediate type just used for parsing the test-suite stanza.
 -- After validation it is converted into the proper 'TestSuite' type.
 data TestSuiteStanza = TestSuiteStanza
-  { _testStanzaImports :: [ImportName]
+  { _testStanzaImports :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
   , _testStanzaTestType :: Maybe TestType
   -- ^ Retained imports for exact printing
   , _testStanzaMainIs :: Maybe (RelativePath Source File)
@@ -462,7 +461,7 @@ unvalidateTestSuite t =
 -- | An intermediate type just used for parsing the benchmark stanza.
 -- After validation it is converted into the proper 'Benchmark' type.
 data BenchmarkStanza = BenchmarkStanza
-  { _benchmarkStanzaImports :: [ImportName]
+  { _benchmarkStanzaImports :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
   -- ^ retained imports
   , _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
   , _benchmarkStanzaMainIs :: Maybe (RelativePath Source File)

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module      :  Distribution.PackageDescription.Parsec
@@ -66,7 +67,6 @@ 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 Distribution.Types.Imports
 import qualified Distribution.Types.PackageDescription.Lens as L
 import qualified Distribution.Types.SetupBuildInfo.Lens as L
 import qualified Text.Parsec as P
@@ -656,16 +656,16 @@ parseCondTreeWithCommonStanzas v grammar fromBuildInfo commonStanzas fields = do
   where
     hasElif = specHasElif v
 
--- | only attach import annotation on root
-attachImportsOnRoot
-  :: [ImportName]
-  -> CondTree v c a
-  -> CondTree v c (WithImports a)
-attachImportsOnRoot imports = mapTreeData' (WithImports imports) noImports
+-- -- | only attach import annotation on root
+-- attachImportsOnRoot
+--   :: [ImportName]
+--   -> CondTree v c a
+--   -> CondTree v c (WithImports a)
+-- attachImportsOnRoot imports = mapTreeData' (WithImports imports) noImports
 
 -- | only prepend import annotation on root
 prependImportsOnRoot
-  :: [ImportName]
+  :: [(ImportName, CondTreeBuildInfo)]
   -> CondTree v c (WithImports a)
   -> CondTree v c (WithImports a)
 prependImportsOnRoot imports = mapTreeData' (mapImports (imports <>)) id
@@ -682,8 +682,9 @@ processImports
   -> ParseResult
       src
       ( [Field Position]
-      , [ImportName]
-      , CondTree ConfVar [Dependency] (WithImports a) -> CondTree ConfVar [Dependency] (WithImports a)
+      , [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
+      , -- NOTE(leana8959): as we know it's a build info we can insert in this function!
+        CondTree ConfVar [Dependency] (WithImports a) -> CondTree ConfVar [Dependency] (WithImports a)
       )
 processImports v fromBuildInfo commonStanzas = go []
   where
@@ -693,12 +694,12 @@ processImports v fromBuildInfo commonStanzas = go []
     getList' = Newtype.unpack
 
     go
-      :: [(ImportName, CondTree ConfVar [Dependency] (WithImports BuildInfo))]
+      :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
       -> [Field Position]
       -> ParseResult
           src
           ( [Field Position]
-          , [ImportName]
+          , [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
           , CondTree ConfVar [Dependency] (WithImports a) -> CondTree ConfVar [Dependency] (WithImports a)
           )
     go acc (Field (Name pos name) _ : fields)
@@ -717,7 +718,7 @@ processImports v fromBuildInfo commonStanzas = go []
             parseFailure pos $ "Undefined common stanza imported: " ++ commonName
             pure Nothing
           Just commonTree ->
-            pure (Just (commonName, mapTreeData noImports commonTree))
+            pure (Just (commonName, commonTree))
 
       go (acc ++ catMaybes namedTrees) fields
 
@@ -726,12 +727,12 @@ processImports v fromBuildInfo commonStanzas = go []
       fields' <- catMaybes <$> traverse (warnImport v) fields
       let
         importNames :: [ImportName]
-        importTrees :: [CondTree ConfVar [Dependency] (WithImports BuildInfo)]
+        importTrees :: [CondTree ConfVar [Dependency] BuildInfo]
         (importNames, importTrees) = unzip acc
       pure
         ( fields'
-        , importNames
-        , \x -> foldr (mergeCommonStanza fromBuildInfo) x importTrees
+        , acc
+        , id -- TODO(leana8959): defer merging
         )
 
 -- | Warn on "import" fields, also map to Maybe, so erroneous fields can be filtered
@@ -743,26 +744,27 @@ warnImport v (Field (Name pos name) _) | name == "import" = do
   return Nothing
 warnImport _ f = pure (Just f)
 
-mergeCommonStanza
-  :: forall a
-   . L.HasBuildInfo a
-  => (BuildInfo -> a)
-  -> CondTree ConfVar [Dependency] (WithImports BuildInfo)
-  -> CondTree ConfVar [Dependency] (WithImports a)
-  -> CondTree ConfVar [Dependency] (WithImports a)
-mergeCommonStanza fromBuildInfo (CondNode bi _ bis) (CondNode x _ cs) =
-  CondNode x' (unImportNames x' ^. L.targetBuildDepends) cs'
-  where
-    -- new value is old value with buildInfo field _prepended_.
-    x' :: WithImports a
-    x' =
-      WithImports
-        (getImportNames bi <> getImportNames x)
-        (unImportNames x & L.buildInfo %~ (unImportNames bi <>))
-
-    -- tree components are appended together.
-    cs' :: [CondBranch ConfVar [Dependency] (WithImports a)]
-    cs' = map (fmap fromBuildInfo <$>) bis ++ cs
+-- -- TODO(leana8959): we defer merging
+-- mergeCommonStanza
+--   :: forall a
+--    . L.HasBuildInfo a
+--   => (BuildInfo -> a)
+--   -> CondTree ConfVar [Dependency] (WithImports BuildInfo)
+--   -> CondTree ConfVar [Dependency] (WithImports a)
+--   -> CondTree ConfVar [Dependency] (WithImports a)
+-- mergeCommonStanza fromBuildInfo (CondNode bi _ bis) (CondNode x _ cs) =
+--   CondNode x' (unImportNames x' ^. L.targetBuildDepends) cs'
+--   where
+--     -- new value is old value with buildInfo field _prepended_.
+--     x' :: WithImports a
+--     x' =
+--       WithImports
+--         (getImportNames bi <> getImportNames x)
+--         (unImportNames x & L.buildInfo %~ (unImportNames bi <>))
+--
+--     -- tree components are appended together.
+--     cs' :: [CondBranch ConfVar [Dependency] (WithImports a)]
+--     cs' = map (fmap fromBuildInfo <$>) bis ++ cs
 
 -------------------------------------------------------------------------------
 -- Branches

Cabal-syntax/src/Distribution/Types/Benchmark.hs

@@ -15,7 +15,9 @@ import Prelude ()
 import Distribution.Types.BenchmarkInterface
 import Distribution.Types.BenchmarkType
 import Distribution.Types.BuildInfo
-import Distribution.Types.Imports
+import Distribution.Types.CondTree
+import Distribution.Types.ConfVar
+import Distribution.Types.Dependency
 import Distribution.Types.UnqualComponentName
 
 import Distribution.ModuleName
@@ -25,11 +27,13 @@ import qualified Distribution.Types.BuildInfo.Lens as L
 -- | A \"benchmark\" stanza in a cabal file.
 data Benchmark = Benchmark
   { benchmarkName :: UnqualComponentName
-  , benchmarkImports :: [ImportName]
+  , benchmarkImports :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
+  -- ^ Retained condTree imports, not merged
   , benchmarkInterface :: BenchmarkInterface
   , benchmarkBuildInfo :: BuildInfo
+  -- ^ the BuildInfo defined locally, unmerged with imports
   }
-  deriving (Generic, Show, Read, Eq, Ord, Data)
+  deriving (Generic, Show {- Read, -}, Eq {- Ord, -}, Data)
 
 instance Binary Benchmark
 instance Structured Benchmark

Cabal-syntax/src/Distribution/Types/Benchmark/Lens.hs

@@ -9,13 +9,15 @@ import Prelude ()
 
 import Distribution.Types.Benchmark (Benchmark)
 import Distribution.Types.BenchmarkInterface (BenchmarkInterface)
-import Distribution.Types.BuildInfo (BuildInfo)
-import Distribution.Types.Imports (ImportName)
+import Distribution.Types.BuildInfo (BuildInfo, ImportName)
+import Distribution.Types.CondTree
+import Distribution.Types.ConfVar
+import Distribution.Types.Dependency
 import Distribution.Types.UnqualComponentName (UnqualComponentName)
 
 import qualified Distribution.Types.Benchmark as T
 
-benchmarkImports :: Lens' Benchmark [ImportName]
+benchmarkImports :: Lens' Benchmark [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
 benchmarkImports f s = fmap (\x -> s{T.benchmarkImports = x}) (f (T.benchmarkImports s))
 {-# INLINE benchmarkImports #-}
 

Cabal-syntax/src/Distribution/Types/BuildInfo.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 
 module Distribution.Types.BuildInfo
@@ -15,6 +16,12 @@ module Distribution.Types.BuildInfo
   , hcProfSharedOptions
   , hcStaticOptions
   , insertBuildInfoImports
+
+    -- * Imports
+  , WithImports (..)
+  , ImportName
+  , noImports
+  , mapImports
   ) where
 
 import Distribution.Compat.Prelude
@@ -24,7 +31,8 @@ import Distribution.Types.CondTree
 import Distribution.Types.ConfVar
 import Distribution.Types.Dependency
 import Distribution.Types.ExeDependency
-import Distribution.Types.Imports
+
+-- import Distribution.Types.Imports
 import Distribution.Types.LegacyExeDependency
 import Distribution.Types.Mixin
 import Distribution.Types.PkgconfigDependency
@@ -36,7 +44,7 @@ import Language.Haskell.Extension
 
 -- Consider refactoring into executable and library versions.
 data BuildInfo = BuildInfo
-  { buildInfoImports :: [String]
+  { buildInfoImports :: ![(ImportName, CondTreeBuildInfo)]
   , buildable :: Bool
   -- ^ component is buildable here
   , buildTools :: [LegacyExeDependency]
@@ -151,7 +159,8 @@ data BuildInfo = BuildInfo
   -- ^ Dependencies specific to a library or executable target
   , mixins :: [Mixin]
   }
-  deriving (Generic, Show, Read, Eq, Ord, Data)
+  -- TODO(leana8959): instances
+  deriving (Generic, Show {- Read, -}, Eq {- Ord, -}, Data)
 
 instance Binary BuildInfo
 instance Structured BuildInfo
@@ -334,3 +343,19 @@ lookupHcOptions f hc bi = case f bi of
     | hc == GHC -> ghc
     | hc == GHCJS -> ghcjs
     | otherwise -> mempty
+
+-- TODO(leana8959): where do we put this to avoid cyclical import
+type ImportName = String
+type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo
+
+data WithImports a = WithImports
+  { getImportNames :: ![(ImportName, CondTreeBuildInfo)]
+  , unImportNames :: !a
+  }
+  deriving (Show, Functor)
+
+mapImports :: ([(ImportName, CondTreeBuildInfo)] -> [(ImportName, CondTreeBuildInfo)]) -> WithImports a -> WithImports a
+mapImports f (WithImports imports x) = WithImports (f imports) x
+
+noImports :: a -> WithImports a
+noImports = WithImports mempty

Cabal-syntax/src/Distribution/Types/Component.hs

@@ -29,7 +29,7 @@ data Component
   | CExe Executable
   | CTest TestSuite
   | CBench Benchmark
-  deriving (Generic, Show, Eq, Read)
+  deriving (Generic, Show, Eq {- , Read -})
 
 instance Binary Component
 instance Structured Component

Cabal-syntax/src/Distribution/Types/Executable.hs

@@ -19,21 +19,22 @@ import Distribution.Types.CondTree
 import Distribution.Types.ConfVar
 import Distribution.Types.Dependency
 import Distribution.Types.ExecutableScope
-import Distribution.Types.Imports
 import Distribution.Types.UnqualComponentName
 import Distribution.Utils.Path
 
 import qualified Distribution.Types.BuildInfo.Lens as L
 
 data Executable = Executable
   { exeName :: UnqualComponentName
-  , exeImports :: [ImportName]
-  -- ^ Retained for exact print
+  , exeImports :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
+  -- ^ Retained condTree imports, not merged
   , modulePath :: RelativePath Source File
   , exeScope :: ExecutableScope
   , buildInfo :: BuildInfo
+  -- ^ the BuildInfo defined locally, unmerged with imports
   }
-  deriving (Generic, Show, Read, Eq, Ord, Data)
+  -- TODO(leana8959): instances
+  deriving (Generic, Show {- Read, -}, Eq {- Ord, -}, Data)
 
 insertExeImports
   :: CondTree ConfVar [Dependency] (WithImports Executable)

Cabal-syntax/src/Distribution/Types/ForeignLib.hs

@@ -30,7 +30,6 @@ import Distribution.Types.ConfVar
 import Distribution.Types.Dependency
 import Distribution.Types.ForeignLibOption
 import Distribution.Types.ForeignLibType
-import Distribution.Types.Imports
 import Distribution.Types.UnqualComponentName
 import Distribution.Utils.Path
 import Distribution.Version
@@ -47,15 +46,15 @@ import qualified Distribution.Types.BuildInfo.Lens as L
 data ForeignLib = ForeignLib
   { foreignLibName :: UnqualComponentName
   -- ^ Name of the foreign library
-  , foreignLibImports :: [ImportName]
-  -- ^ Retained imports for exact printing
+  , foreignLibImports :: [(ImportName, CondTree ConfVar [Dependency] BuildInfo)]
+  -- ^ Retained condTree imports, not merged
   , foreignLibType :: ForeignLibType
   -- ^ What kind of foreign library is this (static or dynamic).
   , foreignLibOptions :: [ForeignLibOption]
   -- ^ What options apply to this foreign library (e.g., are we
   -- merging in all foreign dependencies.)
   , foreignLibBuildInfo :: BuildInfo
-  -- ^ Build information for this foreign library.
+  -- ^ the BuildInfo for this foreign library. Defined locally, unmerged with imports
   , foreignLibVersionInfo :: Maybe LibVersionInfo
   -- ^ Libtool-style version-info data to compute library version.
   -- Refer to the libtool documentation on the
@@ -68,7 +67,7 @@ data ForeignLib = ForeignLib
   -- This is a list rather than a maybe field so that we can flatten
   -- the condition trees (for instance, when creating an sdist)
   }
-  deriving (Generic, Show, Read, Eq, Ord, Data)
+  deriving (Generic, Show {- Read, -}, Eq {- Ord, -}, Data)
 
 data LibVersionInfo = LibVersionInfo Int Int Int deriving (Data, Eq, Generic)