Use dedicated hie-self-debug-test.yaml for self-debug

- Added `cradleFile` Launch argument and --cradle-file option
  to support use of custom hie.yaml files for debug.
- self-debug tests specify cradleFile=hie-self-debug-test.yaml, which means:
  - using cradle with single "all" component
  - ignoring cabal.project.local
- Also added hie-self-debug.yaml which also uses "all" cradle but does not ignore cabal.project.local.
  - specified as cradleFile in .vscode/launch.json
- Uncommented multi cradles in default hie.yaml file, and removed "all" cradle.

Author: Saizan

.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"