WIP on backpack support

3 files changed, 72 insertions, 30 deletions

diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs
index 6e013a1..737b590 100644
--- a/src/CabalHelper/Runtime/Main.hs
+++ b/src/CabalHelper/Runtime/Main.hs
@@ -153,6 +153,9 @@ import Distribution.Backpack (OpenUnitId(..))
 import Distribution.ModuleName
   ( ModuleName
   )
+import Distribution.Types.ComponentId
+  ( unComponentId
+  )
 import Distribution.Types.ModuleRenaming
   ( ModuleRenaming(..)
   )
@@ -162,6 +165,7 @@ import Distribution.Types.MungedPackageId
 import Distribution.Types.UnitId
   ( UnitId
   , unDefUnitId
+  , unUnitId
   )
 import Distribution.Types.UnitId
   ( DefUnitId
@@ -379,9 +383,14 @@ main = do
     "entrypoints":[] -> do
 #if CH_MIN_VERSION_Cabal(2,0,0)
       includeDirMap <- recursiveDepInfo lbi v distdir
+      appendFile "/tmp/cbli.txt" "\n--------------------------------------"
       eps <- componentsMap lbi v distdir $ \c clbi _bi -> do
+               appendFile "/tmp/cbli.txt" ("\n" ++ show clbi)
                let (_,_,seps) = recursiveIncludeDirs includeDirMap (componentUnitId clbi)
+               appendFile "/tmp/cbli.txt" ("\n" ++ show (componentEntrypoints c) )
+               appendFile "/tmp/cbli.txt" "\n-------"
                return seps
+      appendFile "/tmp/cbli.txt" "\n--------------------------------------"
 #else
       eps <- componentsMap lbi v distdir $ \c _clbi _bi ->
                return $ componentEntrypoints c
@@ -413,6 +422,9 @@ main = do
 
 flagName' = unFlagName . flagName
 
+
+logm str = appendFile "/tmp/cbli.txt" str
+
 -- getLibrary :: PackageDescription -> Library
 -- getLibrary pd = unsafePerformIO $ do
 --   lr <- newIORef (error "libraryMap: empty IORef")
@@ -458,7 +470,11 @@ componentsMap lbi _v _distdir f = do
 
         l' <- readIORef lr
         r <- f c clbi bi
-        writeIORef lr $ (componentNameToCh name, r):l'
+#if CH_MIN_VERSION_Cabal(2,0,0)
+        writeIORef lr $ (componentNameToCh (ChUnitId $ unUnitId $ componentUnitId clbi) name, r):l'
+#else
+        writeIORef lr $ (componentNameToCh ChNoUnitId name, r):l'
+#endif
 
     reverse <$> readIORef lr
 
@@ -586,10 +602,10 @@ recursiveIncludeDirs includeDirs unit = go ([],[],Nothing) [unit]
 
 combineEp Nothing e = Just e
 combineEp (Just ChSetupEntrypoint) e = Just e
-combineEp (Just (ChLibEntrypoint es1 os1)) (ChLibEntrypoint es2 os2) = Just (ChLibEntrypoint (es2++es1) (os2++os1))
-combineEp (Just (ChLibEntrypoint es1 os1)) (ChExeEntrypoint  mi os2) = Just (ChExeEntrypoint mi (os2++es1++os1))
-combineEp (Just (ChExeEntrypoint   _ os1)) (ChLibEntrypoint es2 os2) = Just (ChLibEntrypoint es2 (os2++os1))
-combineEp (Just (ChExeEntrypoint   _ os1)) (ChExeEntrypoint  mi os2) = Just (ChExeEntrypoint mi (os2++os1))
+combineEp (Just (ChLibEntrypoint es1 os1 ss1)) (ChLibEntrypoint es2 os2 ss2) = Just (ChLibEntrypoint (nub $ es2++es1) (nub $ os2++os1) (nub $ ss2++ss1))
+combineEp (Just (ChLibEntrypoint es1 os1 ss1)) (ChExeEntrypoint  mi os2)     = Just (ChExeEntrypoint mi (nub $ os2++es1++os1++ss1))
+combineEp (Just (ChExeEntrypoint   _ os1))     (ChLibEntrypoint es2 os2 ss2) = Just (ChLibEntrypoint es2 (nub $ os2++os1) ss2)
+combineEp (Just (ChExeEntrypoint   _ os1))     (ChExeEntrypoint  mi os2)     = Just (ChExeEntrypoint mi  (nub $ os2++os1))
 #endif
 
 initialBuildStepsForAllComponents distdir pd lbi v =
@@ -616,15 +632,15 @@ toDataVersion = id
 --fromDataVersion = id
 #endif
 
-componentNameToCh CLibName = ChLibName
+componentNameToCh _uid CLibName = ChLibName
 #if CH_MIN_VERSION_Cabal(1,25,0)
 -- CPP >= 1.25
-componentNameToCh (CSubLibName n) = ChSubLibName $ unUnqualComponentName' n
-componentNameToCh (CFLibName   n) = ChFLibName $ unUnqualComponentName' n
+componentNameToCh uid (CSubLibName n) = ChSubLibName (unUnqualComponentName' n) uid
+componentNameToCh uid (CFLibName   n) = ChFLibName (unUnqualComponentName' n) uid
 #endif
-componentNameToCh (CExeName n) = ChExeName $ unUnqualComponentName' n
-componentNameToCh (CTestName n) = ChTestName $ unUnqualComponentName' n
-componentNameToCh (CBenchName n) = ChBenchName $ unUnqualComponentName' n
+componentNameToCh uid (CExeName n) = ChExeName (unUnqualComponentName' n) uid
+componentNameToCh uid (CTestName n) = ChTestName (unUnqualComponentName' n) uid
+componentNameToCh uid (CBenchName n) = ChBenchName (unUnqualComponentName' n) uid
 
 #if CH_MIN_VERSION_Cabal(1,25,0)
 -- CPP >= 1.25
@@ -674,28 +690,35 @@ componentEntrypoints (CLib Library {..})
         (map gmModuleName exposedModules)
         (map gmModuleName $ otherModules libBuildInfo)
 #if CH_MIN_VERSION_Cabal(2,0,0)
+        (map gmModuleName signatures)
+#else
+        [] -- no signatures prior to Cabal 2.0
+#endif
+#if CH_MIN_VERSION_Cabal(2,0,0)
 componentEntrypoints (CFLib (ForeignLib{..}))
     = ChLibEntrypoint
         []
         (map gmModuleName $ otherModules foreignLibBuildInfo)
+        []
 #endif
 componentEntrypoints (CExe Executable {..})
     = ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo)
 componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})
     = ChExeEntrypoint fp (map gmModuleName $ otherModules testBuildInfo)
 componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn, ..})
-    = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo)
+    = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo) []
 componentEntrypoints (CTest TestSuite {})
