Start refactoring to support cabal v2-build

2 files changed, 15 insertions, 10 deletions

diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs
index 02f4c3b..5e03d8c 100644
--- a/tests/CompileTest.hs
+++ b/tests/CompileTest.hs
@@ -46,6 +46,7 @@ main :: IO ()
 main = do
   let ?progs = defaultPrograms
   let ?opts = defaultCompileOptions { oVerbose = True }
+  let ?verbose = True
 
   args <- getArgs
   case args of
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index 6e71075..63085db 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections, ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections, ScopedTypeVariables, RecordWildCards #-}
 module Main where
 
 import GHC
@@ -10,6 +10,7 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Data.List
 import Data.Version
+import qualified Data.Map as Map
 import System.Environment (getArgs)
 import System.Exit
 import System.FilePath ((</>))
@@ -91,23 +92,26 @@ run x xs = do
   ExitSuccess <- rawSystem x xs
   return ()
 
+allComponents :: Query pt [ChComponentInfo]
+allComponents =
+    concat . map (Map.elems . uiComponents) <$> (mapM unitQuery =<< projectUnits)
+
 test :: FilePath -> IO [Bool]
 test dir = do
-    let qe = mkQueryEnv dir (dir </> "dist")
-    cs <- runQuery qe $ components $ (,,,) <$> entrypoints <.> ghcOptions <.> needsBuildOutput
-    forM cs $ \(ep, opts, nb, cn) -> do
-
-        putStrLn $ "\n" ++ show cn ++ ":::: " ++ show nb
+    qe <- mkQueryEnv (ProjDirV1 dir) (DistDirV1 $ dir </> "dist")
+    cs <- runQuery allComponents qe
+    forM cs $ \ChComponentInfo{..} -> do
+        putStrLn $ "\n" ++ show ciComponentName ++ ":::: " ++ show ciNeedsBuildOutput
 
-        when (nb == ProduceBuildOutput) $ do
+        when (ciNeedsBuildOutput == ProduceBuildOutput) $ do
           run "cabal" [ "build" ]
 
-        let opts' = "-Werror" : opts
+        let opts' = "-Werror" : ciGhcOptions
 
         let sopts = intercalate " " $ map formatArg $ "\nghc" : opts'
-        putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
+        putStrLn $ "\n" ++ show ciComponentName ++ ": " ++ sopts
         hFlush stdout
-        compileModule nb ep opts'
+        compileModule ciNeedsBuildOutput ciEntrypoints opts'
   where
     formatArg x
         | "-" `isPrefixOf` x = "\n  "++x