Use dedicated hie-self-debug-test.yaml for self-debug (tests)

.vscode/launch.json

@@ -9,7 +9,8 @@
             "entryFile": "hdb/Main.hs",
             "entryArgs": ["server", "--port", "12345"],
             "entryPoint": "main",
-            "extraGhcArgs": []
+            "extraGhcArgs": [],
+	    "cradleFile" : "hie-self-debug.yaml"
         },
         {
             "type": "haskell-debugger",
@@ -19,7 +20,8 @@
             "entryFile": "test/haskell/Main.hs",
             "entryPoint": "main",
             "entryArgs": ["--pattern", "DAP.Scopes"],
-            "extraGhcArgs": []
+            "extraGhcArgs": [],
+	    "cradleFile": "hie-self-debug.yaml"
         }
     ]
 }

cabal.project.self-debug-test

@@ -0,0 +1,7 @@
+-- cabal project file used for self-debug tests.
+-- Meant to be just `cabal.project` but separate file to prevent cabal 
+-- from including `cabal.project.local` as well.
+--
+-- Referenced by hie-self-debug-test.yaml
+
+import: cabal.project

hdb-dap/Development/Debug/Adapter/Init.hs

@@ -80,6 +80,8 @@ data LaunchArgs
     -- or function arguments otherwise.
   , extraGhcArgs :: Maybe [String]
     -- ^ Additional arguments to pass to the GHC invocation inferred by hie-bios for this project
+  , cradleFile :: Maybe FilePath
+    -- ^ specify cradle file rather than let it be inferred from @entryFile@, relative to @projectRoot@.
   } deriving stock (Show, Eq, Generic)
     deriving anyclass FromJSON
 
@@ -115,6 +117,7 @@ initDebugger l servConf supportsRunInTerminal preferInternalInterpreter
                          , entryPoint = fromMaybe "main" -> entryPoint
                          , entryArgs  = fromMaybe [] -> entryArgs
                          , extraGhcArgs = fromMaybe [] -> extraGhcArgs
+                         , cradleFile
                          } = do
   syncRequests  <- liftIO newEmptyMVar
   syncResponses <- liftIO newEmptyMVar
@@ -144,7 +147,7 @@ initDebugger l servConf supportsRunInTerminal preferInternalInterpreter
         WithSeverity msg sev
           | sev >= Info -> dapLogger <& renderSessionSetupLog msg
           | otherwise -> mempty
