Solver DSL: Support sub-libraries and library visibility field.

cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs

@@ -5,6 +5,7 @@
 module UnitTests.Distribution.Solver.Modular.DSL (
     ExampleDependency(..)
   , Dependencies(..)
+  , ExSubLib(..)
   , ExTest(..)
   , ExExe(..)
   , ExConstraint(..)
@@ -29,6 +30,8 @@ module UnitTests.Distribution.Solver.Modular.DSL (
   , exResolve
   , extractInstallPlan
   , declareFlags
+  , withSubLibrary
+  , withSubLibraries
   , withSetupDeps
   , withTest
   , withTests
@@ -139,6 +142,7 @@ type ExamplePkgName    = String
 type ExamplePkgVersion = Int
 type ExamplePkgHash    = String  -- for example "installed" packages
 type ExampleFlagName   = String
+type ExampleSubLibName = String
 type ExampleTestName   = String
 type ExampleExeName    = String
 type ExampleVersionRange = C.VersionRange
@@ -157,6 +161,12 @@ data ExampleDependency =
     -- and an exclusive upper bound.
   | ExRange ExamplePkgName ExamplePkgVersion ExamplePkgVersion
 
+    -- | Sub-library dependency
+  | ExSubLibAny ExamplePkgName ExampleSubLibName
+
+    -- | Sub-library dependency on a fixed version
+  | ExSubLibFix ExamplePkgName ExampleSubLibName ExamplePkgVersion
+
     -- | Build-tool-depends dependency
   | ExBuildToolAny ExamplePkgName ExampleExeName
 
@@ -190,6 +200,8 @@ data ExFlag = ExFlag {
   , exFlagType    :: FlagType
   } deriving Show
 
+data ExSubLib = ExSubLib ExampleSubLibName C.LibraryVisibility [ExampleDependency]
+
 data ExTest = ExTest ExampleTestName [ExampleDependency]
 
 data ExExe = ExExe ExampleExeName [ExampleDependency]
@@ -221,7 +233,7 @@ data ExampleAvailable = ExAv {
 
 data ExampleComponents a = ExampleComponents {
     exLib :: Maybe a
-  , exSubLibs :: [(C.UnqualComponentName, a)]
+  , exSubLibs :: [(C.UnqualComponentName, C.LibraryVisibility, a)]
   , exFLibs :: [(C.UnqualComponentName, a)]
   , exExes :: [(C.UnqualComponentName, a)]
   , exTests :: [(C.UnqualComponentName, a)]
@@ -243,8 +255,9 @@ defaultExampleComponents = ExampleComponents {
 flatDeps :: ExampleComponents [a] -> [a]
 flatDeps components = concat $
      maybeToList (exLib components)
+  ++ [ deps | (_, _, deps) <- exSubLibs components]
   ++ [ concatMap snd (f components)
-     | f <- [exSubLibs, exFLibs, exExes, exTests, exBenchmarks] ]
+     | f <- [exFLibs, exExes, exTests, exBenchmarks] ]
   ++ maybeToList (exSetup components)
 
 data ExampleVar =
@@ -298,6 +311,17 @@ declareFlags flags ex = ex {
       exAvFlags = flags
     }
 
+withSubLibrary :: ExampleAvailable -> ExSubLib -> ExampleAvailable
+withSubLibrary ex lib = withSubLibraries ex [lib]
+
+withSubLibraries :: ExampleAvailable -> [ExSubLib] -> ExampleAvailable
+withSubLibraries ex libs =
+  let allLibs =
+          exSubLibs (exAvDeps ex)
+       ++ [(C.mkUnqualComponentName name, visibility, deps)
+          | ExSubLib name visibility deps <- libs]
+  in ex { exAvDeps = (exAvDeps ex) { exSubLibs = allLibs } }
+
 withSetupDeps :: ExampleAvailable -> [ExampleDependency] -> ExampleAvailable
 withSetupDeps ex setupDeps = ex {
       exAvDeps = (exAvDeps ex) { exSetup = Just setupDeps }
@@ -408,9 +432,12 @@ exAvSrcPkg ex =
                       libDeps = exLib (exAvDeps ex)
                   in mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable <$> libDeps
               , C.condSubLibraries =
-                  let mkTree = mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable
+                  let mkTree visibility deps =
+                        let tree = mkCondTree defaultLib mkLib . mkBuildInfoTree $ Buildable deps
+                        in tree { C.condTreeData = (C.condTreeData tree) {C.libVisibility = visibility} }
                       mkLib bi = mempty { C.libBuildInfo = bi }
-                  in map (second mkTree) $ exSubLibs (exAvDeps ex)
+                  in map (\(name, visibility, deps) -> (name, mkTree visibility deps)) $
+                     exSubLibs (exAvDeps ex)
               , C.condForeignLibs =
                   let mkTree = mkCondTree mempty mkLib . mkBuildInfoTree . Buildable
                       mkLib bi = mempty { C.foreignLibBuildInfo = bi }
@@ -504,6 +531,8 @@ exAvSrcPkg ex =
     extractFlags (ExAny _)            = []
     extractFlags (ExFix _ _)          = []
     extractFlags (ExRange _ _ _)      = []
+    extractFlags (ExSubLibAny _ _)    = []
+    extractFlags (ExSubLibFix _ _ _)  = []
     extractFlags (ExBuildToolAny _ _)   = []
     extractFlags (ExBuildToolFix _ _ _) = []
     extractFlags (ExLegacyBuildToolAny _)   = []
@@ -572,8 +601,8 @@ exAvSrcPkg ex =
            , C.condTreeComponents  = map mkFlagged flaggedDeps
            }
 
-    mkDirect :: (ExamplePkgName, C.VersionRange) -> C.Dependency
-    mkDirect (dep, vr) = C.Dependency (C.mkPackageName dep) vr (Set.singleton C.LMainLibName)
+    mkDirect :: (ExamplePkgName, C.LibraryName, C.VersionRange) -> C.Dependency
+    mkDirect (dep, name, vr) = C.Dependency (C.mkPackageName dep) vr (Set.singleton name)
 
     mkFlagged :: (ExampleFlagName, Dependencies, Dependencies)
               -> DependencyComponent C.BuildInfo
@@ -588,20 +617,27 @@ exAvSrcPkg ex =
     -- 'mkDirect' for example. A flagged dependency is the set of dependencies
     -- guarded by a flag.
     splitDeps :: [ExampleDependency]
-              -> ( [(ExamplePkgName, C.VersionRange)]
+              -> ( [(ExamplePkgName, C.LibraryName, C.VersionRange)]
                  , [(ExampleFlagName, Dependencies, Dependencies)]
                  )
     splitDeps [] =
       ([], [])
     splitDeps (ExAny p:deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
-      in ((p, C.anyVersion):directDeps, flaggedDeps)
+      in ((p, C.LMainLibName, C.anyVersion):directDeps, flaggedDeps)
     splitDeps (ExFix p v:deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
-      in ((p, C.thisVersion $ mkSimpleVersion v):directDeps, flaggedDeps)
+      in ((p, C.LMainLibName, C.thisVersion $ mkSimpleVersion v):directDeps, flaggedDeps)
     splitDeps (ExRange p v1 v2:deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
-      in ((p, mkVersionRange v1 v2):directDeps, flaggedDeps)
+      in ((p, C.LMainLibName, mkVersionRange v1 v2):directDeps, flaggedDeps)
+    splitDeps (ExSubLibAny p lib:deps) =
+      let (directDeps, flaggedDeps) = splitDeps deps
+      in ((p, C.LSubLibName (C.mkUnqualComponentName lib), C.anyVersion):directDeps, flaggedDeps)
+    splitDeps (ExSubLibFix p lib v:deps) =
+      let (directDeps, flaggedDeps) = splitDeps deps
+      in ( (p, C.LSubLibName (C.mkUnqualComponentName lib), C.thisVersion $ mkSimpleVersion v):directDeps
+         , flaggedDeps)
     splitDeps (ExFlagged f a b:deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
       in (directDeps, (f, a, b):flaggedDeps)

cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs

@@ -26,6 +26,7 @@ import Distribution.Utils.ShortText (ShortText)
 
 import Distribution.Client.Setup (defaultMaxBackjumps)
 
+import           Distribution.Types.LibraryVisibility
 import           Distribution.Types.PackageName
 import           Distribution.Types.UnqualComponentName
 
@@ -292,7 +293,10 @@ arbitraryExampleComponents pn db          = do
     toExampleComponents :: [(Component, a)] -> ExampleComponents a
     toExampleComponents comps = ExampleComponents {
         exLib = listToMaybe [deps | (ComponentLib, deps) <- comps]
-      , exSubLibs = [(name, deps) | (ComponentSubLib name, deps) <- comps]
+
+        -- TODO: Handle private libraries.
+      , exSubLibs = [(name, LibraryVisibilityPublic, deps) | (ComponentSubLib name, deps) <- comps]
+
       , exFLibs = [(name, deps) | (ComponentFLib name, deps) <- comps]
       , exExes = [(name, deps) | (ComponentExe name, deps) <- comps]
       , exTests = [(name, deps) | (ComponentTest name, deps) <- comps]
@@ -460,6 +464,12 @@ instance (Arbitrary a, Monoid a) => Arbitrary (ExampleComponents a) where
                    , exBenchmarks comps
                    , exSetup comps) ]
 
+instance Arbitrary LibraryVisibility where
+  arbitrary = elements [LibraryVisibilityPublic, LibraryVisibilityPrivate]
+
+  shrink LibraryVisibilityPublic  = []
+  shrink LibraryVisibilityPrivate = [LibraryVisibilityPublic]
+
 instance Arbitrary ExampleDependency where
   arbitrary = error "arbitrary not implemented: ExampleDependency"