-    = ChLibEntrypoint [] []
+    = ChLibEntrypoint [] [] []
 componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _  fp, ..})
     = ChExeEntrypoint fp (map gmModuleName $ otherModules benchmarkBuildInfo)
 componentEntrypoints (CBench Benchmark {})
-    = ChLibEntrypoint [] []
+    = ChLibEntrypoint [] [] []
 
 #if CH_MIN_VERSION_Cabal(2,0,0)
 isInplaceCompInc :: ComponentLocalBuildInfo -> (OpenUnitId, ModuleRenaming) -> Bool
-isInplaceCompInc clbi (DefiniteUnitId uid, _mr) = unDefUnitId uid `elem` componentInternalDeps clbi
-isInplaceCompInc clbi (IndefFullUnitId _ _, _mmr) = False -- TODO: keep this for now, what in future?
+isInplaceCompInc clbi (DefiniteUnitId uid, _mr)     = unDefUnitId uid `elem` componentInternalDeps clbi
+-- isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = False
+isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = unComponentId uid `elem` map unUnitId (componentInternalDeps clbi)
 #endif
 
 #if CH_MIN_VERSION_Cabal(2,0,0)
diff --git a/src/CabalHelper/Shared/InterfaceTypes.hs b/src/CabalHelper/Shared/InterfaceTypes.hs
index 5f4972f..bf61bb7 100644
--- a/src/CabalHelper/Shared/InterfaceTypes.hs
+++ b/src/CabalHelper/Shared/InterfaceTypes.hs
@@ -47,11 +47,15 @@ data ChResponse
 
 data ChComponentName = ChSetupHsName
                      | ChLibName