-  let debugRunnerConf = DebugRunnerConf projectRoot entryFile extraGhcArgs
+  let debugRunnerConf = DebugRunnerConf projectRoot entryFile extraGhcArgs cradleFile
   liftIO (getDebugRunner servConf hieBiosLogger debugRunnerConf) >>= \case
     Left e              -> throwError (ErrorMessage (T.pack e), Nothing)
     Right (ghcInvocation, debugRunner) -> do

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Development.Debug.Session.Setup
   (
@@ -75,6 +76,10 @@ data DebugRunnerConf = DebugRunnerConf
   { drcProjectRoot :: FilePath
   , drcEntryFile :: FilePath
   , drcExtraGhcArgs :: [String]
+  , drcCradleFile :: Maybe FilePath
+    -- ^ specified cradle file rather than letting be inferred from
+    -- @drcEntryFile@, relative to @drcProjectRoot@ if so. @DebugRunnerProvider@s
+    -- must WARN if this field is @Just@ but they do not use hie cradles.
   }
 
 data SessionSetupLog
@@ -106,11 +111,12 @@ data HieBiosFlags = HieBiosFlags
 hieBiosSetup :: LogAction IO (WithSeverity SessionSetupLog)
              -> FilePath -- ^ project root
              -> FilePath -- ^ entry file
+             -> Maybe FilePath -- ^ cradle file
              -> ExceptT String IO (Either String HieBiosFlags)
-hieBiosSetup logger projectRoot entryFile = do
+hieBiosSetup logger projectRoot entryFile cradleFile = do
 
   logInfo "Figuring out the right flags to compile the project using hie-bios..."
-  cradle <- hieBiosCradle logger projectRoot entryFile & ExceptT
+  cradle <- hieBiosCradle logger projectRoot entryFile cradleFile & ExceptT
 
   -- GHC is found in PATH (by hie-bios as well).
   logInfo "Checking GHC version against debugger version..."
@@ -129,10 +135,16 @@ hieBiosSetup logger projectRoot entryFile = do
 hieBiosCradle :: LogAction IO (WithSeverity SessionSetupLog)
               -> FilePath -- ^ Project root
               -> FilePath -- ^ Entry file relative to root
+              -> Maybe FilePath -- ^ Cradle file relative to root
               -> IO (Either String (HIE.Cradle Void))
-hieBiosCradle logger root relTarget = runExceptT $ do
+hieBiosCradle logger root relTarget mrelCradle = runExceptT $ do
   let target = root </> relTarget
-  explicitCradle <- HIE.findCradle target & liftIO
+  explicitCradle <- case mrelCradle of
+    Nothing -> HIE.findCradle target & liftIO
+    Just ((root </>) -> cradleFile) -> do
+      liftIO (doesFileExist cradleFile) >>= \case
+        True -> return $ Just cradleFile
+        False -> throwError $ "Specified Cradle file does not exist: " ++ cradleFile
   cradle <- maybe (loadImplicitCradle hieBiosLogger target)
                   (HIE.loadCradle hieBiosLogger) explicitCradle & liftIO
   liftLogIO logger <& WithSeverity (LogCradle cradle) Info
@@ -219,8 +231,8 @@ hieDebugRunner
   :: LogAction IO (WithSeverity SessionSetupLog)
   -> DebugRunnerConf
   -> IO (Either String (GhcInvocation, Debugger.DebugRunner Ghc a))
-hieDebugRunner l (DebugRunnerConf projectRoot entryFile extraGhcArgs) = runExceptT $ do
-  r <- hieBiosSetup l projectRoot entryFile
+hieDebugRunner l (DebugRunnerConf projectRoot entryFile extraGhcArgs cradleFile) = runExceptT $ do
+  r <- hieBiosSetup l projectRoot entryFile cradleFile
   HieBiosFlags{..} <- case r of
     Left e -> throwError e
     Right f -> return f

hdb/Development/Debug/Interactive.hs

@@ -47,14 +47,15 @@ runIDM :: LogAction IO InteractiveLog
        -> FilePath -- ^ entryFile
        -> [String] -- ^ entryArgs
        -> [String] -- ^ extraGhcArgs
+       -> Maybe FilePath
        -> RunDebuggerSettings
        -> InteractiveDM a
        -> IO a
-runIDM logger entryPoint entryFile entryArgs extraGhcArgs runConf act = do
+runIDM logger entryPoint entryFile entryArgs extraGhcArgs cradleFile runConf act = do
   projectRoot <- getCurrentDirectory
 
   let hieBiosLogger = contramap ISessionSetupLog logger
-  hieDebugRunner hieBiosLogger (DebugRunnerConf projectRoot entryFile extraGhcArgs) >>= \case
+  hieDebugRunner hieBiosLogger (DebugRunnerConf projectRoot entryFile extraGhcArgs cradleFile) >>= \case
     Left e               -> exitWithMsg e
     Right (_ghcInvocation, debugRunner)
                          -> do

hdb/Development/Debug/Options.hs

@@ -21,6 +21,7 @@ data HdbOptions
     , entryFile :: FilePath
     , entryArgs :: [String]
     , extraGhcArgs :: [String]
+    , cradleFile :: Maybe FilePath
     , verbosity :: Severity
     , internalInterpreter :: Bool
     , disableIpeBacktraces :: Bool

hdb/Development/Debug/Options/Parser.hs

@@ -54,6 +54,12 @@ cliParser = HdbCLI
      <> metavar "GHC_ARGS"
      <> value []
      <> help "Additional flags to pass to the ghc invocation that loads the program for debugging" )
+  <*> option (Just <$> str)
+       (long "cradle-file"
+       <> metavar "HIE_PATH"
+       <> value Nothing
+       <> help "Path to .yaml file to use as cradle configuration. Location inferred from ENTRY_POINT otherwise."
+       )
   <*> verbosityParser Warning
   <*> internalInterpreterParser
   <*> disableIpeBacktracesParser

hdb/Main.hs

@@ -96,7 +96,7 @@ main = do
               , externalInterpreterCustomProc = Left stdinStream
               , externalInterpreterProg = thisProg
               }
-        runIDM (contramap InteractiveLog l) entryPoint entryFile entryArgs extraGhcArgs
+        runIDM (contramap InteractiveLog l) entryPoint entryFile entryArgs extraGhcArgs cradleFile
           runConf debugInteractive
     HdbProxy{port} -> do
         setBacktraceMechanismState IPEBacktrace True

hie-self-debug-test.yaml

@@ -0,0 +1,6 @@
+# HIE cradle used for self-debug tests.
+# It has to be at the project root, otherwise HIE will not resolve it properly.
+cradle:
+  cabal:
+    cabalProject: "cabal.project.self-debug-test"
+    component: "all"

hie-self-debug.yaml

@@ -0,0 +1,3 @@
+cradle:
+  cabal:
+    component: "all"

hie.yaml

@@ -1,9 +1,8 @@
 cradle:
   cabal:
