[Fix #38] Use LoadUnitsFromCradle new hie-bios mode

cabal.project

@@ -13,3 +13,7 @@ if !os(windows)
 if !os(windows)
     executable-dynamic: True
 
+source-repository-package
+    type: git
+    location: https://github.com/Saizan/hie-bios.git
+    branch: new-loadstyles

haskell-debugger.cabal

@@ -155,7 +155,7 @@ library
     hs-source-dirs:   haskell-debugger
     default-language: GHC2021
 
-library dap
+library dap-server
     import:           warnings
     exposed-modules:  Development.Debug.Adapter.Breakpoints,
                       Development.Debug.Adapter.Stepping,
@@ -222,7 +222,7 @@ executable hdb
         unordered-containers >= 0.2.19 && < 0.3,
 
         haskell-debugger,
-        haskell-debugger:dap,
+        haskell-debugger:dap-server,
         hie-bios,
         prettyprinter ^>= 1.7.0,
         co-log-core >= 0.3.2.5 && < 0.4,

hdb-dap/Development/Debug/Session/Setup.hs

@@ -186,8 +186,9 @@
   -- because hie.yaml may invoke programs relative to the root (e.g. GHC's hie.yaml does)
   -- (HIE.getCompilerOptions depends on CWD being the proper root dir)
   let compilerOpts = liftIO $ withCurrentDirectory root $
+-- TODO version this properly
 #if MIN_VERSION_hie_bios(0,14,0)
-                          HIE.getCompilerOptions target (HIE.LoadWithContext [target]) cradle
+                          HIE.getCompilerOptions (HIE.TargetWithContext target [target]) HIE.LoadUnitsFromCradle cradle
 #else
                           HIE.getCompilerOptions target [] cradle
 #endif

test/golden/T130b/T130b.ghc-914.hdb-stdout

@@ -1,4 +1,5 @@
-[1 of 2] Compiling Main             ( <TEMPORARY-DIRECTORY>/app/Main.hs, interpreted )[T130b-0.1.0.0-inplace-T130b]
+[1 of 3] Compiling Lib              ( <TEMPORARY-DIRECTORY>/lib/Lib.hs, interpreted )[T130b-0.1.0.0-inplace]
+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/app/Main.hs, interpreted )[T130b-0.1.0.0-inplace-T130b]
 (hdb) MyType
 ()
 (hdb) Exiting...

test/golden/T135/hie.yaml

@@ -1,6 +1,5 @@
 cradle:
   cabal:
-    - path: "./mylib"
-      component: "lib:mylib"
+    #we want mylib to be an external package, so we don't list it in the cradle.
     - path: "./myapp/"
       component: "myapp"

test/golden/T237/hie.yaml

@@ -0,0 +1,5 @@
+cradle:
+  cabal:
+    components:
+      - path: "app/"
+        component: "exe:T237"

test/golden/self-debug-cli/cabal.project

@@ -0,0 +1 @@
+packages: .

test/golden/self-debug-cli/debuggee.cabal

@@ -0,0 +1,20 @@
+cabal-version:      3.0
+name:               debuggee
+version:            0.1.0.0
+-- synopsis:
+-- description:
+author:              
+maintainer:          
+-- copyright:
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+-- extra-source-files:
+
+
+executable debuggee
+    main-is:          Main.hs
+    -- other-modules:
+    -- other-extensions:
+    build-depends:    base
+    hs-source-dirs:   .
+    default-language: Haskell2010

test/haskell/Main.hs

@@ -120,7 +120,10 @@ mkGoldenTest keepTmpDirs inheritedEnv flags path = goldenVsStringComparing testN
     noTmpDir = ".no-tmp-dir" `isInfixOf` testName
 
     topAction :: IO LBS.ByteString
-    topAction | noTmpDir  = testAction path =<< getCurrentDirectory -- a bit dangerous! used in the self-debug-cli test
+    topAction | noTmpDir  = do
+      cwd <- getCurrentDirectory -- a bit dangerous! used in the self-debug-cli test
+      withTmpDirFromRepo keepTmpDirs cwd (testAction path)
+
               | otherwise = withHermeticDir keepTmpDirs (takeDirectory path) (testAction (takeFileName path))
 
 

test/haskell/Test/Integration/MultiHomeUnit.hs

@@ -6,6 +6,7 @@ module Test.Integration.MultiHomeUnit (multiHomeUnitTests) where
 import Test.DAP
 import Test.Tasty
 import Test.Tasty.HUnit
+import System.FilePath ((</>))
 #ifdef mingw32_HOST_OS
 import Test.Tasty.ExpectedFailure
 #endif
@@ -16,37 +17,38 @@ multiHomeUnitTests =
   ignoreTestBecause "Needs to be fixed for Windows (#199)" $
 #endif
   testGroup "DAP.Integration.MultiHomeUnit"
-    [ testCase "should run program to the end" runToTheEnd
-    , testCase "should stop at break-point in the same home unit" sameHomeUnitBP
-    , testCase "should stop at break-point in different home unit 1" otherHomeUnitBP1
-    , testCase "should stop at break-point in different home unit 2" otherHomeUnitBP2
+    [testGroup dirname [ testCase "should run program to the end" $ runToTheEnd dirname
+    , testCase "should stop at break-point in the same home unit" $ sameHomeUnitBP dirname
+    , testCase "should stop at break-point in different home unit 1" $ otherHomeUnitBP1 dirname
+    , testCase "should stop at break-point in different home unit 2" $ otherHomeUnitBP2 dirname
+    ] |
+    dirname <- ["cabal-mhu1","T38"]
     ]
-
-withCommonSetup :: (FilePath -> TestDAP ()) -> Assertion
-withCommonSetup test =
-  withTestDAPServer "test/integration/cabal-mhu1" [] $ \test_dir server ->
+withCommonSetup :: (FilePath -> TestDAP ()) -> String -> Assertion
+withCommonSetup test dirname =
+  withTestDAPServer ("test/integration" </> dirname) [] $ \test_dir server ->
     withTestDAPServerClient server $ do
       test test_dir
       disconnect
 
-runToTheEnd :: Assertion
+runToTheEnd :: String -> Assertion
 runToTheEnd = withCommonSetup $ \test_dir -> do
   let cfg = mkLaunchConfig test_dir "bar/app/Main.hs"
   runToEnd cfg
 
-sameHomeUnitBP :: Assertion
+sameHomeUnitBP :: String -> Assertion
 sameHomeUnitBP = withCommonSetup $ \test_dir -> do
   let cfg = mkLaunchConfig test_dir "bar/app/Main.hs"
   hitBreakpointWith cfg 8
 
-otherHomeUnitBP1 :: Assertion
+otherHomeUnitBP1 :: String -> Assertion
 otherHomeUnitBP1 = withCommonSetup $ \test_dir -> do
   -- Use bar/app/Main.hs as the entry file; set a breakpoint in a
   -- *different* home unit (bar/src/Bar.hs).
   let cfg = mkLaunchConfig test_dir "bar/app/Main.hs"
   hitBreakpointIn cfg "bar/src/Bar.hs" 8
 
-otherHomeUnitBP2 :: Assertion
+otherHomeUnitBP2 :: String -> Assertion
 otherHomeUnitBP2 = withCommonSetup $ \test_dir -> do
   let cfg = mkLaunchConfig test_dir "bar/app/Main.hs"
   hitBreakpointIn cfg "foo/src/Foo.hs" 6

test/haskell/Test/Utils.hs

@@ -2,7 +2,7 @@ module Test.Utils where
 
 import Control.Monad (when)
 import Data.List (isInfixOf)
-import System.Directory (doesFileExist)
+import System.Directory (doesFileExist,doesDirectoryExist)
 import System.FilePath
 import System.IO.Temp
 import qualified System.Process as P
@@ -14,7 +14,7 @@ withHermeticDir :: Bool               -- ^ Whether to keep the temp dir around f
                 -> (FilePath -> IO r) -- ^ Continuation receives hermetic test dir (in temporary dir)
                 -> IO r
 withHermeticDir keep src k = do
-  withTmpDir "hdb-test" $ \dest -> do
+  withTestTmpDir keep $ \dest -> do
     P.callCommand $ "cp -r " ++ src ++ " " ++ dest
     let destTestDir = dest </> takeBaseName src
     -- Some test projects reference @./haskell-debugger-view@ in their
@@ -24,14 +24,6 @@ withHermeticDir keep src k = do
     cpHaskellDebuggerViewIfNeeded destTestDir
     k destTestDir
   where
-    withTmpDir | keep      = withPersistentSystemTempDirectory
-               | otherwise = withSystemTempDirectory
-
-    withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r
-    withPersistentSystemTempDirectory template k' = do
-      dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory
-      k' dir
-
     cpHaskellDebuggerViewIfNeeded testDir = do
       let cabalProject = testDir </> "cabal.project"
       existsCP <- doesFileExist cabalProject
@@ -41,3 +33,37 @@ withHermeticDir keep src k = do
           P.callCommand $
             "cp -r haskell-debugger-view " ++ testDir </> "haskell-debugger-view"
 
+
+withTestTmpDir :: Bool               -- ^ Whether to keep the temp dir around for inspection
+                -> (FilePath -> IO r) -- ^ Continuation receives temporary dir
+                -> IO r
+withTestTmpDir keep k = do
+  withTmpDir "hdb-test" k
+  where
+    withTmpDir | keep      = withPersistentSystemTempDirectory
+               | otherwise = withSystemTempDirectory
+
+    withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r
+    withPersistentSystemTempDirectory template k' = do
+      dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory
+      k' dir
+
+
+withTmpDirFromRepo :: Bool               -- ^ Whether to keep the temp dir around for inspection
+                -> FilePath           -- ^ Test dir
+                -> (FilePath -> IO r) -- ^ Continuation receives temporary dir
+                -> IO r
+withTmpDirFromRepo keep src k = do
+  b <- doesDirectoryExist $ src </> ".git"
+  withTestTmpDir keep $ \ dest -> do
+    case b of
+      False -> do
+        P.callCommand $ "cp -r " ++ src ++ "/. " ++ dest
+      True -> do
+        P.callCommand $ unwords
+          [ "git ls-files -z --full-name --"
+          , src
+          , "| cpio -0 -pdm  "
+          , dest
+          ]
+    k dest

test/integration/T107a/hie.yaml

@@ -1,3 +1,3 @@
 cradle:
   cabal:
-    components: "exe:t3"
+    component: "exe:t3"

test/integration/T38/bar/app/Main.hs

@@ -0,0 +1,9 @@
+module Main where
+
+import Bar
+import Foo
+
+main :: IO ()
+main = do
+  myFibonacciTest
+  print (fib 5)

test/integration/T38/bar/bar.cabal

@@ -0,0 +1,20 @@
+cabal-version:      3.8
+name:               bar
+version:            0.1.0.0
+build-type:         Simple
+
+library
+    exposed-modules:  Bar
+    build-depends:
+        base,
+        foo,
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+executable bar-exe
+    main-is: app/Main.hs
+    build-depends:
+        base,
+        bar,
+        foo,
+    default-language: Haskell2010

test/integration/T38/bar/src/Bar.hs

@@ -0,0 +1,10 @@
+module Bar where
+
+import Foo
+
+myFibonacciTest :: IO ()
+myFibonacciTest = do
+  print (fib 1)
+  print (fib 4)
+  print (fib 8)
+  print (fib 10)

test/integration/T38/cabal.project

@@ -0,0 +1,3 @@
+packages:
+    ./foo
+    ./bar

test/integration/T38/foo/foo.cabal

@@ -0,0 +1,10 @@
+cabal-version:      3.8
+name:               foo
+version:            0.1.0.0
+build-type:         Simple
+
+library
+    exposed-modules:  Foo
+    build-depends:    base
+    hs-source-dirs:   src
+    default-language: Haskell2010

test/integration/T38/foo/src/Foo.hs

@@ -0,0 +1,6 @@
+module Foo where
+
+fib :: Int -> Int
+fib n
+  | n <= 1 = 1
+  | otherwise = fib (n - 1) + fib (n - 2)