-                     | ChSubLibName String
-                     | ChFLibName String
-                     | ChExeName String
-                     | ChTestName String
-                     | ChBenchName String
+                     | ChSubLibName String ChUnitId
+                     | ChFLibName   String ChUnitId
+                     | ChExeName    String ChUnitId
+                     | ChTestName   String ChUnitId
+                     | ChBenchName  String ChUnitId
+  deriving (Eq, Ord, Read, Show, Generic)
+
+data ChUnitId = ChNoUnitId
+              | ChUnitId String
   deriving (Eq, Ord, Read, Show, Generic)
 
 newtype ChModuleName = ChModuleName String
@@ -64,6 +68,7 @@ data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but
                                       -- to find these files.
                   | ChLibEntrypoint { chExposedModules :: [ChModuleName]
                                     , chOtherModules   :: [ChModuleName]
+                                    , chSignatures     :: [ChModuleName] -- backpack only
                                     }
                   | ChExeEntrypoint { chMainIs         :: FilePath
                                     , chOtherModules   :: [ChModuleName]
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index 8228356..127dd8e 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -17,6 +17,7 @@ import System.Environment (getArgs)
 import System.Exit
 import System.FilePath ((</>))
 import System.Directory
+import System.IO
 import System.IO.Temp
 import System.Process (readProcess)
 
@@ -30,10 +31,11 @@ main = do
   args <- getArgs
   topdir <- getCurrentDirectory
   res <- mapM (setup topdir test) $ case args of
-    [] -> [ ("tests/exelib"   , parseVer "1.10")
-          , ("tests/exeintlib", parseVer "2.0")
-          , ("tests/fliblib"  , parseVer "2.0")
-          , ("tests/bkpregex" , parseVer "2.0")
+    [] -> [
+          --   ("tests/exelib"   , parseVer "1.10")
+          -- , ("tests/exeintlib", parseVer "2.0")
+          -- , ("tests/fliblib"  , parseVer "2.0")
+            ("tests/bkpregex" , parseVer "2.0")
           ]
     xs -> map (,parseVer "0") xs
 
@@ -87,11 +89,23 @@ setup topdir act (srcdir, min_cabal_ver) = do
 test :: FilePath -> IO [Bool]
 test dir = do
     let qe = mkQueryEnv dir (dir </> "dist")
+
+    cs <- runQuery qe $ components $ (,) <$> entrypoints
+    putStrLn "\n--------------------------------eps-----------------------------"
+    forM cs $ \(ep, cn) -> do
+        putStrLn $ "\n" ++ show (ep,cn)
+    putStrLn "\n--------------------------------eps end-----------------------------"
+
     cs <- runQuery qe $ components $ (,,) <$> entrypoints <.> ghcOptions
+    putStrLn "\n--------------------------------components-----------------------------"
+    forM cs $ \(ep, opts, cn) -> do
+        putStrLn $ "\n" ++ show cn ++ ": " ++ show opts
+    putStrLn "\n--------------------------------components end-------------------------"
     forM cs $ \(ep, opts, cn) -> do
         let opts' = "-Werror" : opts
         let sopts = intercalate " " $ map formatArg $ "ghc" : opts'
         putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
+        hFlush stdout
         compileModule ep opts'
   where
     formatArg x
@@ -126,9 +140,9 @@ compileModule ep opts = do
 
     ts <- mapM (\t -> guessTarget t Nothing) $
          case ep of
-           ChLibEntrypoint ms ms' -> map unChModuleName $ ms ++ ms'
-           ChExeEntrypoint m  ms  -> [m] ++ map unChModuleName ms
-           ChSetupEntrypoint      -> ["Setup.hs"]
+           ChLibEntrypoint ms ms' ss -> map unChModuleName $ ms ++ ms' ++ ss
+           ChExeEntrypoint m  ms     -> [m] ++ map unChModuleName ms
+           ChSetupEntrypoint         -> ["Setup.hs"]
     let ts' = map (\t -> t { targetAllowObjCode = False }) ts
 
     setTargets ts'
@@ -136,8 +150,8 @@ compileModule ep opts = do
 
 #if __GLASGOW_HASKELL__ >= 706
     setContext $ case ep of
-      ChLibEntrypoint ms ms' ->
-          map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms'
+      ChLibEntrypoint ms ms' ss ->
+          map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' ++ ss
       ChExeEntrypoint _  ms  ->
           map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
       ChSetupEntrypoint      ->