-    component: "all"
-    # - path: "./haskell-debugger/"
-    #   component: "lib:haskell-debugger"
-    # - path: "./hdb/"
-    #   component: "exe:hdb"
-    # - path: "./test/haskell/"
-    #   component: "test:haskell-debugger-test"
+    - path: "./haskell-debugger/"
+      component: "lib:haskell-debugger"
+    - path: "./hdb/"
+      component: "exe:hdb"
+    - path: "./test/haskell/"
+      component: "test:haskell-debugger-test"

test/golden/self-debug-cli/hie.yaml

@@ -0,0 +1,3 @@
+cradle:
+  cabal:
+    component: "all"

test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test

@@ -19,13 +19,18 @@
 #
 # 5) When testing the sdist (just the packaged things), the root doesn't have a hie.yaml.
 #    Add one temporarily
+
+# Dedicated HIE file for self-debug tests.
+
+yaml_file=hie-self-debug-test.yaml
+
 created_yaml=false
-if [ ! -f hie.yaml ]; then
-    echo 'cradle:\n  cabal:\n    component: "all"' > hie.yaml
+if [ ! -f "$yaml_file" ]; then
+    printf 'cradle:\n  cabal:\n    component: "all"\n' > "$yaml_file"
     created_yaml=true;
 fi
 
-$HDB -v0 hdb/Main.hs < "test/golden/self-debug-cli/self-debug-cli.hdb-stdin" 2>&1 \
+$HDB -v0 --cradle-file="$yaml_file" hdb/Main.hs < "test/golden/self-debug-cli/self-debug-cli.hdb-stdin" 2>&1 \
   | grep -v "BreakFound" \
   | grep -v "] Compiling" \
   | sed \
@@ -34,5 +39,5 @@ $HDB -v0 hdb/Main.hs < "test/golden/self-debug-cli/self-debug-cli.hdb-stdin" 2>&
       -e 's|haskell-debugger-view-[0-9.][0-9.]*-inplace|haskell-debugger-view-<VERSION>-inplace|g'
 
 if [ $created_yaml = true ]; then
-    rm hie.yaml
+    rm "$yaml_file"
 fi

test/haskell/Test/DAP.hs

@@ -125,6 +125,7 @@ data LaunchConfig = LaunchConfig
   , lcEntryPoint :: Maybe String
   , lcEntryArgs :: [String]
   , lcExtraGhcArgs :: [String]
+  , lcCradleFile :: Maybe FilePath
   , lcInternalInterpreter :: Maybe Bool
   }
 
@@ -137,6 +138,7 @@ mkLaunchConfig projectRoot entryFile = LaunchConfig
   , lcEntryPoint = Just "main"
   , lcEntryArgs = []
   , lcExtraGhcArgs = []
+  , lcCradleFile = Nothing
   , lcInternalInterpreter = Nothing
   }
 
@@ -150,8 +152,10 @@ launchWith LaunchConfig{..} = launch $ object $
   [ "entryPoint" .= ep | Just ep <- [lcEntryPoint] ] ++
   [ "entryArgs" .= lcEntryArgs ] ++
   [ "extraGhcArgs" .= lcExtraGhcArgs ] ++
+  [ "cradleFile" .= file | Just file <- [lcCradleFile] ] ++
   [ "internalInterpreter" .= b | Just b <- [lcInternalInterpreter] ]
 
+
 -- | Set breakpoints in a particular source file of a project at the given
 -- lines.
 setLineBreakpoints :: FilePath -- ^ project root

test/haskell/Test/Integration/Basic.hs

@@ -81,6 +81,7 @@ minimalConfig =
             , lcEntryArgs = []
             , lcExtraGhcArgs = []
             , lcInternalInterpreter = Nothing
+            , lcCradleFile = Nothing
             }
       hitBreakpointWith cfg 2
       disconnect

test/haskell/Test/Integration/SelfDebug.hs

@@ -32,8 +32,9 @@ selfDebugDAPTest = do
     doesFileExist (test_dir </> "cabal.project") >>= \exists ->
       unless exists $ writeFile (test_dir </> "cabal.project")
         "packages: . haskell-debugger-view\nallow-newer: ghc-bignum,containers,time,ghc,base,template-haskell"
-    doesFileExist (test_dir </> "hie.yaml") >>= \exists ->
-      unless exists $ writeFile (test_dir </> "hie.yaml")
+    let hieFileName = "hie-self-debug-test.yaml"
+    doesFileExist (test_dir </> hieFileName) >>= \exists ->
+      unless exists $ writeFile (test_dir </> hieFileName)
         "cradle:\n  cabal:\n    component: \"all\""
     withTestDAPServerClient server $ do
       let cfg = LaunchConfig
@@ -42,6 +43,7 @@ selfDebugDAPTest = do
             , lcEntryPoint = Just "main"
             , lcEntryArgs = ["cli", "test/golden/self-debug-cli/Main.hs"]
             , lcExtraGhcArgs = []
+            , lcCradleFile = Just hieFileName
             , lcInternalInterpreter = Nothing
             }